diff options
| author |  Jason Gross <jgross@mit.edu> | 2017-04-04 14:35:43 -0400 |
|---|---|---|
| committer |  Jason Gross <jasongross9@gmail.com> | 2017-04-04 16:05:55 -0400 |
| commit | 331fe3fcfb27d87dcfb0585ced3c051f19aaedf2 (patch) | |
| tree | a9af1a7f8bba3fb1f6e7d1610ca1553f5e5f23c2 /src | |
| parent | 6cba3c4e0572e9d917d3578c39f4f85cd3799b54 (diff) | |
Add [Proof using] to most proofs
This closes #146 and makes `make quick` faster.
The changes were generated by adding [Global Set Suggest Proof Using.]
to GlobalSettings.v, and then following [the instructions for a script I
wrote](https://github.com/JasonGross/coq-tools#proof-using-helper).
Diffstat (limited to 'src')
117 files changed, 1095 insertions, 1041 deletions
diff --git a/src/Algebra.v b/src/Algebra.v index 7f1310957..ca86b54e4 100644 --- a/src/Algebra.v +++ b/src/Algebra.v @@ -148,7 +148,7 @@ Section ZeroNeqOne. Context {T eq zero one} `{@is_zero_neq_one T eq zero one} `{Equivalence T eq}. Lemma one_neq_zero : not (eq one zero). - Proof. + Proof using Type*. intro HH; symmetry in HH. auto using zero_neq_one. Qed. End ZeroNeqOne. diff --git a/src/Algebra/Field.v b/src/Algebra/Field.v index f35e2c1cc..e71b24018 100644 --- a/src/Algebra/Field.v +++ b/src/Algebra/Field.v @@ -12,12 +12,12 @@ Section Field. Local Infix "+" := add. Local Infix "*" := mul. Lemma right_multiplicative_inverse : forall x : T, ~ eq x zero -> eq (mul x (inv x)) one. - Proof. + Proof using Type*. intros. rewrite commutative. auto using left_multiplicative_inverse. Qed. Lemma left_inv_unique x ix : ix * x = one -> ix = inv x. - Proof. + Proof using Type*. intro Hix. assert (ix*x*inv x = inv x). - rewrite Hix, left_identity; reflexivity. @@ -28,17 +28,17 @@ Section Field. Definition inv_unique := left_inv_unique. Lemma right_inv_unique x ix : x * ix = one -> ix = inv x. - Proof. rewrite commutative. apply left_inv_unique. Qed. + Proof using Type*. rewrite commutative. apply left_inv_unique. Qed. Lemma div_one x : div x one = x. - Proof. + Proof using Type*. rewrite field_div_definition. rewrite <-(inv_unique 1 1); apply monoid_is_right_identity. Qed. Lemma mul_cancel_l_iff : forall x y, y <> 0 -> (x * y = y <-> x = one). - Proof. + Proof using Type*. intros. split; intros. + rewrite <-(right_multiplicative_inverse y) by assumption. @@ -50,7 +50,7 @@ Section Field. Qed. Lemma field_theory_for_stdlib_tactic : Field_theory.field_theory 0 1 add mul sub opp div inv eq. - Proof. + Proof using Type*. constructor. { apply Ring.ring_theory_for_stdlib_tactic. } { intro H01. symmetry in H01. auto using (zero_neq_one(eq:=eq)). } @@ -61,7 +61,7 @@ Section Field. Context {eq_dec:DecidableRel eq}. Global Instance is_mul_nonzero_nonzero : @is_zero_product_zero_factor T eq 0 mul. - Proof. + Proof using Type*. split. intros x y Hxy. eapply not_not; try typeclasses eauto; []; intuition idtac; eapply (zero_neq_one(eq:=eq)). transitivity ((inv y * (inv x * x)) * y). @@ -71,7 +71,7 @@ Section Field. Qed. Global Instance integral_domain : @integral_domain T eq zero one opp add sub mul. - Proof. + Proof using Type*. split; auto using field_commutative_ring, field_is_zero_neq_one, is_mul_nonzero_nonzero. Qed. End Field. @@ -126,7 +126,7 @@ Section Homomorphism. Lemma homomorphism_multiplicative_inverse : forall x, not (EQ x ZERO) -> phi (INV x) = inv (phi x). - Proof. + Proof using Type*. intros. eapply inv_unique. rewrite <-Ring.homomorphism_mul. @@ -137,14 +137,14 @@ Section Homomorphism. { EQ_dec : DecidableRel EQ } : forall x, (EQ x ZERO -> phi (INV x) = inv (phi x)) -> phi (INV x) = inv (phi x). - Proof. + Proof using Type*. intros x ?; destruct (dec (EQ x ZERO)); auto using homomorphism_multiplicative_inverse. Qed. Lemma homomorphism_div : forall x y, not (EQ y ZERO) -> phi (DIV x y) = div (phi x) (phi y). - Proof. + Proof using Type*. intros. rewrite !field_div_definition. rewrite Ring.homomorphism_mul, homomorphism_multiplicative_inverse; (eauto || reflexivity). @@ -154,7 +154,7 @@ Section Homomorphism. { EQ_dec : DecidableRel EQ } : forall x y, (EQ y ZERO -> phi (INV y) = inv (phi y)) -> phi (DIV x y) = div (phi x) (phi y). - Proof. + Proof using Type*. intros. rewrite !field_div_definition. rewrite Ring.homomorphism_mul, homomorphism_multiplicative_inverse_complete; (eauto || reflexivity). @@ -181,7 +181,7 @@ Section Homomorphism_rev. : @field H eq zero one opp add sub mul inv div /\ @Ring.is_homomorphism F EQ ONE ADD MUL H eq one add mul phi /\ @Ring.is_homomorphism H eq one add mul F EQ ONE ADD MUL phi'. - Proof. + Proof using Type*. repeat match goal with | [ H : field |- _ ] => destruct H; try clear H | [ H : commutative_ring |- _ ] => destruct H; try clear H @@ -320,7 +320,7 @@ Section FieldSquareRoot. Local Infix "=" := eq : type_scope. Local Notation "a <> b" := (not (a = b)) : type_scope. Local Infix "+" := add. Local Infix "*" := mul. Lemma only_two_square_roots_choice x y z : x * x = z -> y * y = z -> x = y \/ x = opp y. - Proof. + Proof using Type*. intros. setoid_rewrite <-sub_zero_iff. eapply zero_product_zero_factor. diff --git a/src/Algebra/Field_test.v b/src/Algebra/Field_test.v index 2df673163..0743729c2 100644 --- a/src/Algebra/Field_test.v +++ b/src/Algebra/Field_test.v @@ -13,33 +13,37 @@ Module _fsatz_test. Local Infix "-" := sub. Local Infix "/" := div. Lemma inv_hyp a b c d (H:a*inv b=inv d*c) (bnz:b<>0) (dnz:d<>0) : a*d = b*c. - Proof. fsatz. Qed. + Proof using Type*. fsatz. Qed. Lemma inv_goal a b c d (H:a=b+c) (anz:a<>0) : inv a*d + 1 = (d+b+c)*inv(b+c). - Proof. fsatz. Qed. + Proof using Type*. fsatz. Qed. Lemma div_hyp a b c d (H:a/b=c/d) (bnz:b<>0) (dnz:d<>0) : a*d = b*c. - Proof. fsatz. Qed. + Proof using Type*. fsatz. Qed. Lemma div_goal a b c d (H:a=b+c) (anz:a<>0) : d/a + 1 = (d+b+c)/(b+c). - Proof. fsatz. Qed. + Proof using Type*. fsatz. Qed. Lemma zero_neq_one : 0 <> 1. - Proof. fsatz. Qed. + Proof using Type*. fsatz. Qed. Lemma only_two_square_roots x y : x * x = y * y -> x <> opp y -> x = y. - Proof. intros; fsatz. Qed. + Proof using Type*. intros; fsatz. Qed. Lemma transitivity_contradiction a b c (ab:a=b) (bc:b=c) (X:a<>c) : False. - Proof. fsatz. Qed. + Proof using Type*. fsatz. Qed. Lemma algebraic_contradiction a b c (A:a+b=c) (B:a-b=c) (X:a*a - b*b <> c*c) : False. - Proof. fsatz. Qed. + Proof using Type*. fsatz. Qed. Lemma division_by_zero_in_hyps (bad:1/0 + 1 = (1+1)/0): 1 = 1. - Proof. fsatz. Qed. - Lemma division_by_zero_in_hyps_eq_neq (bad:1/0 + 1 = (1+1)/0): 1 <> 0. fsatz. Qed. - Lemma division_by_zero_in_hyps_neq_neq (bad:1/0 <> (1+1)/0): 1 <> 0. fsatz. Qed. + Proof using Type*. fsatz. Qed. + Lemma division_by_zero_in_hyps_eq_neq (bad:1/0 + 1 = (1+1)/0): 1 <> 0. + Proof using Type*. + fsatz. Qed. + Lemma division_by_zero_in_hyps_neq_neq (bad:1/0 <> (1+1)/0): 1 <> 0. + Proof using Type*. + fsatz. Qed. Import BinNums. Context {char_ge_16:@Ring.char_ge F eq zero one opp add sub mul 16}. @@ -50,10 +54,10 @@ Module _fsatz_test. Local Notation nine := (three+three+three) (only parsing). Lemma fractional_equation_solution x (A:x<>1) (B:x<>opp two) (C:x*x+x <> two) (X:nine/(x*x + x - two) = three/(x+two) + seven*inv(x-1)) : x = opp one / (three+two). - Proof. fsatz. Qed. + Proof using Type*. fsatz. Qed. Lemma fractional_equation_no_solution x (A:x<>1) (B:x<>opp two) (C:x*x+x <> two) (X:nine/(x*x + x - two) = opp three/(x+two) + seven*inv(x-1)) : False. - Proof. fsatz. Qed. + Proof using Type*. fsatz. Qed. Local Notation "x ^ 2" := (x*x). Lemma recursive_nonzero_solving @@ -62,7 +66,7 @@ Module _fsatz_test. (Hsqrt : sqrt_a^2 = a) (Hfrac : (sqrt_a / y)^2 <> d) : x^2 = (y^2 - one) / (d * y^2 - a). - Proof. fsatz. Qed. + Proof using eq_dec fld. fsatz. Qed. Local Notation "x ^ 3" := (x^2*x). Lemma weierstrass_associativity_main a b x1 y1 x2 y2 x4 y4 @@ -86,6 +90,6 @@ Module _fsatz_test. x9 (Hx9: x9 = λ9^2-x1-x6) y9 (Hy9: y9 = λ9*(x1-x9)-y1) : x7 = x9 /\ y7 = y9. - Proof. fsatz_prepare_hyps; split; fsatz. Qed. + Proof using Type*. fsatz_prepare_hyps; split; fsatz. Qed. End _test. End _fsatz_test.
\ No newline at end of file diff --git a/src/Algebra/Group.v b/src/Algebra/Group.v index b053fc844..64e378281 100644 --- a/src/Algebra/Group.v +++ b/src/Algebra/Group.v @@ -9,16 +9,16 @@ Section BasicProperties. Local Open Scope eq_scope. Lemma cancel_left : forall z x y, z*x = z*y <-> x = y. - Proof. eauto using Monoid.cancel_left, left_inverse. Qed. + Proof using Type*. eauto using Monoid.cancel_left, left_inverse. Qed. Lemma cancel_right : forall z x y, x*z = y*z <-> x = y. - Proof. eauto using Monoid.cancel_right, right_inverse. Qed. + Proof using Type*. eauto using Monoid.cancel_right, right_inverse. Qed. Lemma inv_inv x : inv(inv(x)) = x. - Proof. eauto using Monoid.inv_inv, left_inverse. Qed. + Proof using Type*. eauto using Monoid.inv_inv, left_inverse. Qed. Lemma inv_op_ext x y : (inv y*inv x)*(x*y) =id. - Proof. eauto using Monoid.inv_op, left_inverse. Qed. + Proof using Type*. eauto using Monoid.inv_op, left_inverse. Qed. Lemma inv_unique x ix : ix * x = id -> ix = inv x. - Proof. + Proof using Type*. intro Hix. cut (ix*x*inv x = inv x). - rewrite <-associative, right_inverse, right_identity; trivial. @@ -26,14 +26,14 @@ Section BasicProperties. Qed. Lemma inv_bijective x y : inv x = inv y <-> x = y. - Proof. + Proof using Type*. split; intro Hi; rewrite ?Hi; try reflexivity. assert (Hii:inv (inv x) = inv (inv y)) by (rewrite Hi; reflexivity). rewrite 2inv_inv in Hii; exact Hii. Qed. Lemma inv_op x y : inv (x*y) = inv y*inv x. - Proof. + Proof using Type*. symmetry. etransitivity. 2:eapply inv_unique. 2:eapply inv_op_ext. @@ -41,19 +41,19 @@ Section BasicProperties. Qed. Lemma inv_id : inv id = id. - Proof. symmetry. eapply inv_unique, left_identity. Qed. + Proof using Type*. symmetry. eapply inv_unique, left_identity. Qed. Lemma inv_id_iff x : inv x = id <-> x = id. - Proof. + Proof using Type*. split; intro Hi; rewrite ?Hi, ?inv_id; try reflexivity. rewrite <-inv_id, inv_bijective in Hi; exact Hi. Qed. Lemma inv_nonzero_nonzero x : x <> id <-> inv x <> id. - Proof. setoid_rewrite inv_id_iff; reflexivity. Qed. + Proof using Type*. setoid_rewrite inv_id_iff; reflexivity. Qed. Lemma eq_r_opp_r_inv a b c : a = op c (inv b) <-> op a b = c. - Proof. + Proof using Type*. split; intro Hx; rewrite Hx || rewrite <-Hx; rewrite <-!associative, ?left_inverse, ?right_inverse, right_identity; reflexivity. @@ -62,9 +62,9 @@ Section BasicProperties. Section ZeroNeqOne. Context {one} `{is_zero_neq_one T eq id one}. Lemma opp_one_neq_zero : inv one <> id. - Proof. setoid_rewrite inv_id_iff. exact one_neq_zero. Qed. + Proof using Type*. setoid_rewrite inv_id_iff. exact one_neq_zero. Qed. Lemma zero_neq_opp_one : id <> inv one. - Proof. intro Hx. symmetry in Hx. eauto using opp_one_neq_zero. Qed. + Proof using Type*. intro Hx. symmetry in Hx. eauto using opp_one_neq_zero. Qed. End ZeroNeqOne. End BasicProperties. @@ -75,14 +75,14 @@ Section Homomorphism. Local Infix "=" := eq. Local Infix "=" := eq : type_scope. Lemma homomorphism_id : phi ID = id. - Proof. + Proof using Type*. assert (Hii: op (phi ID) (phi ID) = op (phi ID) id) by (rewrite <- Monoid.homomorphism, left_identity, right_identity; reflexivity). rewrite cancel_left in Hii; exact Hii. Qed. Lemma homomorphism_inv x : phi (INV x) = inv (phi x). - Proof. + Proof using Type*. apply inv_unique. rewrite <- Monoid.homomorphism, left_inverse, homomorphism_id; reflexivity. Qed. @@ -91,11 +91,11 @@ Section Homomorphism. Context {MUL} {MUL_is_scalarmult:@ScalarMult.is_scalarmult G EQ OP ID MUL }. Context {mul} {mul_is_scalarmult:@ScalarMult.is_scalarmult H eq op id mul }. Lemma homomorphism_scalarmult n P : phi (MUL n P) = mul n (phi P). - Proof. eapply ScalarMult.homomorphism_scalarmult, homomorphism_id. Qed. + Proof using Type*. eapply ScalarMult.homomorphism_scalarmult, homomorphism_id. Qed. Import ScalarMult. Lemma opp_mul : forall n P, inv (mul n P) = mul n (inv P). - Proof. + Proof using groupH mul_is_scalarmult. induction n; intros. { rewrite !scalarmult_0_l, inv_id; reflexivity. } { rewrite <-NPeano.Nat.add_1_l, Plus.plus_comm at 1. @@ -117,7 +117,7 @@ Section Homomorphism_rev. Lemma group_from_redundant_representation : @group H eq op id inv /\ @Monoid.is_homomorphism G EQ OP H eq op phi /\ @Monoid.is_homomorphism H eq op G EQ OP phi'. - Proof. + Proof using Type*. repeat match goal with | [ H : _/\_ |- _ ] => destruct H; try clear H | [ H : group |- _ ] => destruct H; try clear H @@ -141,7 +141,7 @@ Section Homomorphism_rev. Definition homomorphism_from_redundant_representation : @Monoid.is_homomorphism G EQ OP H eq op phi. - Proof. + Proof using groupG phi'_eq phi'_op phi'_phi_id. split; repeat intro; apply phi'_eq; rewrite ?phi'_op, ?phi'_phi_id; easy. Qed. End Homomorphism_rev. @@ -204,7 +204,7 @@ Section HomomorphismComposition. {phi'':G->K} (Hphi'' : forall x, eqK (phi' (phi x)) (phi'' x)) : @Monoid.is_homomorphism G EQ OP K eqK opK phi''. - Proof. + Proof using Hphi Hphi' groupK. split; repeat intro; rewrite <- !Hphi''. { rewrite !Monoid.homomorphism; reflexivity. } { apply Hphi', Hphi; assumption. } diff --git a/src/Algebra/IntegralDomain.v b/src/Algebra/IntegralDomain.v index 083c10242..4ab50c6e3 100644 --- a/src/Algebra/IntegralDomain.v +++ b/src/Algebra/IntegralDomain.v @@ -11,12 +11,12 @@ Module IntegralDomain. Lemma nonzero_product_iff_nonzero_factors : forall x y : T, ~ eq (mul x y) zero <-> ~ eq x zero /\ ~ eq y zero. - Proof. setoid_rewrite Ring.zero_product_iff_zero_factor; intuition. Qed. + Proof using Type*. setoid_rewrite Ring.zero_product_iff_zero_factor; intuition. Qed. Global Instance Integral_domain : @Integral_domain.Integral_domain T zero one add mul sub opp eq Ring.Ncring_Ring_ops Ring.Ncring_Ring Ring.Cring_Cring_commutative_ring. - Proof. split; cbv; eauto using zero_product_zero_factor, one_neq_zero. Qed. + Proof using Type. split; cbv; eauto using zero_product_zero_factor, one_neq_zero. Qed. End IntegralDomain. Module _LargeCharacteristicReflective. @@ -51,14 +51,14 @@ Module IntegralDomain. Let of_Z := (@Ring.of_Z R zero one opp add). Lemma CtoZ_correct c : of_Z (CtoZ c) = denote c. - Proof. + Proof using ring. induction c; simpl CtoZ; simpl denote; repeat (rewrite_hyp ?* || Ring.push_homomorphism of_Z); reflexivity. Qed. (* TODO: move *) Lemma nonzero_of_Z_abs z : of_Z (Z.abs z) <> zero <-> of_Z z <> zero. - Proof. + Proof using ring. destruct z; simpl Z.abs; [reflexivity..|]. simpl of_Z. setoid_rewrite opp_zero_iff. reflexivity. Qed. @@ -70,13 +70,13 @@ Module IntegralDomain. match n with N0 => false | N.pos p => BinPos.Pos.ltb p C end. Lemma is_factor_nonzero_correct (n:N) (refl:Logic.eq (is_factor_nonzero n) true) : of_Z (Z.of_N n) <> zero. - Proof. + Proof using char_ge_C. destruct n; [discriminate|]; rewrite Znat.positive_N_Z; apply char_ge_C, Pos.ltb_lt, refl. Qed. Lemma RZN_product_nonzero l (H : forall x : N, List.In x l -> of_Z (Z.of_N x) <> zero) : of_Z (Z.of_N (List.fold_right N.mul 1%N l)) <> zero. - Proof. + Proof using HC char_ge_C ring zpzf. rewrite <-List.Forall_forall in H; induction H; simpl List.fold_right. { eapply char_ge_C; assumption. } { rewrite Znat.N2Z.inj_mul; Ring.push_homomorphism of_Z. @@ -90,7 +90,7 @@ Module IntegralDomain. end. Lemma is_constant_nonzero_correct z (refl:Logic.eq (is_constant_nonzero z) true) : of_Z z <> zero. - Proof. + Proof using HC char_ge_C ring zpzf. rewrite <-nonzero_of_Z_abs, <-Znat.N2Z.inj_abs_N. repeat match goal with | _ => progress cbv [is_constant_nonzero] in * @@ -109,7 +109,7 @@ Module IntegralDomain. | _ => is_constant_nonzero (CtoZ c) end. Lemma is_nonzero_correct' c (refl:Logic.eq (is_nonzero c) true) : denote c <> zero. - Proof. + Proof using HC char_ge_C ring zpzf. induction c; repeat match goal with | H:_|-_ => progress rewrite Bool.andb_true_iff in H; destruct H @@ -131,7 +131,7 @@ Module IntegralDomain. (char_ge_C:@Ring.char_ge R eq zero one opp add sub mul C) c (refl:Logic.eq (andb (Pos.ltb xH C) (is_nonzero C c)) true) : denote c <> zero. - Proof. + Proof using ring zpzf. rewrite Bool.andb_true_iff in refl; destruct refl. eapply @is_nonzero_correct'; try apply Pos.ltb_lt; eauto. Qed. diff --git a/src/Algebra/Monoid.v b/src/Algebra/Monoid.v index 565058cf7..bd15290c7 100644 --- a/src/Algebra/Monoid.v +++ b/src/Algebra/Monoid.v @@ -11,7 +11,7 @@ Section Monoid. Lemma cancel_right z iz (Hinv:op z iz = id) : forall x y, x * z = y * z <-> x = y. - Proof. + Proof using Type*. split; intros. { assert (op (op x z) iz = op (op y z) iz) as Hcut by (rewrite_hyp ->!*; reflexivity). rewrite <-associative in Hcut. @@ -21,7 +21,7 @@ Section Monoid. Lemma cancel_left z iz (Hinv:op iz z = id) : forall x y, z * x = z * y <-> x = y. - Proof. + Proof using Type*. split; intros. { assert (op iz (op z x) = op iz (op z y)) as Hcut by (rewrite_hyp ->!*; reflexivity). rewrite !associative, !Hinv, !left_identity in Hcut; exact Hcut. } @@ -29,14 +29,14 @@ Section Monoid. Qed. Lemma inv_inv x ix iix : ix*x = id -> iix*ix = id -> iix = x. - Proof. + Proof using Type*. intros Hi Hii. assert (H:op iix id = op iix (op ix x)) by (rewrite Hi; reflexivity). rewrite associative, Hii, left_identity, right_identity in H; exact H. Qed. Lemma inv_op x y ix iy : ix*x = id -> iy*y = id -> (iy*ix)*(x*y) =id. - Proof. + Proof using Type*. intros Hx Hy. cut (iy * (ix*x) * y = id); try intro H. { rewrite <-!associative; rewrite <-!associative in H; exact H. } diff --git a/src/Algebra/Ring.v b/src/Algebra/Ring.v index 2b0e1ba80..cff27bdb3 100644 --- a/src/Algebra/Ring.v +++ b/src/Algebra/Ring.v @@ -15,7 +15,7 @@ Section Ring. Local Infix "+" := add. Local Infix "-" := sub. Local Infix "*" := mul. Lemma mul_0_l : forall x, 0 * x = 0. - Proof. + Proof using Type*. intros. assert (0*x = 0*x) as Hx by reflexivity. rewrite <-(right_identity 0), right_distributive in Hx at 1. @@ -24,7 +24,7 @@ Section Ring. Qed. Lemma mul_0_r : forall x, x * 0 = 0. - Proof. + Proof using Type*. intros. assert (x*0 = x*0) as Hx by reflexivity. rewrite <-(left_identity 0), left_distributive in Hx at 1. @@ -33,10 +33,10 @@ Section Ring. Qed. Lemma sub_0_l x : 0 - x = opp x. - Proof. rewrite ring_sub_definition. rewrite left_identity. reflexivity. Qed. + Proof using Type*. rewrite ring_sub_definition. rewrite left_identity. reflexivity. Qed. Lemma mul_opp_r x y : x * opp y = opp (x * y). - Proof. + Proof using Type*. assert (Ho:x*(opp y) + x*y = 0) by (rewrite <-left_distributive, left_inverse, mul_0_r; reflexivity). rewrite <-(left_identity (opp (x*y))), <-Ho; clear Ho. @@ -44,7 +44,7 @@ Section Ring. Qed. Lemma mul_opp_l x y : opp x * y = opp (x * y). - Proof. + Proof using Type*. assert (Ho:opp x*y + x*y = 0) by (rewrite <-right_distributive, left_inverse, mul_0_l; reflexivity). rewrite <-(left_identity (opp (x*y))), <-Ho; clear Ho. @@ -54,19 +54,19 @@ Section Ring. Definition opp_zero_iff : forall x, opp x = 0 <-> x = 0 := Group.inv_id_iff. Global Instance is_left_distributive_sub : is_left_distributive (eq:=eq)(add:=sub)(mul:=mul). - Proof. + Proof using Type*. split; intros. rewrite !ring_sub_definition, left_distributive. eapply Group.cancel_left, mul_opp_r. Qed. Global Instance is_right_distributive_sub : is_right_distributive (eq:=eq)(add:=sub)(mul:=mul). - Proof. + Proof using Type*. split; intros. rewrite !ring_sub_definition, right_distributive. eapply Group.cancel_left, mul_opp_l. Qed. Lemma sub_zero_iff x y : x - y = 0 <-> x = y. - Proof. + Proof using Type*. split; intro E. { rewrite <-(right_identity y), <- E, ring_sub_definition. rewrite commutative, <-associative, commutative. @@ -75,25 +75,25 @@ Section Ring. Qed. Lemma neq_sub_neq_zero x y (Hxy:x<>y) : x-y <> 0. - Proof. + Proof using Type*. intro Hsub. apply Hxy. rewrite <-(left_identity y), <-Hsub, ring_sub_definition. rewrite <-associative, left_inverse, right_identity. reflexivity. Qed. Lemma zero_product_iff_zero_factor {Hzpzf:@is_zero_product_zero_factor T eq zero mul} : forall x y : T, eq (mul x y) zero <-> eq x zero \/ eq y zero. - Proof. + Proof using Type*. split; eauto using zero_product_zero_factor; []. intros [Hz|Hz]; rewrite Hz; eauto using mul_0_l, mul_0_r. Qed. Lemma nonzero_product_iff_nonzero_factor {Hzpzf:@is_zero_product_zero_factor T eq zero mul} : forall x y : T, not (eq (mul x y) zero) <-> (not (eq x zero) /\ not (eq y zero)). - Proof. intros; rewrite zero_product_iff_zero_factor; tauto. Qed. + Proof using Type*. intros; rewrite zero_product_iff_zero_factor; tauto. Qed. Global Instance Ncring_Ring_ops : @Ncring.Ring_ops T zero one add mul sub opp eq. Global Instance Ncring_Ring : @Ncring.Ring T zero one add mul sub opp eq Ncring_Ring_ops. - Proof. + Proof using Type*. split; exact _ || cbv; intros; eauto using left_identity, right_identity, commutative, associative, right_inverse, left_distributive, right_distributive, ring_sub_definition with core typeclass_instances. - (* TODO: why does [eauto using @left_identity with typeclass_instances] not work? *) eapply @left_identity; eauto with typeclass_instances. @@ -121,23 +121,23 @@ Section Homomorphism. Context `{phi_homom:is_homomorphism}. Lemma homomorphism_zero : phi ZERO = zero. - Proof. apply Group.homomorphism_id. Qed. + Proof using Type*. apply Group.homomorphism_id. Qed. Lemma homomorphism_add : forall x y, phi (ADD x y) = add (phi x) (phi y). - Proof. apply Monoid.homomorphism. Qed. + Proof using phi_homom. apply Monoid.homomorphism. Qed. Definition homomorphism_opp : forall x, phi (OPP x) = opp (phi x) := (Group.homomorphism_inv (INV:=OPP) (inv:=opp)). Lemma homomorphism_sub : forall x y, phi (SUB x y) = sub (phi x) (phi y). - Proof. + Proof using Type*. intros. rewrite !ring_sub_definition, Monoid.homomorphism, homomorphism_opp. reflexivity. Qed. Global Instance monoid_homomorphism_mul : Monoid.is_homomorphism (phi:=phi) (OP:=MUL) (op:=mul) (EQ:=EQ) (eq:=eq). - Proof. split; destruct phi_homom; assumption || exact _. Qed. + Proof using phi_homom. split; destruct phi_homom; assumption || exact _. Qed. End Homomorphism. (* TODO: file a Coq bug for rewrite_strat -- it should accept ltac variables *) @@ -200,7 +200,7 @@ Section Isomorphism. : @ring H eq zero one opp add sub mul /\ @is_homomorphism F EQ ONE ADD MUL H eq one add mul phi /\ @is_homomorphism H eq one add mul F EQ ONE ADD MUL phi'. - Proof. + Proof using phi'_add phi'_eq phi'_mul phi'_one phi'_opp phi'_phi_id phi'_sub phi'_zero ringF. repeat match goal with | [ H : field |- _ ] => destruct H; try clear H | [ H : commutative_ring |- _ ] => destruct H; try clear H @@ -236,10 +236,10 @@ Section TacticSupportCommutative. Global Instance Cring_Cring_commutative_ring : @Cring.Cring T zero one add mul sub opp eq Ncring_Ring_ops Ncring_Ring. - Proof. unfold Cring.Cring; intros; cbv. eapply commutative. Qed. + Proof using Type. unfold Cring.Cring; intros; cbv. eapply commutative. Qed. Lemma ring_theory_for_stdlib_tactic : Ring_theory.ring_theory zero one add mul sub opp eq. - Proof. + Proof using Type*. constructor; intros. (* TODO(automation): make [auto] do this? *) - apply left_identity. - apply commutative. @@ -289,15 +289,15 @@ Section of_Z. end. Lemma of_Z_0 : of_Z 0 = Rzero. - Proof. reflexivity. Qed. + Proof using Type*. reflexivity. Qed. Lemma of_nat_add x : of_nat (Nat.add x 1) = Radd (of_nat x) Rone. - Proof. destruct x; rewrite ?Nat.add_1_r; reflexivity. Qed. + Proof using Type*. destruct x; rewrite ?Nat.add_1_r; reflexivity. Qed. Lemma of_nat_sub x (H: (0 < x)%nat): of_nat (Nat.sub x 1) = Rsub (of_nat x) Rone. - Proof. + Proof using Type*. induction x; [omega|simpl]. rewrite <-of_nat_add. rewrite Nat.sub_0_r, Nat.add_1_r. @@ -309,7 +309,7 @@ Section of_Z. Lemma of_Z_add_1_r : forall x, of_Z (Z.add x 1) = Radd (of_Z x) Rone. - Proof. + Proof using Type*. destruct x; [reflexivity| | ]; simpl of_Z. { rewrite Pos2Nat.inj_add, of_nat_add. reflexivity. } @@ -330,7 +330,7 @@ Section of_Z. Lemma of_Z_sub_1_r : forall x, of_Z (Z.sub x 1) = Rsub (of_Z x) Rone. - Proof. + Proof using Type*. induction x. { simpl; rewrite ring_sub_definition, !left_identity; reflexivity. } @@ -354,14 +354,14 @@ Section of_Z. Lemma of_Z_opp : forall a, of_Z (Z.opp a) = Ropp (of_Z a). - Proof. + Proof using Type*. destruct a; simpl; rewrite ?Group.inv_id, ?Group.inv_inv; reflexivity. Qed. Lemma of_Z_add : forall a b, of_Z (Z.add a b) = Radd (of_Z a) (of_Z b). - Proof. + Proof using Type*. intros. let x := match goal with |- ?x => x end in let f := match (eval pattern b in x) with ?f _ => f end in @@ -381,7 +381,7 @@ Section of_Z. Lemma of_Z_mul : forall a b, of_Z (Z.mul a b) = Rmul (of_Z a) (of_Z b). - Proof. + Proof using Type*. intros. let x := match goal with |- ?x => x end in let f := match (eval pattern b in x) with ?f _ => f end in @@ -408,7 +408,7 @@ Section of_Z. Z Logic.eq Z.one Z.add Z.mul R Req Rone Radd Rmul of_Z. - Proof. + Proof using Type*. repeat constructor; intros. { apply of_Z_add. } { repeat intro; subst; reflexivity. } diff --git a/src/Algebra/ScalarMult.v b/src/Algebra/ScalarMult.v index 33c236775..5c17a6bb5 100644 --- a/src/Algebra/ScalarMult.v +++ b/src/Algebra/ScalarMult.v @@ -28,30 +28,32 @@ Section ScalarMultProperties. end. Global Instance Proper_scalarmult_ref : Proper (Logic.eq==>eq==>eq) scalarmult_ref. - Proof. + Proof using monoidG. repeat intro; subst. match goal with [n:nat |- _ ] => induction n; simpl @scalarmult_ref; [reflexivity|] end. repeat match goal with [H:_ |- _ ] => rewrite H end; reflexivity. Qed. Lemma scalarmult_ext : forall n P, mul n P = scalarmult_ref n P. + Proof using Type*. + induction n; simpl @scalarmult_ref; intros; rewrite <-?IHn; (apply scalarmult_0_l || apply scalarmult_S_l). Qed. Lemma scalarmult_1_l : forall P, 1*P = P. - Proof. intros. rewrite scalarmult_S_l, scalarmult_0_l, right_identity; reflexivity. Qed. + Proof using Type*. intros. rewrite scalarmult_S_l, scalarmult_0_l, right_identity; reflexivity. Qed. Lemma scalarmult_add_l : forall (n m:nat) (P:G), ((n + m)%nat * P = n * P + m * P). - Proof. + Proof using Type*. induction n; intros; rewrite ?scalarmult_0_l, ?scalarmult_S_l, ?plus_Sn_m, ?plus_O_n, ?scalarmult_S_l, ?left_identity, <-?associative, <-?IHn; reflexivity. Qed. Lemma scalarmult_zero_r : forall m, m * zero = zero. - Proof. induction m; rewrite ?scalarmult_S_l, ?scalarmult_0_l, ?left_identity, ?IHm; try reflexivity. Qed. + Proof using Type*. induction m; rewrite ?scalarmult_S_l, ?scalarmult_0_l, ?left_identity, ?IHm; try reflexivity. Qed. Lemma scalarmult_assoc : forall (n m : nat) P, n * (m * P) = (m * n)%nat * P. - Proof. + Proof using Type*. induction n; intros. { rewrite <-mult_n_O, !scalarmult_0_l. reflexivity. } { rewrite scalarmult_S_l, <-mult_n_Sm, <-Plus.plus_comm, scalarmult_add_l. @@ -59,10 +61,10 @@ Section ScalarMultProperties. Qed. Lemma scalarmult_times_order : forall l B, l*B = zero -> forall n, (l * n) * B = zero. - Proof. intros ? ? Hl ?. rewrite <-scalarmult_assoc, Hl, scalarmult_zero_r. reflexivity. Qed. + Proof using Type*. intros ? ? Hl ?. rewrite <-scalarmult_assoc, Hl, scalarmult_zero_r. reflexivity. Qed. Lemma scalarmult_mod_order : forall l B, l <> 0%nat -> l*B = zero -> forall n, n mod l * B = n * B. - Proof. + Proof using Type*. intros ? ? Hnz Hmod ?. rewrite (NPeano.Nat.div_mod n l Hnz) at 2. rewrite scalarmult_add_l, scalarmult_times_order, left_identity by auto. reflexivity. @@ -79,7 +81,7 @@ Section ScalarMultHomomorphism. Context (phi_ZERO:phi ZERO = zero). Lemma homomorphism_scalarmult : forall n P, phi (MUL n P) = mul n (phi P). - Proof. + Proof using Type*. setoid_rewrite scalarmult_ext. induction n; intros; simpl; rewrite ?Monoid.homomorphism, ?IHn; easy. Qed. diff --git a/src/Assembly/Compile.v b/src/Assembly/Compile.v index 666cc65cc..e9300ff0f 100644 --- a/src/Assembly/Compile.v +++ b/src/Assembly/Compile.v @@ -52,7 +52,7 @@ Module CompileHL. Lemma compile_correct {_: Evaluable T} {t} e1 e2 G (wf:HL.wf G e1 e2) : List.Forall (fun v => let 'existT _ (x, a) := v in LL.interp_arg a = x) G -> LL.interp (compile e2) = HL.interp e1 :> interp_type t. - Proof. + Proof using Type. induction wf; repeat match goal with | [HIn:In ?x ?l, HForall:Forall _ ?l |- _ ] => @@ -171,7 +171,7 @@ Module CompileLL. end. Lemma type_eqb_spec: forall t0 t1, type_eqb t0 t1 = true <-> t0 = t1. - Proof. + Proof using Type. intros; split. - revert t1; induction t0 as [|t0a IHt0a t0b IHt0b]. diff --git a/src/Assembly/Conversions.v b/src/Assembly/Conversions.v index c7801c63a..f677b6d58 100644 --- a/src/Assembly/Conversions.v +++ b/src/Assembly/Conversions.v @@ -206,7 +206,7 @@ Module LLConversions. Lemma convertArg_interp' : forall {t V} f (x: @arg A V t), (interp_arg' (fun z => toT (fromT (f z))) (@convertArg A B EA EB _ t x)) = @convertVar A B EA EB t (interp_arg' f x). - Proof. + Proof using Type. intros. induction x as [| |t0 t1 i0 i1]; simpl; [reflexivity|reflexivity|]. induction EA, EB; simpl; f_equal; assumption. @@ -214,7 +214,7 @@ Module LLConversions. Lemma convertArg_var: forall {A B EA EB t} V (x: @interp_type A t), @convertArg A B EA EB V t (uninterp_arg x) = uninterp_arg (var := V) (@convertVar A B EA EB t x). - Proof. + Proof using Type. induction t as [|t0 IHt_0 t1 IHt_1]; simpl; intros; [reflexivity|]. induction x as [a b]; simpl; f_equal; induction t0 as [|t0a IHt0_0 t0b IHt0_1], @@ -241,7 +241,7 @@ Module LLConversions. Admitted. Lemma roundTrip_0 : @toT Correctness.B BE (@fromT Z ZE 0%Z) <> None. - Proof. + Proof using Type. intros; unfold toT, fromT, BE, ZE, BoundedEvaluable, ZEvaluable, bwFromRWV; simpl; try break_match; simpl; try abstract (intro Z; inversion Z); pose proof (Npow2_gt0 n); simpl in *; nomega. @@ -447,7 +447,7 @@ Module LLConversions. check (f := rangeOf) (@convertExpr Z R _ _ _ _ E) = true -> typeMap (fun x => NToWord n (Z.to_N x)) (zinterp E) = wordInterp (ZToWord _ E). - Proof. + Proof using Type. intros. apply RangeInterp_bounded_spec. apply check_spec. diff --git a/src/Assembly/Evaluables.v b/src/Assembly/Evaluables.v index 924f548fa..433915da3 100644 --- a/src/Assembly/Evaluables.v +++ b/src/Assembly/Evaluables.v @@ -154,7 +154,7 @@ Section RangeUpdate. Section BoundedSub. Lemma NToWord_Npow2: wzero n = NToWord n (Npow2 n). - Proof. + Proof using Type. induction n as [|n0]. + repeat rewrite shatter_word_0; reflexivity. @@ -167,7 +167,7 @@ Section RangeUpdate. Lemma bWSub_lem: forall (x0 x1: word n) (low0 high1: N), (low0 <= wordToN x0)%N -> (wordToN x1 <= high1)%N -> (low0 - high1 <= & (x0 ^- x1))%N. - Proof. + Proof using Type. intros. destruct (Nge_dec (wordToN x1) 1)%N as [e|e]. @@ -244,14 +244,14 @@ Section RangeUpdate. Definition getBits (x: N) := N.succ (N.log2 x). Lemma land_intro_ones: forall x, x = N.land x (N.ones (getBits x)). - Proof. + Proof using Type. intros. rewrite N.land_ones_low; [reflexivity|]. unfold getBits; nomega. Qed. Lemma land_lt_Npow2: forall x k, (N.land x (N.ones k) < 2 ^ k)%N. - Proof. + Proof using Type. intros. rewrite N.land_ones. apply N.mod_lt. @@ -262,7 +262,7 @@ Section RangeUpdate. Qed. Lemma land_prop_bound_l: forall a b, (N.land a b < Npow2 (N.to_nat (getBits a)))%N. - Proof. + Proof using Type. intros; rewrite Npow2_N. rewrite (land_intro_ones a). rewrite <- N.land_comm. @@ -280,7 +280,7 @@ Section RangeUpdate. Qed. Lemma land_prop_bound_r: forall a b, (N.land a b < Npow2 (N.to_nat (getBits b)))%N. - Proof. + Proof using Type. intros; rewrite N.land_comm; apply land_prop_bound_l. Qed. End LandOnes. @@ -295,7 +295,7 @@ Section RangeUpdate. else Some (range N (low0 + low1) (high0 + high1)) end)%N (@wplus n). - Proof. + Proof using Type. unfold validBinaryWordOp; intros. destruct (overflows n (high0 + high1))%N; repeat split; try assumption. @@ -324,7 +324,7 @@ Section RangeUpdate. else None end) (@wminus n). - Proof. + Proof using Type. unfold validBinaryWordOp; intros. Ltac kill_preds := @@ -371,7 +371,7 @@ Section RangeUpdate. Some (range N (low0 * low1) (high0 * high1))%N end) (@wmult n). - Proof. + Proof using Type. unfold validBinaryWordOp; intros. destruct (overflows n (high0 * high1))%N; repeat split. @@ -399,7 +399,7 @@ Section RangeUpdate. else (N.shiftr high0 low1)))%N end) (fun x k => extend (Nat.eq_le_incl _ _ eq_refl) (shiftr x (wordToNat k))). - Proof. + Proof using Type. unfold validBinaryWordOp; intros. repeat split; unfold extend; try rewrite wordToN_convS, wordToN_zext. @@ -478,7 +478,7 @@ Section RangeUpdate. Some (range N 0%N (if (Nge_dec upper (Npow2 n)) then (N.pred (Npow2 n)) else upper)) end) (@wand n). - Proof. + Proof using Type. unfold validBinaryWordOp; intros. repeat split; [apply N_ge_0 | |]. destruct (lt_dec (N.to_nat (getBits high0)) (N.to_nat (getBits high1))), @@ -638,7 +638,7 @@ Section BoundedWord. Defined. Lemma just_None_spec: forall x, just x = None -> (x >= Npow2 n)%N. - Proof. + Proof using Type. intros x H; unfold just in *. destruct (Nge_dec (N.pred (Npow2 n)) x) as [p|p]; [inversion H |]. rewrite <- (N.pred_succ x) in p. @@ -649,21 +649,21 @@ Section BoundedWord. Qed. Lemma just_value_spec: forall x b, just x = Some b -> bw_value b = NToWord n x. - Proof. + Proof using Type. intros x b H; destruct b; unfold just in *; destruct (Nge_dec (N.pred (Npow2 n)) x); simpl in *; inversion H; subst; reflexivity. Qed. Lemma just_low_spec: forall x b, just x = Some b -> bw_low b = x. - Proof. + Proof using Type. intros x b H; destruct b; unfold just in *; destruct (Nge_dec (N.pred (Npow2 n)) x); simpl in *; inversion H; subst; reflexivity. Qed. Lemma just_high_spec: forall x b, just x = Some b -> bw_high b = x. - Proof. + Proof using Type. intros x b H; destruct b; unfold just in *; destruct (Nge_dec (N.pred (Npow2 n)) x); simpl in *; inversion H; subst; reflexivity. diff --git a/src/Assembly/LL.v b/src/Assembly/LL.v index e94933e2c..c2faf955d 100644 --- a/src/Assembly/LL.v +++ b/src/Assembly/LL.v @@ -44,7 +44,7 @@ Module LL. end. Lemma interp_arg_spec: forall {t} (x: arg t), interp_arg x = interp_arg' id x. - Proof. + Proof using Type. intros; induction x; unfold id in *; simpl; repeat f_equal; first [reflexivity| assumption]. Qed. @@ -82,7 +82,7 @@ Module LL. end. Lemma interp_spec: forall {t} (e: expr t), interp e = interp' id e. - Proof. + Proof using Type. intros; induction e; unfold id in *; simpl; repeat f_equal; try rewrite H; simpl; repeat f_equal; rewrite interp_arg_spec; repeat f_equal. @@ -133,7 +133,7 @@ Module LL. match_arg_Prod a = (a1, a2) <-> a = Pair a1 a2 | _ => fun _ => True end a. - Proof. + Proof using Type. unfold match_arg_Prod; destruct a; repeat match goal with | _ => split @@ -147,7 +147,7 @@ Module LL. Lemma match_arg_Prod_correct {var t1 t2} (a:arg T var (Prod t1 t2)) (a1:arg T var t1) (a2:arg T var t2) : match_arg_Prod a = (a1, a2) <-> a = Pair a1 a2. - Proof. + Proof using Type. pose proof (match_arg_Prod_correct_helper a) as H; simpl in H; rewrite H; reflexivity. Qed. End match_arg. diff --git a/src/BaseSystem.v b/src/BaseSystem.v index 48b6468cf..5d48c0977 100644 --- a/src/BaseSystem.v +++ b/src/BaseSystem.v @@ -48,7 +48,7 @@ Section BaseSystem. Definition encode z max := encode' z max (length base). Lemma decode'_truncate : forall bs us, decode' bs us = decode' bs (firstn (length bs) us). - Proof. + Proof using Type. unfold decode'; intros; f_equal; apply combine_truncate_l. Qed. @@ -105,6 +105,8 @@ Section PolynomialBaseCoefs. Definition poly_base := map bi (seq 0 baseLength). Lemma poly_b0_1 : forall x, nth_default x poly_base 0 = 1. + Proof using baseLengthNonzero. + unfold poly_base, bi, nth_default. case_eq baseLength; intros. { assert ((0 < baseLength)%nat) by @@ -115,7 +117,7 @@ Section PolynomialBaseCoefs. Qed. Lemma poly_base_positive : forall b, In b poly_base -> b > 0. - Proof. + Proof using Type. unfold poly_base. intros until 0; intro H. rewrite in_map_iff in *. @@ -126,7 +128,7 @@ Section PolynomialBaseCoefs. Lemma poly_base_defn : forall i, (i < length poly_base)%nat -> nth_default 0 poly_base i = bi i. - Proof. + Proof using Type. unfold poly_base, nth_default; nth_tac. Qed. @@ -135,7 +137,7 @@ Section PolynomialBaseCoefs. let b := nth_default 0 poly_base in let r := (b (S i) / b i) in b (S i) = r * b i. - Proof. + Proof using Type. intros; subst b; subst r. repeat rewrite poly_base_defn in * by omega. unfold bi. @@ -153,7 +155,7 @@ Section PolynomialBaseCoefs. let b := nth_default 0 poly_base in let r := (b i * b j) / b (i+j)%nat in b i * b j = r * b (i+j)%nat. - Proof. + Proof using Type. unfold poly_base, nth_default; nth_tac. clear. diff --git a/src/BaseSystemProofs.v b/src/BaseSystemProofs.v index 1c2fe0fbe..409d8b7db 100644 --- a/src/BaseSystemProofs.v +++ b/src/BaseSystemProofs.v @@ -15,14 +15,14 @@ Section BaseSystemProofs. Context `(base_vector : BaseVector). Lemma decode'_truncate : forall bs us, decode' bs us = decode' bs (firstn (length bs) us). - Proof. + Proof using Type. unfold decode'; intros; f_equal; apply combine_truncate_l. Qed. Lemma decode'_splice : forall xs ys bs, decode' bs (xs ++ ys) = decode' (firstn (length xs) bs) xs + decode' (skipn (length xs) bs) ys. - Proof. + Proof using Type. unfold decode'. induction xs; destruct ys, bs; boring. + rewrite combine_truncate_r. @@ -32,17 +32,19 @@ Section BaseSystemProofs. Qed. Lemma add_rep : forall bs us vs, decode' bs (add us vs) = decode' bs us + decode' bs vs. - Proof. + Proof using Type. unfold decode', accumulate; induction bs; destruct us, vs; boring; ring. Qed. Lemma decode_nil : forall bs, decode' bs nil = 0. + Proof using Type. + auto. Qed. Hint Rewrite decode_nil. Lemma decode_base_nil : forall us, decode' nil us = 0. - Proof. + Proof using Type. intros; rewrite decode'_truncate; auto. Qed. @@ -50,26 +52,26 @@ Section BaseSystemProofs. Lemma mul_each_rep : forall bs u vs, decode' bs (mul_each u vs) = u * decode' bs vs. - Proof. + Proof using Type. unfold decode', accumulate; induction bs; destruct vs; boring; ring. Qed. Lemma base_eq_1cons: base = 1 :: skipn 1 base. - Proof. + Proof using Type*. pose proof (b0_1 0) as H. destruct base; compute in H; try discriminate; boring. Qed. Lemma decode'_cons : forall x1 x2 xs1 xs2, decode' (x1 :: xs1) (x2 :: xs2) = x1 * x2 + decode' xs1 xs2. - Proof. + Proof using Type. unfold decode', accumulate; boring; ring. Qed. Hint Rewrite decode'_cons. Lemma decode_cons : forall x us, decode base (x :: us) = x + decode base (0 :: us). - Proof. + Proof using Type*. unfold decode; intros. rewrite base_eq_1cons. autorewrite with core; ring_simplify; auto. @@ -78,7 +80,7 @@ Section BaseSystemProofs. Lemma decode'_map_mul : forall v xs bs, decode' (map (Z.mul v) bs) xs = Z.mul v (decode' bs xs). - Proof. + Proof using Type. unfold decode'. induction xs; destruct bs; boring. unfold accumulate; simpl; nia. @@ -87,18 +89,18 @@ Section BaseSystemProofs. Lemma decode_map_mul : forall v xs, decode (map (Z.mul v) base) xs = Z.mul v (decode base xs). - Proof. + Proof using Type. unfold decode; intros; apply decode'_map_mul. Qed. Lemma sub_rep : forall bs us vs, decode' bs (sub us vs) = decode' bs us - decode' bs vs. - Proof. + Proof using Type. induction bs; destruct us; destruct vs; boring; ring. Qed. Lemma nth_default_base_nonzero : forall d, d <> 0 -> forall i, nth_default d base i <> 0. - Proof. + Proof using Type*. intros. rewrite nth_default_eq. destruct (nth_in_or_default i base d). @@ -108,7 +110,7 @@ Section BaseSystemProofs. Lemma nth_default_base_pos : forall d, 0 < d -> forall i, 0 < nth_default d base i. - Proof. + Proof using Type*. intros. rewrite nth_default_eq. destruct (nth_in_or_default i base d). @@ -118,7 +120,7 @@ Section BaseSystemProofs. Lemma mul_each_base : forall us bs c, decode' bs (mul_each c us) = decode' (mul_each c bs) us. - Proof. + Proof using Type. induction us; destruct bs; boring; ring. Qed. @@ -128,14 +130,14 @@ Section BaseSystemProofs. Lemma base_app : forall us low high, decode' (low ++ high) us = decode' low (firstn (length low) us) + decode' high (skipn (length low) us). - Proof. + Proof using Type. induction us; destruct low; boring. Qed. Lemma base_mul_app : forall low c us, decode' (low ++ mul_each c low) us = decode' low (firstn (length low) us) + c * decode' low (skipn (length low) us). - Proof. + Proof using Type. intros. rewrite base_app; f_equal. rewrite <- mul_each_rep. @@ -144,27 +146,31 @@ Section BaseSystemProofs. Qed. Lemma zeros_rep : forall bs n, decode' bs (zeros n) = 0. + Proof using Type. + induction bs; destruct n; boring. Qed. Lemma length_zeros : forall n, length (zeros n) = n. + Proof using Type. + induction n; boring. Qed. Hint Rewrite length_zeros. Lemma app_zeros_zeros : forall n m, zeros n ++ zeros m = zeros (n + m)%nat. - Proof. + Proof using Type. induction n; boring. Qed. Hint Rewrite app_zeros_zeros. Lemma zeros_app0 : forall m, zeros m ++ 0 :: nil = zeros (S m). - Proof. + Proof using Type. induction m; boring. Qed. Hint Rewrite zeros_app0. Lemma nth_default_zeros : forall n i, nth_default 0 (BaseSystem.zeros n) i = 0. - Proof. + Proof using Type. induction n; intros; [ cbv [BaseSystem.zeros]; apply nth_default_nil | ]. rewrite <-zeros_app0, nth_default_app. rewrite length_zeros. @@ -176,7 +182,7 @@ Section BaseSystemProofs. Qed. Lemma rev_zeros : forall n, rev (zeros n) = zeros n. - Proof. + Proof using Type. induction n; boring. Qed. Hint Rewrite rev_zeros. @@ -185,19 +191,19 @@ Section BaseSystemProofs. Lemma decode_single : forall n bs x, decode' bs (zeros n ++ x :: nil) = nth_default 0 bs n * x. - Proof. + Proof using Type. induction n; destruct bs; boring. Qed. Hint Rewrite decode_single. Lemma peel_decode : forall xs ys x y, decode' (x::xs) (y::ys) = x*y + decode' xs ys. - Proof. + Proof using Type. boring. Qed. Hint Rewrite zeros_rep peel_decode. Lemma decode_Proper : Proper (Logic.eq ==> (Forall2 Logic.eq) ==> Logic.eq) decode'. - Proof. + Proof using Type. repeat intro; subst. revert y y0 H0; induction x0; intros. + inversion H0. rewrite !decode_nil. @@ -210,18 +216,20 @@ Section BaseSystemProofs. Qed. Lemma decode_highzeros : forall xs bs n, decode' bs (xs ++ zeros n) = decode' bs xs. - Proof. + Proof using Type. induction xs; destruct bs; boring. Qed. Lemma mul_bi'_zeros : forall n m, mul_bi' base n (zeros m) = zeros m. + Proof using Type. + induction m; boring. Qed. Hint Rewrite mul_bi'_zeros. Lemma nth_error_base_nonzero : forall n x, nth_error base n = Some x -> x <> 0. - Proof. + Proof using Type*. eauto using (@nth_error_value_In Z), Z.gt0_neq0, base_positive. Qed. @@ -230,7 +238,7 @@ Section BaseSystemProofs. Lemma mul_bi_single : forall m n x, (n + m < length base)%nat -> decode base (mul_bi base n (zeros m ++ x :: nil)) = nth_default 0 base m * x * nth_default 0 base n. - Proof. + Proof using Type*. unfold mul_bi, decode. destruct m; simpl; simpl_list; simpl; intros. { pose proof nth_error_base_nonzero as nth_nonzero. @@ -268,12 +276,14 @@ Section BaseSystemProofs. Qed. Lemma set_higher' : forall vs x, vs++x::nil = vs .+ (zeros (length vs) ++ x :: nil). + Proof using Type. + induction vs; boring; f_equal; ring. Qed. Lemma set_higher : forall bs vs x, decode' bs (vs++x::nil) = decode' bs vs + nth_default 0 bs (length vs) * x. - Proof. + Proof using Type. intros. rewrite set_higher'. rewrite add_rep. @@ -282,41 +292,49 @@ Section BaseSystemProofs. Qed. Lemma zeros_plus_zeros : forall n, zeros n = zeros n .+ zeros n. + Proof using Type. + induction n; auto. simpl; f_equal; auto. Qed. Lemma mul_bi'_n_nil : forall n, mul_bi' base n nil = nil. - Proof. + Proof using Type. unfold mul_bi; auto. Qed. Hint Rewrite mul_bi'_n_nil. Lemma add_nil_l : forall us, nil .+ us = us. + Proof using Type. + induction us; auto. Qed. Hint Rewrite add_nil_l. Lemma add_nil_r : forall us, us .+ nil = us. + Proof using Type. + induction us; auto. Qed. Hint Rewrite add_nil_r. Lemma add_first_terms : forall us vs a b, (a :: us) .+ (b :: vs) = (a + b) :: (us .+ vs). + Proof using Type. + auto. Qed. Hint Rewrite add_first_terms. Lemma mul_bi'_cons : forall n x us, mul_bi' base n (x :: us) = x * crosscoef base n (length us) :: mul_bi' base n us. - Proof. + Proof using Type. unfold mul_bi'; auto. Qed. Lemma add_same_length : forall us vs l, (length us = l) -> (length vs = l) -> length (us .+ vs) = l. - Proof. + Proof using Type. induction us, vs; boring. erewrite (IHus vs (pred l)); boring. Qed. @@ -327,7 +345,7 @@ Section BaseSystemProofs. Lemma add_snoc_same_length : forall l us vs a b, (length us = l) -> (length vs = l) -> (us ++ a :: nil) .+ (vs ++ b :: nil) = (us .+ vs) ++ (a + b) :: nil. - Proof. + Proof using Type. induction l, us, vs; boring; discriminate. Qed. @@ -336,7 +354,7 @@ Section BaseSystemProofs. (Hlvs: length vs = l), mul_bi' base n (rev (us .+ vs)) = mul_bi' base n (rev us) .+ mul_bi' base n (rev vs). - Proof. + Proof using Type. (* TODO(adamc): please help prettify this *) induction us using rev_ind; try solve [destruct vs; boring; congruence]. @@ -360,18 +378,20 @@ Section BaseSystemProofs. Qed. Lemma zeros_cons0 : forall n, 0 :: zeros n = zeros (S n). + Proof using Type. + auto. Qed. Lemma add_leading_zeros : forall n us vs, (zeros n ++ us) .+ (zeros n ++ vs) = zeros n ++ (us .+ vs). - Proof. + Proof using Type. induction n; boring. Qed. Lemma rev_add_rev : forall us vs l, (length us = l) -> (length vs = l) -> (rev us) .+ (rev vs) = rev (us .+ vs). - Proof. + Proof using Type. induction us, vs; boring; try solve [subst; discriminate]. rewrite (add_snoc_same_length (pred l) _ _ _ _) by (subst; simpl_list; omega). rewrite (IHus vs (pred l)) by omega; auto. @@ -379,13 +399,13 @@ Section BaseSystemProofs. Hint Rewrite rev_add_rev. Lemma mul_bi'_length : forall us n, length (mul_bi' base n us) = length us. - Proof. + Proof using Type. induction us, n; boring. Qed. Hint Rewrite mul_bi'_length. Lemma add_comm : forall us vs, us .+ vs = vs .+ us. - Proof. + Proof using Type. induction us, vs; boring; f_equal; auto. Qed. @@ -394,7 +414,7 @@ Section BaseSystemProofs. Lemma mul_bi_add_same_length : forall n us vs l, (length us = l) -> (length vs = l) -> mul_bi base n (us .+ vs) = mul_bi base n us .+ mul_bi base n vs. - Proof. + Proof using Type. unfold mul_bi; boring. rewrite add_leading_zeros. erewrite mul_bi'_add; boring. @@ -402,7 +422,7 @@ Section BaseSystemProofs. Qed. Lemma add_zeros_same_length : forall us, us .+ (zeros (length us)) = us. - Proof. + Proof using Type. induction us; boring; f_equal; omega. Qed. @@ -411,13 +431,13 @@ Section BaseSystemProofs. Lemma add_trailing_zeros : forall us vs, (length us >= length vs)%nat -> us .+ vs = us .+ (vs ++ (zeros (length us - length vs)%nat)). - Proof. + Proof using Type. induction us, vs; boring; f_equal; boring. Qed. Lemma length_add_ge : forall us vs, (length us >= length vs)%nat -> (length (us .+ vs) <= length us)%nat. - Proof. + Proof using Type. intros. rewrite add_trailing_zeros by trivial. erewrite add_same_length by (pose proof app_length; boring); omega. @@ -425,25 +445,25 @@ Section BaseSystemProofs. Lemma add_length_le_max : forall us vs, (length (us .+ vs) <= max (length us) (length vs))%nat. - Proof. + Proof using Type. intros; case_max; (rewrite add_comm; apply length_add_ge; omega) || (apply length_add_ge; omega) . Qed. Lemma sub_nil_length: forall us : digits, length (sub nil us) = length us. - Proof. + Proof using Type. induction us; boring. Qed. Lemma sub_length : forall us vs, (length (sub us vs) = max (length us) (length vs))%nat. - Proof. + Proof using Type. induction us, vs; boring. rewrite sub_nil_length; auto. Qed. Lemma mul_bi_length : forall us n, length (mul_bi base n us) = (length us + n)%nat. - Proof. + Proof using Type. pose proof mul_bi'_length; unfold mul_bi. destruct us; repeat progress (simpl_list; boring). Qed. @@ -451,7 +471,7 @@ Section BaseSystemProofs. Lemma mul_bi_trailing_zeros : forall m n us, mul_bi base n us ++ zeros m = mul_bi base n (us ++ zeros m). - Proof. + Proof using Type. unfold mul_bi. induction m; intros; try solve [boring]. rewrite <- zeros_app0. @@ -462,7 +482,7 @@ Section BaseSystemProofs. Lemma mul_bi_add_longer : forall n us vs, (length us >= length vs)%nat -> mul_bi base n (us .+ vs) = mul_bi base n us .+ mul_bi base n vs. - Proof. + Proof using Type. boring. rewrite add_trailing_zeros by auto. rewrite (add_trailing_zeros (mul_bi base n us) (mul_bi base n vs)) @@ -475,7 +495,7 @@ Section BaseSystemProofs. Lemma mul_bi_add : forall n us vs, mul_bi base n (us .+ vs) = (mul_bi base n us) .+ (mul_bi base n vs). - Proof. + Proof using Type. intros; pose proof mul_bi_add_longer. destruct (le_ge_dec (length us) (length vs)). { rewrite add_comm. @@ -489,7 +509,7 @@ Section BaseSystemProofs. Lemma mul_bi_rep : forall i vs, (i + length vs < length base)%nat -> decode base (mul_bi base i vs) = decode base vs * nth_default 0 base i. - Proof. + Proof using Type*. unfold decode. induction vs using rev_ind; intros; try solve [unfold mul_bi; boring]. assert (i + length vs < length base)%nat by @@ -511,7 +531,7 @@ Section BaseSystemProofs. Lemma mul'_rep : forall us vs, (length us + length vs <= length base)%nat -> decode base (mul' (rev us) vs) = decode base us * decode base vs. - Proof. + Proof using Type*. unfold decode. induction us using rev_ind; boring. @@ -530,13 +550,13 @@ Section BaseSystemProofs. Lemma mul_rep : forall us vs, (length us + length vs <= length base)%nat -> decode base (mul us vs) = decode base us * decode base vs. - Proof. + Proof using Type*. exact mul'_rep. Qed. Lemma mul'_length: forall us vs, (length (mul' us vs) <= length us + length vs)%nat. - Proof. + Proof using Type. pose proof add_length_le_max. induction us; boring. unfold mul_each. @@ -545,7 +565,7 @@ Section BaseSystemProofs. Lemma mul_length: forall us vs, (length (mul us vs) <= length us + length vs)%nat. - Proof. + Proof using Type. intros; unfold BaseSystem.mul. rewrite mul'_length. rewrite rev_length; omega. @@ -553,7 +573,7 @@ Section BaseSystemProofs. Lemma add_length_exact : forall us vs, length (us .+ vs) = max (length us) (length vs). - Proof. + Proof using Type. induction us; destruct vs; boring. Qed. @@ -564,7 +584,7 @@ Section BaseSystemProofs. | 0 => 0%nat | _ => pred (length us + length vs) end)%nat. - Proof. + Proof using Type. induction us; intros; try solve [boring]. unfold BaseSystem.mul'; fold mul'. unfold mul_each. @@ -583,7 +603,7 @@ Section BaseSystemProofs. Lemma mul'_length_exact: forall us vs, (length us <= length vs)%nat -> us <> nil -> (length (mul' us vs) = pred (length us + length vs))%nat. - Proof. + Proof using Type. intros; rewrite mul'_length_exact_full; destruct us; simpl; congruence. Qed. @@ -592,7 +612,7 @@ Section BaseSystemProofs. | 0 => 0 | _ => pred (length us + length vs) end)%nat. - Proof. + Proof using Type. intros; unfold BaseSystem.mul; autorewrite with distr_length; reflexivity. Qed. @@ -603,7 +623,7 @@ Section BaseSystemProofs. Lemma mul_length_exact: forall us vs, (length us <= length vs)%nat -> us <> nil -> (length (mul us vs) = pred (length us + length vs))%nat. - Proof. + Proof using Type. intros; unfold BaseSystem.mul. rewrite mul'_length_exact; rewrite ?rev_length; try omega. intro rev_nil. @@ -618,7 +638,7 @@ Section BaseSystemProofs. Hint Resolve encode'_zero encode'_succ. Lemma encode'_length : forall z max i, length (encode' base z max i) = i. - Proof. + Proof using Type. induction i; auto. rewrite encode'_succ, app_length, IHi. cbv [length]. @@ -634,7 +654,7 @@ Section BaseSystemProofs. Lemma encode'_spec : forall z max, 0 < max -> base_max_succ_divide max -> forall i, (i <= length base)%nat -> decode' base (encode' base z max i) = z mod (nth_default max base i). - Proof. + Proof using Type*. induction i; intros. + rewrite encode'_zero, b0_1, Z.mod_1_r. apply decode_nil. @@ -653,7 +673,7 @@ Section BaseSystemProofs. Lemma encode_rep : forall z max, 0 <= z < max -> base_max_succ_divide max -> decode base (encode base z max) = z. - Proof. + Proof using Type*. unfold encode; intros. rewrite encode'_spec, nth_default_out_of_bounds by (omega || auto). apply Z.mod_small; omega. @@ -669,7 +689,7 @@ Section MultiBaseSystemProofs. Lemma decode_short_initial : forall (us : digits), (firstn (length us) base0 = firstn (length us) base1) -> decode base0 us = decode base1 us. - Proof. + Proof using Type. intros us H. unfold decode, decode'. rewrite (combine_truncate_r us base0), (combine_truncate_r us base1), H. @@ -681,7 +701,7 @@ Section MultiBaseSystemProofs. -> firstn (length us) base0 = firstn (length us) base1 -> firstn (length vs) base0 = firstn (length vs) base1 -> (decode base0 us) * (decode base0 vs) = decode base1 (mul base1 us vs). - Proof. + Proof using base_vector1. intros. rewrite mul_rep by trivial. apply f_equal2; apply decode_short_initial; assumption. diff --git a/src/BoundedArithmetic/Double/Proofs/BitwiseOr.v b/src/BoundedArithmetic/Double/Proofs/BitwiseOr.v index 048b83887..9d5b409f8 100644 --- a/src/BoundedArithmetic/Double/Proofs/BitwiseOr.v +++ b/src/BoundedArithmetic/Double/Proofs/BitwiseOr.v @@ -16,7 +16,7 @@ Section bitwise_or. Global Instance is_bitwise_or_double : is_bitwise_or or_double. - Proof. + Proof using Type*. constructor; intros x y. destruct n as [|p|]. { rewrite !(tuple_decoder_n_O (W:=W) 2); easy. } diff --git a/src/BoundedArithmetic/Double/Proofs/Decode.v b/src/BoundedArithmetic/Double/Proofs/Decode.v index 1c5a6495a..e3d57bdfc 100644 --- a/src/BoundedArithmetic/Double/Proofs/Decode.v +++ b/src/BoundedArithmetic/Double/Proofs/Decode.v @@ -26,7 +26,7 @@ Section decode. Lemma decode_bounded {isdecode : is_decode decode} w : 0 <= n -> bounded limb_widths (List.map decode (rev (to_list k w))). - Proof. + Proof using Type. intro. eapply bounded_uniform; try solve [ eauto using repeat_spec ]. { distr_length. } @@ -38,7 +38,7 @@ Section decode. (** TODO: Clean up this proof *) Global Instance tuple_is_decode {isdecode : is_decode decode} : is_decode (tuple_decoder (k := k)). - Proof. + Proof using Type. unfold tuple_decoder; hnf; simpl. intro w. destruct (zerop k); [ subst | ]. @@ -59,7 +59,7 @@ Section decode. Local Arguments repeat : simpl never. Local Arguments Z.mul !_ !_. Lemma tuple_decoder_S {k} w : 0 <= n -> (tuple_decoder (k := S (S k)) w = tuple_decoder (k := S k) (fst w) + (decode (snd w) << (S k * n)))%Z. - Proof. + Proof using Type. intro Hn. destruct w as [? w]; simpl. replace (decode w) with (decode w * 1 + 0)%Z by omega. @@ -70,16 +70,16 @@ Section decode. reflexivity. Qed. Global Instance tuple_decoder_O w : tuple_decoder (k := 1) w =~> decode w. - Proof. + Proof using Type. unfold tuple_decoder, BaseSystem.decode, BaseSystem.decode', accumulate, base_from_limb_widths, repeat. simpl; hnf. omega. Qed. Global Instance tuple_decoder_m1 w : tuple_decoder (k := 0) w =~> 0. - Proof. reflexivity. Qed. + Proof using Type. reflexivity. Qed. Lemma tuple_decoder_n_neg k w {H : is_decode decode} : n <= 0 -> tuple_decoder (k := k) w =~> 0. - Proof. + Proof using Type. pose proof (tuple_is_decode w) as H'; hnf in H'. intro; assert (k * n <= 0) by nia. assert (2^(k * n) <= 2^0) by (apply Z.pow_le_mono_r; omega). @@ -91,7 +91,7 @@ Section decode. (P_ext : forall n (a b : decoder n W), (forall x, a x = b x) -> P _ a -> P _ b) : (P _ (tuple_decoder (k := 1)) -> P _ decode) * (P _ decode -> P _ (tuple_decoder (k := 1))). - Proof. + Proof using Type. unfold tuple_decoder, BaseSystem.decode, BaseSystem.decode', accumulate, base_from_limb_widths, repeat. simpl; hnf. rewrite Z.mul_1_l. @@ -99,12 +99,12 @@ Section decode. Qed. Global Instance tuple_decoder_2' w : (0 <= n)%bounded_rewrite -> tuple_decoder (k := 2) w <~= (decode (fst w) + decode (snd w) << (1%nat * n))%Z. - Proof. + Proof using Type. intros; rewrite !tuple_decoder_S, !tuple_decoder_O by assumption. reflexivity. Qed. Global Instance tuple_decoder_2 w : (0 <= n)%bounded_rewrite -> tuple_decoder (k := 2) w <~= (decode (fst w) + decode (snd w) << n)%Z. - Proof. + Proof using Type. intros; rewrite !tuple_decoder_S, !tuple_decoder_O by assumption. autorewrite with zsimplify_const; reflexivity. Qed. diff --git a/src/BoundedArithmetic/Double/Proofs/LoadImmediate.v b/src/BoundedArithmetic/Double/Proofs/LoadImmediate.v index 155845760..9c00b728f 100644 --- a/src/BoundedArithmetic/Double/Proofs/LoadImmediate.v +++ b/src/BoundedArithmetic/Double/Proofs/LoadImmediate.v @@ -18,7 +18,7 @@ Section load_immediate. Global Instance is_load_immediate_double : is_load_immediate (ldi_double n). - Proof. + Proof using Type*. intros x H; hnf in H. pose proof (decode_exponent_nonnegative decode (ldi x)). assert (0 <= x mod 2^n < 2^n) by auto with zarith. diff --git a/src/BoundedArithmetic/Double/Proofs/Multiply.v b/src/BoundedArithmetic/Double/Proofs/Multiply.v index bb09f8b2b..6d2f72c25 100644 --- a/src/BoundedArithmetic/Double/Proofs/Multiply.v +++ b/src/BoundedArithmetic/Double/Proofs/Multiply.v @@ -73,7 +73,7 @@ Section tuple2. Lemma decode_mul_double_mod x y : (tuple_decoder (mul_double half_n x y) = (decode x * decode y) mod (2^(2 * half_n) * 2^(2*half_n)))%Z. - Proof. + Proof using Type*. assert (0 <= 2 * half_n) by eauto using decode_exponent_nonnegative. assert (0 <= half_n) by omega. unfold mul_double, Let_In. @@ -94,13 +94,13 @@ Section tuple2. Lemma decode_mul_double_function x y : tuple_decoder (mul_double half_n x y) = (decode x * decode y)%Z. - Proof. + Proof using Type*. rewrite decode_mul_double_mod; generalize_decode_var. simpl in *; Z.rewrite_mod_small; reflexivity. Qed. Global Instance mul_double_is_multiply_double : is_mul_double mul_double_multiply. - Proof. + Proof using Type*. apply decode_mul_double_iff; apply decode_mul_double_function. Qed. End full_from_half. @@ -123,10 +123,10 @@ Section tuple2. try reflexivity. Global Instance mul_double_is_multiply_low_low : is_mul_low_low n mul_double_multiply_low_low. - Proof. t. Qed. + Proof using Type*. t. Qed. Global Instance mul_double_is_multiply_high_low : is_mul_high_low n mul_double_multiply_high_low. - Proof. t. Qed. + Proof using Type*. t. Qed. Global Instance mul_double_is_multiply_high_high : is_mul_high_high n mul_double_multiply_high_high. - Proof. t. Qed. + Proof using Type*. t. Qed. End half_from_full. End tuple2. diff --git a/src/BoundedArithmetic/Double/Proofs/RippleCarryAddSub.v b/src/BoundedArithmetic/Double/Proofs/RippleCarryAddSub.v index 672a62685..5d9443a91 100644 --- a/src/BoundedArithmetic/Double/Proofs/RippleCarryAddSub.v +++ b/src/BoundedArithmetic/Double/Proofs/RippleCarryAddSub.v @@ -71,7 +71,7 @@ Section carry_sub_is_good. Lemma carry_sub_is_good_carry : ((z1 - if z0 <? 0 then 1 else 0) <? 0) = ((z0 + z1 << k) <? 0). - Proof. + Proof using Hk Hz0. clear n Hn Hz1. assert (0 < 2 ^ k) by auto with zarith. autorewrite with Zshift_to_pow. @@ -88,7 +88,7 @@ Section carry_sub_is_good. Lemma carry_sub_is_good_value : (z0 mod 2 ^ k + ((z1 - if z0 <? 0 then 1 else 0) mod 2 ^ n) << k)%Z = (z0 + z1 << k) mod (2 ^ k * 2 ^ n). - Proof. + Proof using Type*. assert (0 < 2 ^ n) by auto with zarith. assert (0 < 2 ^ k) by auto with zarith. assert (0 < 2^n * 2^k) by nia. @@ -119,14 +119,14 @@ Section ripple_carry_adc. let '(carry, zs) := eta (ripple_carry_adc (k := S k) adc xs ys carry) in let '(carry, z) := eta (adc x y carry) in (carry, (zs, z)). - Proof. apply ripple_carry_tuple_SS. Qed. + Proof using Type. apply ripple_carry_tuple_SS. Qed. Local Opaque Z.of_nat. Global Instance ripple_carry_is_add_with_carry {k} {isdecode : is_decode decode} {is_adc : is_add_with_carry adc} : is_add_with_carry (ripple_carry_adc (k := k) adc). - Proof. + Proof using Type. destruct k as [|k]. { constructor; simpl; intros; autorewrite with zsimplify; reflexivity. } { induction k as [|k IHk]. @@ -163,14 +163,14 @@ Section ripple_carry_subc. let '(carry, zs) := eta (ripple_carry_subc (k := S k) subc xs ys carry) in let '(carry, z) := eta (subc x y carry) in (carry, (zs, z)). - Proof. apply ripple_carry_tuple_SS. Qed. + Proof using Type. apply ripple_carry_tuple_SS. Qed. Local Opaque Z.of_nat. Global Instance ripple_carry_is_sub_with_carry {k} {isdecode : is_decode decode} {is_subc : is_sub_with_carry subc} : is_sub_with_carry (ripple_carry_subc (k := k) subc). - Proof. + Proof using Type. destruct k as [|k]. { constructor; repeat (intros [] || intro); autorewrite with simpl_tuple_decoder zsimplify; reflexivity. } { induction k as [|k IHk]. diff --git a/src/BoundedArithmetic/Double/Proofs/SelectConditional.v b/src/BoundedArithmetic/Double/Proofs/SelectConditional.v index 41ae9dc3b..8dd12e0bc 100644 --- a/src/BoundedArithmetic/Double/Proofs/SelectConditional.v +++ b/src/BoundedArithmetic/Double/Proofs/SelectConditional.v @@ -12,7 +12,7 @@ Section select_conditional. Global Instance is_select_conditional_double : is_select_conditional selc_double. - Proof. + Proof using Type*. intros b x y. destruct n. { rewrite !(tuple_decoder_n_O (W:=W) 2); now destruct b. } diff --git a/src/BoundedArithmetic/Double/Proofs/ShiftLeft.v b/src/BoundedArithmetic/Double/Proofs/ShiftLeft.v index 193dc59bf..759c05e6e 100644 --- a/src/BoundedArithmetic/Double/Proofs/ShiftLeft.v +++ b/src/BoundedArithmetic/Double/Proofs/ShiftLeft.v @@ -26,7 +26,7 @@ Section shl. {isor : is_bitwise_or or}. Global Instance is_shift_left_immediate_double : is_shift_left_immediate (shl_double n). - Proof. + Proof using Type*. intros r count H; hnf in H. assert (0 < 2^count) by auto with zarith. assert (0 < 2^(n+count)) by auto with zarith. diff --git a/src/BoundedArithmetic/Double/Proofs/ShiftRight.v b/src/BoundedArithmetic/Double/Proofs/ShiftRight.v index dde19595e..f2509927f 100644 --- a/src/BoundedArithmetic/Double/Proofs/ShiftRight.v +++ b/src/BoundedArithmetic/Double/Proofs/ShiftRight.v @@ -26,7 +26,7 @@ Section shr. {isor : is_bitwise_or or}. Global Instance is_shift_right_immediate_double : is_shift_right_immediate (shr_double n). - Proof. + Proof using Type*. intros r count H; hnf in H. assert (0 < 2^count) by auto with zarith. assert (0 < 2^(n+count)) by auto with zarith. diff --git a/src/BoundedArithmetic/Double/Proofs/ShiftRightDoubleWordImmediate.v b/src/BoundedArithmetic/Double/Proofs/ShiftRightDoubleWordImmediate.v index dce9940d5..7e9f5ddcd 100644 --- a/src/BoundedArithmetic/Double/Proofs/ShiftRightDoubleWordImmediate.v +++ b/src/BoundedArithmetic/Double/Proofs/ShiftRightDoubleWordImmediate.v @@ -24,7 +24,7 @@ Section shrd. Local Ltac zutil_arith ::= solve [ auto with nocore omega ]. Global Instance is_shift_right_doubleword_immediate_double : is_shift_right_doubleword_immediate (shrd_double n). - Proof. + Proof using isdecode isshrd. intros high low count Hcount; hnf in Hcount. unfold shrd_double, shift_right_doubleword_immediate_double; simpl. generalize (decode_range low). diff --git a/src/BoundedArithmetic/Double/Proofs/SpreadLeftImmediate.v b/src/BoundedArithmetic/Double/Proofs/SpreadLeftImmediate.v index f2061bafe..84f24eef5 100644 --- a/src/BoundedArithmetic/Double/Proofs/SpreadLeftImmediate.v +++ b/src/BoundedArithmetic/Double/Proofs/SpreadLeftImmediate.v @@ -61,7 +61,7 @@ Section tuple2. r count (H : 0 < count < n) : (decode (shl r count) + decode (shr r (n - count)) << n = decode r << count mod (2^n*2^n))%Z. - Proof. + Proof using isdecode isshl isshr. assert (0 <= count < n) by lia. assert (0 <= n - count < n) by lia. assert (0 < 2^(n-count)) by auto with zarith. @@ -80,7 +80,7 @@ Section tuple2. Global Instance is_spread_left_from_shift : is_spread_left_immediate (sprl_from_shift n). - Proof. + Proof using Type*. apply is_spread_left_immediate_alt. intros r count; intros. pose proof (decode_range r). @@ -124,7 +124,7 @@ Section tuple2. r : (decode (shl r half_n) + decode (shr r half_n) * (2^half_n * 2^half_n) = (decode r * 2^half_n) mod (2^half_n*2^half_n*2^half_n*2^half_n))%Z. - Proof. + Proof using Type*. destruct (0 <? half_n) eqn:Hn; Z.ltb_to_lt. { pose proof (spread_left_from_shift_correct (2*half_n) r half_n) as H. specialize_by lia. diff --git a/src/BoundedArithmetic/Double/Repeated/Proofs/Multiply.v b/src/BoundedArithmetic/Double/Repeated/Proofs/Multiply.v index 2c7a0ad1b..a00e0c891 100644 --- a/src/BoundedArithmetic/Double/Repeated/Proofs/Multiply.v +++ b/src/BoundedArithmetic/Double/Repeated/Proofs/Multiply.v @@ -64,7 +64,7 @@ Section multiply. : (is_mul_low_low (Z.of_nat 2^Z.of_nat exp * n_over_two) (multiply_low_low_repeated_double (exp:=exp)) * is_mul_high_low (Z.of_nat 2^Z.of_nat exp * n_over_two) (multiply_high_low_repeated_double (exp:=exp)) * is_mul_high_high (Z.of_nat 2^Z.of_nat exp * n_over_two) (multiply_high_high_repeated_double (exp:=exp)))%type. - Proof. + Proof using Type*. destruct exp as [|exp']; [ clear is_multi_multiply_repeated_double | specialize (is_multi_multiply_repeated_double exp') ]. { destruct decode; generalize ismulhwll, ismulhwhl, ismulhwhh. simpl. diff --git a/src/BoundedArithmetic/Double/Repeated/Proofs/ShiftLeftRight.v b/src/BoundedArithmetic/Double/Repeated/Proofs/ShiftLeftRight.v index 401e3a015..acda67158 100644 --- a/src/BoundedArithmetic/Double/Repeated/Proofs/ShiftLeftRight.v +++ b/src/BoundedArithmetic/Double/Repeated/Proofs/ShiftLeftRight.v @@ -32,7 +32,7 @@ Section shift_left_right. Fixpoint is_shift_left_right_immediate_repeated_double {exp : nat} : (is_shift_left_immediate (shift_left_immediate_repeated_double (exp:=exp)) * is_shift_right_immediate (shift_right_immediate_repeated_double (exp:=exp)))%type. - Proof. is_cls_fixpoint_t2 decode n exp is_shl is_shr (@is_shift_left_right_immediate_repeated_double). Qed. + Proof using Type*. is_cls_fixpoint_t2 decode n exp is_shl is_shr (@is_shift_left_right_immediate_repeated_double). Qed. Global Instance is_shift_left_immediate_repeated_double {exp : nat} : is_shift_left_immediate (shift_left_immediate_repeated_double (exp:=exp)) := fst (@is_shift_left_right_immediate_repeated_double exp). diff --git a/src/BoundedArithmetic/InterfaceProofs.v b/src/BoundedArithmetic/InterfaceProofs.v index 25cd09e85..85120f50c 100644 --- a/src/BoundedArithmetic/InterfaceProofs.v +++ b/src/BoundedArithmetic/InterfaceProofs.v @@ -48,7 +48,7 @@ Section InstructionGallery. {isdecode : is_decode Wdecoder} : is_spread_left_immediate sprl <-> (forall r count, 0 <= count < n -> decode (fst (sprl r count)) + decode (snd (sprl r count)) << n = (decode r << count) mod (2^n*2^n))%Z. - Proof. + Proof using Type. split; intro H; [ | apply Build_is_spread_left_immediate' ]; intros r count Hc; [ | specialize (H r count Hc); revert H ]; @@ -70,7 +70,7 @@ Section InstructionGallery. {isdecode : is_decode Wdecoder} : is_mul_double muldw <-> (forall x y, decode (fst (muldw x y)) + decode (snd (muldw x y)) << n = (decode x * decode y) mod (2^n*2^n)). - Proof. + Proof using Type. split; intro H; [ | apply Build_is_mul_double' ]; intros x y; [ | specialize (H x y); revert H ]; @@ -136,19 +136,19 @@ Section adc_subc. {issubc : is_sub_with_carry subc}. Global Instance bit_fst_add_with_carry_false : forall x y, bit (fst (adc x y false)) <~=~> (decode x + decode y) >> n. - Proof. + Proof using isadc. intros; erewrite bit_fst_add_with_carry by assumption. autorewrite with zsimplify_const; reflexivity. Qed. Global Instance bit_fst_add_with_carry_true : forall x y, bit (fst (adc x y true)) <~=~> (decode x + decode y + 1) >> n. - Proof. + Proof using isadc. intros; erewrite bit_fst_add_with_carry by assumption. autorewrite with zsimplify_const; reflexivity. Qed. Global Instance fst_add_with_carry_leb : forall x y c, fst (adc x y c) <~= (2^n <=? (decode x + decode y + bit c)). - Proof. + Proof using isadc isdecode. intros x y c; hnf. assert (0 <= n)%Z by eauto using decode_exponent_nonnegative. pose proof (decode_range x); pose proof (decode_range y). @@ -165,25 +165,25 @@ Section adc_subc. Qed. Global Instance fst_add_with_carry_false_leb : forall x y, fst (adc x y false) <~= (2^n <=? (decode x + decode y)). - Proof. + Proof using isadc isdecode. intros; erewrite fst_add_with_carry_leb by assumption. autorewrite with zsimplify_const; reflexivity. Qed. Global Instance fst_add_with_carry_true_leb : forall x y, fst (adc x y true) <~=~> (2^n <=? (decode x + decode y + 1)). - Proof. + Proof using isadc isdecode. intros; erewrite fst_add_with_carry_leb by assumption. autorewrite with zsimplify_const; reflexivity. Qed. Global Instance fst_sub_with_carry_false : forall x y, fst (subc x y false) <~=~> ((decode x - decode y) <? 0). - Proof. + Proof using issubc. intros; erewrite fst_sub_with_carry by assumption. autorewrite with zsimplify_const; reflexivity. Qed. Global Instance fst_sub_with_carry_true : forall x y, fst (subc x y true) <~=~> ((decode x - decode y - 1) <? 0). - Proof. + Proof using issubc. intros; erewrite fst_sub_with_carry by assumption. autorewrite with zsimplify_const; reflexivity. Qed. diff --git a/src/CompleteEdwardsCurve/CompleteEdwardsCurveTheorems.v b/src/CompleteEdwardsCurve/CompleteEdwardsCurveTheorems.v index e3496775f..aba07fb46 100644 --- a/src/CompleteEdwardsCurve/CompleteEdwardsCurveTheorems.v +++ b/src/CompleteEdwardsCurve/CompleteEdwardsCurveTheorems.v @@ -70,7 +70,7 @@ Module E. Ltac t := repeat t_step; fsatz. Global Instance associative_add : is_associative(eq:=E.eq)(op:=add). - Proof. + Proof using Type. (* [nsatz_compute] for a denominator runs out of 6GB of stack space *) (* COQBUG: https://coq.inria.fr/bugs/show_bug.cgi?id=5359 *) Add Field _field : (Algebra.Field.field_theory_for_stdlib_tactic (T:=F)). @@ -83,24 +83,24 @@ Module E. Qed. Global Instance edwards_curve_abelian_group : abelian_group (eq:=eq)(op:=add)(id:=zero)(inv:=opp). - Proof. t. Qed. + Proof using Type. t. Qed. - Global Instance Proper_coordinates : Proper (eq==>fieldwise (n:=2) Feq) coordinates. Proof. repeat t_step. Qed. + Global Instance Proper_coordinates : Proper (eq==>fieldwise (n:=2) Feq) coordinates. Proof using Type. repeat t_step. Qed. Global Instance Proper_mul : Proper (Logic.eq==>eq==>eq) mul. - Proof. + Proof using Type. intros n n'; repeat intro; subst n'. induction n; (reflexivity || eapply (_:Proper (eq==>eq==>eq) add); eauto). Qed. Global Instance mul_is_scalarmult : @is_scalarmult point eq add zero mul. - Proof. split; intros; (reflexivity || exact _). Qed. + Proof using Type. split; intros; (reflexivity || exact _). Qed. Section PointCompression. Local Notation "x ^ 2" := (x*x). Lemma solve_correct x y : onCurve x y <-> (x^2 = (y^2-1) / (d*y^2-a)). - Proof. destruct square_a as [sqrt_a]; pose proof (nonsquare_d (sqrt_a/y)); + Proof using Feq_dec field nonsquare_d nonzero_a square_a. destruct square_a as [sqrt_a]; pose proof (nonsquare_d (sqrt_a/y)); split; intros; fsatz. Qed. (* TODO: move *) @@ -110,11 +110,11 @@ Module E. Lemma exist_option_Some {A} P (x:option A) pf s (H:Logic.eq (exist_option P x pf) (Some s)) : Logic.eq x (Some (proj1_sig s)). - Proof. destruct x, s; cbv [exist_option proj1_sig] in *; congruence. Qed. + Proof using Type. destruct x, s; cbv [exist_option proj1_sig] in *; congruence. Qed. Lemma exist_option_None {A} P (x:option A) pf (H:Logic.eq (exist_option P x pf) None) : Logic.eq x None. - Proof. destruct x; cbv [exist_option proj1_sig] in *; congruence. Qed. + Proof using Type. destruct x; cbv [exist_option proj1_sig] in *; congruence. Qed. Context {sqrt_div:F -> F -> option F} @@ -135,7 +135,7 @@ Module E. else None. Lemma set_sign_None r p s (H:Logic.eq (set_sign r p) (Some s)) : s^2 = r^2 /\ Logic.eq (parity s) p. - Proof. + Proof using Feq_dec field nonzero_a. repeat match goal with | _ => progress subst | _ => progress cbv [set_sign] in * @@ -197,7 +197,7 @@ Module E. Lemma decompress_Some b P (H:Logic.eq (decompress b) (Some P)) : Logic.eq (compress P) b. - Proof. cbv [compress decompress] in *; t. Qed. + Proof using Type. cbv [compress decompress] in *; t. Qed. Lemma decompress_None b (H:Logic.eq (decompress b) None) : forall P, not (Logic.eq (compress P) b). @@ -235,7 +235,7 @@ Module E. Context {Ka} {Ha:Keq (FtoK Fa) Ka} {Kd} {Hd:Keq (FtoK Fd) Kd}. Lemma nonzero_Ka : ~ Keq Ka Kzero. - Proof. + Proof using Feq_dec HFtoK HKtoF Ha HisoF Keq_dec field fieldK nonzero_a. rewrite <-Ha. Ring.pull_homomorphism FtoK. intro X. @@ -245,14 +245,14 @@ Module E. Qed. Lemma square_Ka : exists sqrt_a, Keq (Kmul sqrt_a sqrt_a) Ka. - Proof. + Proof using Feq_dec HFtoK Ha Keq_dec field fieldK square_a. destruct square_a as [sqrt_a]. exists (FtoK sqrt_a). Ring.pull_homomorphism FtoK. rewrite <-Ha. eapply Monoid.is_homomorphism_phi_proper; assumption. Qed. Lemma nonsquare_Kd : forall x, not (Keq (Kmul x x) Kd). - Proof. + Proof using Feq_dec HKtoF Hd HisoF Keq_dec field fieldK nonsquare_d. intros x X. apply (nonsquare_d (KtoF x)). Ring.pull_homomorphism KtoF. rewrite X. rewrite <-Hd, HisoF. reflexivity. @@ -286,7 +286,7 @@ Module E. Qed. Lemma Proper_point_phi : Proper (eq==>eq) point_phi. - Proof. + Proof using Type. intros P Q H. destruct P as [ [? ?] ?], Q as [ [? ?] ?], H as [Hl Hr]; cbv. rewrite !Hl, !Hr. split; reflexivity. @@ -294,7 +294,7 @@ Module E. Lemma lift_ismorphism : @Monoid.is_homomorphism Fpoint eq FaddP Kpoint eq KaddP point_phi. - Proof. + Proof using Type. repeat match goal with | |- _ => intro | |- Monoid.is_homomorphism => split diff --git a/src/CompleteEdwardsCurve/ExtendedCoordinates.v b/src/CompleteEdwardsCurve/ExtendedCoordinates.v index 2545a57d4..f05a1d997 100644 --- a/src/CompleteEdwardsCurve/ExtendedCoordinates.v +++ b/src/CompleteEdwardsCurve/ExtendedCoordinates.v @@ -53,7 +53,7 @@ Module Extended. Ltac t := repeat t_step; Field.fsatz. Global Instance Equivalence_eq : Equivalence eq. - Proof. split; repeat intro; t. Qed. + Proof using Feq_dec field nonzero_a. split; repeat intro; t. Qed. Global Instance DecidableRel_eq : Decidable.DecidableRel eq. Proof. intros P Q; destruct P as [ [ [ [ ] ? ] ? ] ?], Q as [ [ [ [ ] ? ] ? ] ? ]; exact _. Defined. @@ -61,7 +61,7 @@ Module Extended. let xy := E.coordinates P in (fst xy, snd xy, 1, fst xy * snd xy). Next Obligation. t. Qed. Global Instance Proper_from_twisted : Proper (E.eq==>eq) from_twisted. - Proof. cbv [from_twisted]; t. Qed. + Proof using Type. cbv [from_twisted]; t. Qed. Program Definition to_twisted (P:point) : Epoint := let XYZT := coordinates P in let T := snd XYZT in @@ -71,12 +71,12 @@ Module Extended. let iZ := Finv Z in ((X*iZ), (Y*iZ)). Next Obligation. t. Qed. Global Instance Proper_to_twisted : Proper (eq==>E.eq) to_twisted. - Proof. cbv [to_twisted]; t. Qed. + Proof using Type. cbv [to_twisted]; t. Qed. Lemma to_twisted_from_twisted P : E.eq (to_twisted (from_twisted P)) P. - Proof. cbv [to_twisted from_twisted]; t. Qed. + Proof using Type. cbv [to_twisted from_twisted]; t. Qed. Lemma from_twisted_to_twisted P : eq (from_twisted (to_twisted P)) P. - Proof. cbv [to_twisted from_twisted]; t. Qed. + Proof using Type. cbv [to_twisted from_twisted]; t. Qed. Program Definition zero : point := (0, 1, 1, 0). Next Obligation. t. Qed. diff --git a/src/CompleteEdwardsCurve/Pre.v b/src/CompleteEdwardsCurve/Pre.v index 96d2ebfb3..4dfd01cfd 100644 --- a/src/CompleteEdwardsCurve/Pre.v +++ b/src/CompleteEdwardsCurve/Pre.v @@ -20,13 +20,15 @@ Section Edwards. Context {char_ge_3:@Ring.char_ge F eq zero one opp add sub mul 3}. Local Notation onCurve x y := (a*x^2 + y^2 = 1 + d*x^2*y^2) (only parsing). - Lemma onCurve_zero : onCurve 0 1. fsatz. Qed. + Lemma onCurve_zero : onCurve 0 1. + Proof using a_nonzero eq_dec field. + fsatz. Qed. Section Addition. Context (x1 y1:F) (P1onCurve: onCurve x1 y1). Context (x2 y2:F) (P2onCurve: onCurve x2 y2). Lemma denominator_nonzero : (d*x1*x2*y1*y2)^2 <> 1. - Proof. + Proof using Type*. destruct a_square as [sqrt_a], (dec(sqrt_a*x2+y2 = 0)), (dec(sqrt_a*x2-y2 = 0)); try match goal with [H: ?f (sqrt_a * x2) y2 <> 0 |- _ ] => pose proof (d_nonsquare ((f (sqrt_a * x1) (d * x1 * x2 * y1 * y2 * y1)) @@ -35,10 +37,10 @@ Section Edwards. Qed. Lemma denominator_nonzero_x : 1 + d*x1*x2*y1*y2 <> 0. - Proof. pose proof denominator_nonzero. Field.fsatz. Qed. + Proof using Type*. pose proof denominator_nonzero. Field.fsatz. Qed. Lemma denominator_nonzero_y : 1 - d*x1*x2*y1*y2 <> 0. - Proof. pose proof denominator_nonzero. Field.fsatz. Qed. + Proof using Type*. pose proof denominator_nonzero. Field.fsatz. Qed. Lemma onCurve_add : onCurve ((x1*y2 + y1*x2)/(1 + d*x1*x2*y1*y2)) ((y1*y2 - a*x1*x2)/(1 - d*x1*x2*y1*y2)). - Proof. pose proof denominator_nonzero. Field.fsatz. Qed. + Proof using Type*. pose proof denominator_nonzero. Field.fsatz. Qed. End Addition. End Edwards.
\ No newline at end of file diff --git a/src/EdDSARepChange.v b/src/EdDSARepChange.v index e52070249..0a214dc88 100644 --- a/src/EdDSARepChange.v +++ b/src/EdDSARepChange.v @@ -21,7 +21,7 @@ Section EdDSA. Local Notation valid := (@valid E Eeq Eadd EscalarMult b H l B Eenc Senc). Lemma sign_valid : forall A_ sk {n} (M:word n), A_ = public sk -> valid M A_ (sign A_ sk M). - Proof. + Proof using Type. cbv [sign public Spec.EdDSA.valid]; intros; subst; repeat match goal with | |- exists _, _ => eexists @@ -51,7 +51,7 @@ Section EdDSA. Context {Proper_Eenc : Proper (Eeq==>Logic.eq) Eenc}. Global Instance Proper_eq_Eenc ref : Proper (Eeq ==> iff) (fun P => Eenc P = ref). - Proof. intros ? ? Hx; rewrite Hx; reflexivity. Qed. + Proof using Proper_Eenc. intros ? ? Hx; rewrite Hx; reflexivity. Qed. Context {Edec:word b-> option E} {eq_enc_E_iff: forall P_ P, Eenc P = P_ <-> option_eq Eeq (Edec P_) (Some P)}. Context {Sdec:word b-> option (F l)} {eq_enc_S_iff: forall n_ n, Senc n = n_ <-> Sdec n_ = Some n}. @@ -99,7 +99,7 @@ Section EdDSA. Eval cbv [proj1_sig verify'_sig] in proj1_sig verify'_sig mlen message pk sig. Lemma verify'_correct : forall {mlen} (message:word mlen) pk sig, verify' message pk sig = true <-> valid message pk sig. - Proof. exact (proj2_sig verify'_sig). Qed. + Proof using Type*. exact (proj2_sig verify'_sig). Qed. Section ChangeRep. Context {Erep ErepEq ErepAdd ErepId ErepOpp} {Agroup:@group Erep ErepEq ErepAdd ErepId ErepOpp}. @@ -208,7 +208,7 @@ Section EdDSA. Eval cbv beta iota delta [proj1_sig verify_using_representation] in proj1_sig (verify_using_representation msg pk sig). Lemma verify_correct {mlen} (msg:word mlen) pk sig : verify msg pk sig = true <-> valid msg pk sig. - Proof. + Proof using Type*. etransitivity; [|eapply (verify'_correct msg pk sig)]. eapply iff_R_R_same_r, (proj2_sig (verify_using_representation _ _ _)). Qed. @@ -242,7 +242,7 @@ Section EdDSA. Lemma splitSecretPrngCurve_correct sk : let (s, r) := splitSecretPrngCurve sk in SRepEq s (S2Rep (F.of_nat l (curveKey sk))) /\ r = prngKey (H:=H) sk. - Proof. + Proof using H0 SRepDecModLShort_correct. cbv [splitSecretPrngCurve EdDSA.curveKey EdDSA.prngKey Let_In]; split; repeat ( reflexivity @@ -270,13 +270,15 @@ Section EdDSA. ERepEnc R ++ SRepEnc S. Lemma to_nat_l_nonzero : Z.to_nat l <> 0. + Proof using n_le_bpb. + intro Hx; change 0 with (Z.to_nat 0) in Hx. destruct prm; rewrite Z2Nat.inj_iff in Hx; omega. Qed. Lemma sign_correct (pk sk : word b) {mlen} (msg:word mlen) : sign pk sk msg = EdDSA.sign pk sk msg. - Proof. + Proof using Agroup Ahomom ERepEnc_correct ErepB_correct H0 Proper_ERepEnc Proper_SRepAdd Proper_SRepERepMul Proper_SRepEnc Proper_SRepMul SRepAdd_correct SRepDecModLShort_correct SRepDecModL_correct SRepERepMul_correct SRepEnc_correct SRepMul_correct. cbv [sign EdDSA.sign Let_In]. let H := fresh "H" in diff --git a/src/Encoding/ModularWordEncodingPre.v b/src/Encoding/ModularWordEncodingPre.v index faf4eecc5..874bfdc9d 100644 --- a/src/Encoding/ModularWordEncodingPre.v +++ b/src/Encoding/ModularWordEncodingPre.v @@ -21,7 +21,7 @@ Section ModularWordEncodingPre. . Lemma Fm_encoding_valid : forall x, Fm_dec (Fm_enc x) = Some x. - Proof. + Proof using bound_check m_pos. unfold Fm_dec, Fm_enc; intros. pose proof (F.to_Z_range x m_pos). rewrite wordToN_NToWord_idempotent by (apply bound_check_nat_N; @@ -32,7 +32,7 @@ Section ModularWordEncodingPre. Qed. Lemma Fm_encoding_canonical : forall w x, Fm_dec w = Some x -> Fm_enc x = w. - Proof. + Proof using bound_check. unfold Fm_dec, Fm_enc; intros ? ? dec_Some. break_if; [ | congruence ]. inversion dec_Some. diff --git a/src/Encoding/ModularWordEncodingTheorems.v b/src/Encoding/ModularWordEncodingTheorems.v index dd36b3266..81d4fc5d3 100644 --- a/src/Encoding/ModularWordEncodingTheorems.v +++ b/src/Encoding/ModularWordEncodingTheorems.v @@ -16,7 +16,7 @@ Section SignBit. Context {m : positive} {prime_m : prime m} {two_lt_m : (2 < m)%Z} {sz : nat} {bound_check : (Z.to_nat m < 2 ^ sz)%nat}. Lemma sign_bit_parity : forall x, @sign_bit m sz x = Z.odd (F.to_Z x). - Proof. + Proof using Type*. unfold sign_bit, Fm_enc; intros. pose proof (shatter_word (NToWord sz (Z.to_N (F.to_Z x)))) as shatter. case_eq sz; intros; subst; rewrite shatter. @@ -32,12 +32,12 @@ Section SignBit. Qed. Lemma sign_bit_zero : @sign_bit m sz 0 = false. - Proof. + Proof using Type*. rewrite sign_bit_parity; auto. Qed. Lemma sign_bit_opp (x : F m) (Hnz:x <> 0) : negb (@sign_bit m sz x) = @sign_bit m sz (F.opp x). - Proof. + Proof using Type*. pose proof F.to_Z_nonzero_range x Hnz; specialize_by omega. rewrite !sign_bit_parity, F.to_Z_opp, Z_mod_nz_opp_full, Zmod_small, Z.odd_sub, (NumTheoryUtil.p_odd m), (Bool.xorb_true_l (Z.odd (F.to_Z x))); diff --git a/src/Experiments/GenericFieldPow.v b/src/Experiments/GenericFieldPow.v index 76d9cfa4f..033ed9363 100644 --- a/src/Experiments/GenericFieldPow.v +++ b/src/Experiments/GenericFieldPow.v @@ -66,7 +66,7 @@ Module F. Global Instance Proper_div : Proper (_==_ ==> _==_ ==> _==_) div. - Proof. + Proof using Type*. unfold div; repeat intro. repeat match goal with | [H: _ == _ |- _ ] => rewrite H; clear H @@ -74,7 +74,7 @@ Module F. Qed. Global Instance Proper_pow_pos : Proper (_==_==>eq==>_==_) pow_pos. - Proof. + Proof using Rr. cut (forall n (y x : F), x == y -> pow_pos x n == pow_pos y n); [repeat intro; subst; eauto|]. induction n; simpl; intros; trivial; @@ -82,7 +82,7 @@ Module F. Qed. Global Instance Propper_powZ : Proper (_==_==>eq==>_==_) powZ. - Proof. + Proof using Type*. repeat intro; subst; unfold powZ. match goal with |- context[match ?x with _ => _ end] => destruct x end; repeat (eapply Proper_pow_pos || f_equiv; trivial). @@ -90,13 +90,13 @@ Module F. Import Coq.setoid_ring.Field_theory Coq.setoid_ring.Field_tac. Lemma field_theory_for_tactic : field_theory 0 1 _+_ _*_ _-_ -_ _/_ inv _==_. - Proof. + Proof using Type*. split; repeat constructor; repeat intro; gen_rewrite; try cring; eauto using field_one_neq_zero, field_inv_def. Qed. Import Coq.setoid_ring.Ring_theory Coq.setoid_ring.NArithRing. Lemma power_theory_for_tactic : power_theory 1 _*_ _==_ NtoZ power. - Proof. constructor; destruct n; reflexivity. Qed. + Proof using Rr. constructor; destruct n; reflexivity. Qed. Create HintDb field_nonzero discriminated. Hint Resolve field_one_neq_zero : field_nonzero. @@ -107,10 +107,12 @@ Module F. power_tac power_theory_for_tactic [field_power_isconst]). Lemma div_mul_idemp_l : forall a b, (a==0 -> False) -> a*b/a == b. - Proof. intros. field. Qed. + Proof using Type*. intros. field. Qed. Context {eq_dec:forall x y : F, {x==y}+{x==y->False}}. Lemma mul_zero_why : forall a b, a*b == 0 -> a == 0 \/ b == 0. + Proof using Type*. + intros; destruct (eq_dec a 0); intuition. assert (a * b / a == 0) by (match goal with [H: _ == _ |- _ ] => rewrite H; field end). @@ -119,7 +121,7 @@ Module F. Import Coq.nsatz.Nsatz. Global Instance Integral_domain_Field : Integral_domain (R:=F). - Proof. + Proof using Type*. constructor; intros; eauto using mul_zero_why, field_one_neq_zero. Qed. @@ -150,12 +152,12 @@ Module F. Hint Extern 5 (_ == _) => field_nsatz : field. Hint Extern 5 (_ <-> _) => split. - Lemma mul_inv_l : forall x, not (x == 0) -> inv x * x == 1. Proof. auto with field. Qed. + Lemma mul_inv_l : forall x, not (x == 0) -> inv x * x == 1. Proof using Type*. auto with field. Qed. - Lemma mul_inv_r : forall x, not (x == 0) -> x * inv x == 1. Proof. auto with field. Qed. + Lemma mul_inv_r : forall x, not (x == 0) -> x * inv x == 1. Proof using Type*. auto with field. Qed. Lemma mul_cancel_r' (x y z:F) : not (z == 0) -> x * z == y * z -> x == y. - Proof. + Proof using Type*. intros. assert (x * z * inv z == y * z * inv z) by (match goal with [H: _ == _ |- _ ] => rewrite H; auto with field end). @@ -165,28 +167,28 @@ Module F. Qed. Lemma mul_cancel_r (x y z:F) : not (z == 0) -> (x * z == y * z <-> x == y). - Proof. intros;split;intros Heq; try eapply mul_cancel_r' in Heq; eauto with field. Qed. + Proof using Type*. intros;split;intros Heq; try eapply mul_cancel_r' in Heq; eauto with field. Qed. Lemma mul_cancel_l (x y z:F) : not (z == 0) -> (z * x == z * y <-> x == y). - Proof. intros;split;intros; try eapply mul_cancel_r; eauto with field. Qed. + Proof using Type*. intros;split;intros; try eapply mul_cancel_r; eauto with field. Qed. Lemma mul_cancel_r_eq : forall x z:F, not(z==0) -> (x*z == z <-> x == 1). - Proof. + Proof using Type*. intros;split;intros Heq; [|nsatz]. pose proof ring_mul_1_l z as Hz; rewrite <- Hz in Heq at 2; rewrite mul_cancel_r in Heq; eauto. Qed. Lemma mul_cancel_l_eq : forall x z:F, not(z==0) -> (z*x == z <-> x == 1). - Proof. intros;split;intros Heq; try eapply mul_cancel_r_eq; eauto with field. Qed. + Proof using Type*. intros;split;intros Heq; try eapply mul_cancel_r_eq; eauto with field. Qed. - Lemma inv_unique (a:F) : forall x y, x * a == 1 -> y * a == 1 -> x == y. Proof. auto with field. Qed. + Lemma inv_unique (a:F) : forall x y, x * a == 1 -> y * a == 1 -> x == y. Proof using Type*. auto with field. Qed. Lemma mul_nonzero_nonzero (a b:F) : not (a == 0) -> not (b == 0) -> not (a*b == 0). - Proof. intros; intro Hab. destruct (mul_zero_why _ _ Hab); auto. Qed. + Proof using Type*. intros; intro Hab. destruct (mul_zero_why _ _ Hab); auto. Qed. Hint Resolve mul_nonzero_nonzero : field_nonzero. Lemma inv_nonzero (x:F) : not(x == 0) -> not(inv x==0). - Proof. + Proof using H. intros Hx Hi. assert (Hc:not (inv x*x==0)) by (rewrite field_inv_def; eauto with field_nonzero); contradict Hc. ring [Hi]. @@ -194,32 +196,32 @@ Module F. Hint Resolve inv_nonzero : field_nonzero. Lemma div_nonzero (x y:F) : not(x==0) -> not(y==0) -> not(x/y==0). - Proof. + Proof using Type*. unfold division, div_notation, div; auto with field_nonzero. Qed. Hint Resolve div_nonzero : field_nonzero. Lemma pow_pos_nonzero (x:F) p : not(x==0) -> not(Ncring.pow_pos x p == 0). - Proof. + Proof using Type*. intros; induction p using Pos.peano_ind; try assumption; []. rewrite Ncring.pow_pos_succ; eauto using mul_nonzero_nonzero. Qed. Hint Resolve pow_pos_nonzero : field_nonzero. - Lemma sub_diag_iff (x y:F) : x - y == 0 <-> x == y. Proof. auto with field. Qed. + Lemma sub_diag_iff (x y:F) : x - y == 0 <-> x == y. Proof using Type*. auto with field. Qed. - Lemma mul_same (x:F) : x*x == x^2%Z. Proof. auto with field. Qed. + Lemma mul_same (x:F) : x*x == x^2%Z. Proof using Type*. auto with field. Qed. Lemma inv_mul (x y:F) : not(x==0) -> not (y==0) -> inv (x*y) == inv x * inv y. - Proof. intros;field;intuition. Qed. + Proof using H. intros;field;intuition. Qed. - Lemma pow_0_r (x:F) : x^0 == 1. Proof. auto with field. Qed. - Lemma pow_1_r : forall x:F, x^1%Z == x. Proof. auto with field. Qed. - Lemma pow_2_r : forall x:F, x^2%Z == x*x. Proof. auto with field. Qed. - Lemma pow_3_r : forall x:F, x^3%Z == x*x*x. Proof. auto with field. Qed. + Lemma pow_0_r (x:F) : x^0 == 1. Proof using Type*. auto with field. Qed. + Lemma pow_1_r : forall x:F, x^1%Z == x. Proof using Type*. auto with field. Qed. + Lemma pow_2_r : forall x:F, x^2%Z == x*x. Proof using Type*. auto with field. Qed. + Lemma pow_3_r : forall x:F, x^3%Z == x*x*x. Proof using Type*. auto with field. Qed. Lemma pow_succ_r (x:F) (n:Z) : not (x==0)\/(n>=0)%Z -> x^(n+1) == x * x^n. - Proof. + Proof using Type*. intros Hnz; unfold power, powZ, power_field, powZ; destruct n eqn:HSn. - simpl; ring. - setoid_rewrite <-Pos2Z.inj_succ; rewrite Ncring.pow_pos_succ; ring. @@ -234,7 +236,7 @@ Module F. Qed. Lemma pow_pred_r (x:F) (n:Z) : not (x==0) -> x^(n-1) == x^n/x. - Proof. + Proof using Type*. intros; unfold power, powZ, power_field, powZ; destruct n eqn:HSn. - simpl. rewrite unfold_div; field. - destruct (Z.pos p - 1) eqn:Hn. @@ -251,7 +253,7 @@ Module F. || setoid_rewrite pow_pred_r). Lemma pow_mul (x y:F) : forall (n:Z), not(x==0)/\not(y==0)\/(n>=0)%Z -> (x * y)^n == x^n * y^n. - Proof. + Proof using Type*. match goal with |- forall n, @?P n => eapply (Z.order_induction'_0 P) end. { repeat intro. subst. reflexivity. } - intros; cbv [power power_field powZ]; ring. @@ -262,6 +264,8 @@ Module F. Qed. Lemma pow_nonzero (x:F) : forall (n:Z), not(x==0) -> not(x^n==0). + Proof using Type*. + match goal with |- forall n, @?P n => eapply (Z.order_induction'_0 P) end; intros; pow_peano; eauto with field_nonzero. { repeat intro. subst. reflexivity. } @@ -269,6 +273,8 @@ Module F. Hint Resolve pow_nonzero : field_nonzero. Lemma pow_inv (x:F) : forall (n:Z), not(x==0) -> inv x^n == inv (x^n). + Proof using Type*. + match goal with |- forall n, @?P n => eapply (Z.order_induction'_0 P) end. { repeat intro. subst. reflexivity. } - intros; cbv [power power_field powZ]. field; eauto with field_nonzero. @@ -279,56 +285,58 @@ Module F. Qed. Lemma pow_0_l : forall n, (n>0)%Z -> (0:F)^n==0. + Proof using Type*. + match goal with |- forall n, @?P n => eapply (Z.order_induction'_0 P) end; intros; try omega. { repeat intro. subst. reflexivity. } setoid_rewrite pow_succ_r; [auto with field|right;omega]. Qed. Lemma pow_div (x y:F) (n:Z) : not (y==0) -> not(x==0)\/(n >= 0)%Z -> (x/y)^n == x^n/y^n. - Proof. + Proof using Type*. intros Hy Hxn. unfold division, div_notation, div. rewrite pow_mul, pow_inv; try field; destruct Hxn; auto with field_nonzero. Qed. Hint Extern 3 (_ >= _)%Z => omega : field_nonzero. Lemma issquare_mul (x y z:F) : not (y == 0) -> x^2%Z == z * y^2%Z -> (x/y)^2%Z == z. - Proof. intros. rewrite pow_div by (auto with field_nonzero); auto with field. Qed. + Proof using Type*. intros. rewrite pow_div by (auto with field_nonzero); auto with field. Qed. Lemma issquare_mul_sub (x y z:F) : 0 == z*y^2%Z - x^2%Z -> (x/y)^2%Z == z \/ x == 0. - Proof. destruct (eq_dec y 0); [right|left]; auto using issquare_mul with field. Qed. + Proof using Type*. destruct (eq_dec y 0); [right|left]; auto using issquare_mul with field. Qed. Lemma div_mul : forall x y z : F, not(y==0) -> (z == (x / y) <-> z * y == x). - Proof. auto with field. Qed. + Proof using H. auto with field. Qed. Lemma div_1_r : forall x : F, x/1 == x. - Proof. eauto with field field_nonzero. Qed. + Proof using Type*. eauto with field field_nonzero. Qed. Lemma div_1_l : forall x : F, not(x==0) -> 1/x == inv x. - Proof. auto with field. Qed. + Proof using Type*. auto with field. Qed. Lemma div_opp_l : forall x y, not (y==0) -> (-_ x) / y == -_ (x / y). - Proof. auto with field. Qed. + Proof using Type*. auto with field. Qed. Lemma div_opp_r : forall x y, not (y==0) -> x / (-_ y) == -_ (x / y). - Proof. auto with field. Qed. + Proof using Type*. auto with field. Qed. Lemma eq_opp_zero : forall x : F, (~ 1 + 1 == (0:F)) -> (x == -_ x <-> x == 0). - Proof. auto with field. Qed. + Proof using Type*. auto with field. Qed. Lemma add_cancel_l : forall x y z:F, z+x == z+y <-> x == y. - Proof. auto with field. Qed. + Proof using Type*. auto with field. Qed. Lemma add_cancel_r : forall x y z:F, x+z == y+z <-> x == y. - Proof. auto with field. Qed. + Proof using Type*. auto with field. Qed. Lemma add_cancel_r_eq : forall x z:F, x+z == z <-> x == 0. - Proof. auto with field. Qed. + Proof using Type*. auto with field. Qed. Lemma add_cancel_l_eq : forall x z:F, z+x == z <-> x == 0. - Proof. auto with field. Qed. + Proof using Type*. auto with field. Qed. Lemma sqrt_solutions : forall x y:F, y ^ 2%Z == x ^ 2%Z -> y == x \/ y == -_ x. - Proof. + Proof using Type*. intros ? ? squares_eq. remember (y - x) as z eqn:Heqz. assert (y == x + z) as Heqy by (subst; ring); rewrite Heqy in *; clear Heqy Heqz. diff --git a/src/Karatsuba.v b/src/Karatsuba.v index 47ae2facf..8e88d64c3 100644 --- a/src/Karatsuba.v +++ b/src/Karatsuba.v @@ -27,7 +27,7 @@ Section Karatsuba. Lemma eval_karatsuba_mul s x y (s_nonzero:s <> 0) : eval (karatsuba_mul s x y) = eval x * eval y. - Proof. cbv [karatsuba_mul]; repeat rewrite ?eval_sub, ?eval_mul, ?eval_add, ?eval_scmul. + Proof using Type*. cbv [karatsuba_mul]; repeat rewrite ?eval_sub, ?eval_mul, ?eval_add, ?eval_scmul. rewrite <-(eval_split s x), <-(eval_split s y) by assumption; ring. Qed. @@ -42,7 +42,7 @@ Section Karatsuba. Lemma goldilocks_mul_correct (p : Z) (p_nonzero : p <> 0) s (s_nonzero : s <> 0) (s2_modp : (s^2) mod p = (s+1) mod p) xs ys : (eval (goldilocks_mul s xs ys)) mod p = (eval xs * eval ys) mod p. - Proof. cbv [goldilocks_mul]; Zmod_to_equiv_modulo. + Proof using Type*. cbv [goldilocks_mul]; Zmod_to_equiv_modulo. repeat rewrite ?eval_mul, ?eval_add, ?eval_sub, ?eval_scmul, <-?(eval_split s xs), <-?(eval_split s ys) by assumption; ring_simplify. setoid_rewrite s2_modp. apply f_equal2; nsatz. Qed. diff --git a/src/ModularArithmetic/BarrettReduction/Z.v b/src/ModularArithmetic/BarrettReduction/Z.v index 39f99c149..1f3fe0cdd 100644 --- a/src/ModularArithmetic/BarrettReduction/Z.v +++ b/src/ModularArithmetic/BarrettReduction/Z.v @@ -32,7 +32,7 @@ Section barrett. Theorem naive_barrett_reduction_correct : a mod n = a - ⌊am⌋ * n. - Proof. + Proof using n_reasonable. apply Zmod_eq_full; assumption. Qed. End general_idea. @@ -58,7 +58,7 @@ Section barrett. (a_nonneg : 0 <= a). Lemma k_nonnegative : 0 <= k. - Proof. + Proof using Type*. destruct (Z_lt_le_dec k 0); try assumption. rewrite !Z.pow_neg_r in * by lia; lia. Qed. @@ -70,7 +70,7 @@ Section barrett. truncated division), [q] is an integer and [r ≡ a mod n]. *) Theorem barrett_reduction_equivalent : r mod n = a mod n. - Proof. + Proof using m_good. subst r q m. rewrite <- !Z.add_opp_r, !Zopp_mult_distr_l, !Z_mod_plus_full by assumption. reflexivity. @@ -78,7 +78,7 @@ Section barrett. Lemma qn_small : q * n <= a. - Proof. + Proof using a_nonneg k_good m_good n_pos n_reasonable. pose proof k_nonnegative; subst q r m. assert (0 <= 2^(k-1)) by zero_bounds. Z.simplify_fractions_le. @@ -88,7 +88,7 @@ Section barrett. (** N.B. It turns out that it is sufficient to assume [a < 4ᵏ]. *) Context (a_small : a < 4^k). Lemma q_nice : { b : bool | q = a / n + if b then -1 else 0 }. - Proof. + Proof using a_nonneg a_small k_good m_good n_pos n_reasonable. assert (0 <= (4 ^ k * a / n) mod 4 ^ k < 4 ^ k) by auto with zarith lia. assert (0 <= a * (4 ^ k mod n) / n < 4 ^ k) by (auto with zero_bounds zarith lia). subst q r m. @@ -99,7 +99,7 @@ Section barrett. Qed. Lemma r_small : r < 2 * n. - Proof. + Proof using a_nonneg a_small k_good m_good n_pos n_reasonable q. Hint Rewrite (Z.mul_div_eq' a n) using lia : zstrip_div. assert (a mod n < n) by auto with zarith lia. subst r; rewrite (proj2_sig q_nice); generalize (proj1_sig q_nice); intro; subst q m. @@ -112,7 +112,7 @@ Section barrett. : a mod n = if r <? n then r else r - n. - Proof. + Proof using a_nonneg a_small k_good m_good n_pos n_reasonable q. pose proof r_small. pose proof qn_small. destruct (r <? n) eqn:rlt; Z.ltb_to_lt. { symmetry; apply (Zmod_unique a n q); subst r; lia. } diff --git a/src/ModularArithmetic/BarrettReduction/ZBounded.v b/src/ModularArithmetic/BarrettReduction/ZBounded.v index 60cd3df72..a6d968650 100644 --- a/src/ModularArithmetic/BarrettReduction/ZBounded.v +++ b/src/ModularArithmetic/BarrettReduction/ZBounded.v @@ -53,7 +53,7 @@ Section barrett. : medium_valid x -> decode_small (barrett_reduce_function x) = (decode_large x) mod m /\ small_valid (barrett_reduce_function x). - Proof. + Proof using base_pos k_big_enough m_large m_pos m_small offset_nonneg μ'_eq μ'_good μ_good. exact (proj2_sig (barrett_reduce x)). Qed. End barrett. diff --git a/src/ModularArithmetic/BarrettReduction/ZGeneralized.v b/src/ModularArithmetic/BarrettReduction/ZGeneralized.v index aad0cf112..99543a45e 100644 --- a/src/ModularArithmetic/BarrettReduction/ZGeneralized.v +++ b/src/ModularArithmetic/BarrettReduction/ZGeneralized.v @@ -39,7 +39,7 @@ Section barrett. Theorem naive_barrett_reduction_correct : a mod n = a - ⌊am⌋ * n. - Proof. + Proof using n_reasonable. apply Zmod_eq_full; assumption. Qed. End general_idea. @@ -84,7 +84,7 @@ Section barrett. truncated division), [q] is an integer and [r ≡ a mod n]. *) Theorem barrett_reduction_equivalent : r mod n = a mod n. - Proof. + Proof using m_good offset. subst r q m. rewrite <- !Z.add_opp_r, !Zopp_mult_distr_l, !Z_mod_plus_full by assumption. reflexivity. @@ -92,7 +92,7 @@ Section barrett. Lemma qn_small : q * n <= a. - Proof. + Proof using a_nonneg a_small base_good k_big_enough m_good n_pos n_reasonable offset_nonneg. subst q r m. assert (0 < b^(k-offset)). zero_bounds. assert (0 < b^(k+offset)) by zero_bounds. @@ -102,7 +102,7 @@ Section barrett. Qed. Lemma q_nice : { b : bool * bool | q = a / n + (if fst b then -1 else 0) + (if snd b then -1 else 0) }. - Proof. + Proof using a_nonneg a_small base_good k_big_enough m_good n_large n_pos n_reasonable offset_nonneg. assert (0 < b^(k+offset)) by zero_bounds. assert (0 < b^(k-offset)) by zero_bounds. assert (a / b^(k-offset) <= b^(2*k) / b^(k-offset)) by auto with zarith lia. @@ -116,7 +116,7 @@ Section barrett. Qed. Lemma r_small : r < 3 * n. - Proof. + Proof using a_nonneg a_small base_good k_big_enough m_good n_large n_pos n_reasonable offset_nonneg q. Hint Rewrite (Z.mul_div_eq' a n) using lia : zstrip_div. assert (a mod n < n) by auto with zarith lia. subst r; rewrite (proj2_sig q_nice); generalize (proj1_sig q_nice); intro; subst q m. @@ -129,7 +129,7 @@ Section barrett. : a mod n = let r := if r <? n then r else r-n in let r := if r <? n then r else r-n in r. - Proof. + Proof using a_nonneg a_small base_good k_big_enough m_good n_large n_pos n_reasonable offset_nonneg q. pose proof r_small. pose proof qn_small. cbv zeta. destruct (r <? n) eqn:Hr, (r-n <? n) eqn:?; try rewrite Hr; Z.ltb_to_lt; try lia. { symmetry; apply (Zmod_unique a n q); subst r; lia. } diff --git a/src/ModularArithmetic/BarrettReduction/ZHandbook.v b/src/ModularArithmetic/BarrettReduction/ZHandbook.v index b0d6480d8..8962a997f 100644 --- a/src/ModularArithmetic/BarrettReduction/ZHandbook.v +++ b/src/ModularArithmetic/BarrettReduction/ZHandbook.v @@ -54,7 +54,7 @@ Section barrett. if r <? 0 then r + b^(k+offset) else r. Lemma r_mod_3m_eq_orig : r_mod_3m = r_mod_3m_orig. - Proof. + Proof using base_pos k_big_enough m_pos m_small offset_nonneg r1 r2. assert (0 <= r1 < b^(k+offset)) by (subst r1; auto with zarith). assert (0 <= r2 < b^(k+offset)) by (subst r2; auto with zarith). subst r_mod_3m r_mod_3m_orig; cbv zeta. @@ -71,7 +71,7 @@ Section barrett. Let Q := x / m. Let R := x mod m. Lemma q3_nice : { b : bool * bool | q3 = Q + (if fst b then -1 else 0) + (if snd b then -1 else 0) }. - Proof. + Proof using base_pos k_big_enough m_large m_pos m_small offset_nonneg x_nonneg x_small μ_good. assert (0 < b^(k+offset)) by zero_bounds. assert (0 < b^(k-offset)) by zero_bounds. assert (x / b^(k-offset) <= b^(2*k) / b^(k-offset)) by auto with zarith lia. @@ -85,7 +85,7 @@ Section barrett. Qed. Fact q3_in_range : Q - 2 <= q3 <= Q. - Proof. + Proof using base_pos k_big_enough m_large m_pos m_small offset_nonneg q2 x_nonneg x_small μ_good. rewrite (proj2_sig q3_nice). break_match; lia. Qed. @@ -98,7 +98,7 @@ Section barrett. Fact 14.43 guarantees that [q₃] is never larger than the true quotient [Q], and is at most 2 smaller. *) Lemma x_minus_q3_m_in_range : 0 <= x - q3 * m < 3 * m. - Proof. + Proof using base_pos k_big_enough m_large m_pos m_small offset_nonneg q2 x_nonneg x_small μ_good. pose proof q3_in_range. assert (0 <= R < m) by (subst R; auto with zarith). assert (0 <= (Q - q3) * m + R < 3 * m) by nia. @@ -106,7 +106,7 @@ Section barrett. Qed. Lemma r_mod_3m_eq_alt : r_mod_3m = x - q3 * m. - Proof. + Proof using base_pos k_big_enough m_large m_pos m_small offset_nonneg q2 x_nonneg x_small μ_good. pose proof x_minus_q3_m_in_range. subst r_mod_3m r_mod_3m_orig r1 r2. autorewrite with pull_Zmod zsimplify; reflexivity. @@ -115,7 +115,7 @@ Section barrett. (** This version uses reduction modulo [b^(k+offset)]. *) Theorem barrett_reduction_equivalent : r_mod_3m mod m = x mod m. - Proof. + Proof using base_pos k_big_enough m_large m_pos m_small offset_nonneg r1 r2 x_nonneg x_small μ_good. rewrite r_mod_3m_eq_alt. autorewrite with zsimplify push_Zmod; reflexivity. Qed. @@ -124,10 +124,10 @@ Section barrett. conditional addition of [b^(k+offset)]. *) Theorem barrett_reduction_orig_equivalent : r_mod_3m_orig mod m = x mod m. - Proof. rewrite <- r_mod_3m_eq_orig; apply barrett_reduction_equivalent. Qed. + Proof using base_pos k_big_enough m_large m_pos m_small offset_nonneg r_mod_3m x_nonneg x_small μ_good. rewrite <- r_mod_3m_eq_orig; apply barrett_reduction_equivalent. Qed. Lemma r_small : 0 <= r_mod_3m < 3 * m. - Proof. + Proof using Q R base_pos k_big_enough m_large m_pos m_small offset_nonneg q3 x_nonneg x_small μ_good. pose proof x_minus_q3_m_in_range. subst Q R r_mod_3m r_mod_3m_orig r1 r2. autorewrite with pull_Zmod zsimplify; lia. @@ -139,7 +139,7 @@ Section barrett. : x mod m = let r := if r <? m then r else r-m in let r := if r <? m then r else r-m in r. - Proof. + Proof using base_pos k_big_enough m_large m_pos m_small offset_nonneg r1 r2 x_nonneg x_small μ_good. pose proof r_small. cbv zeta. destruct (r <? m) eqn:Hr, (r-m <? m) eqn:?; subst r; rewrite !r_mod_3m_eq_alt, ?Hr in *; Z.ltb_to_lt; try lia. { symmetry; eapply (Zmod_unique x m q3); lia. } @@ -153,6 +153,6 @@ Section barrett. : x mod m = let r := if r <? m then r else r-m in let r := if r <? m then r else r-m in r. - Proof. subst r; rewrite <- r_mod_3m_eq_orig; apply barrett_reduction_small. Qed. + Proof using base_pos k_big_enough m_large m_pos m_small offset_nonneg r_mod_3m x_nonneg x_small μ_good. subst r; rewrite <- r_mod_3m_eq_orig; apply barrett_reduction_small. Qed. End barrett_modular_reduction. End barrett. diff --git a/src/ModularArithmetic/Conversion.v b/src/ModularArithmetic/Conversion.v index 0fb07e26b..3e8436f43 100644 --- a/src/ModularArithmetic/Conversion.v +++ b/src/ModularArithmetic/Conversion.v @@ -103,7 +103,7 @@ Section Conversion. let bitsA := Z.pow2_mod ((inp # digitA) >> indexA) dist in 0 < dist -> bounded limb_widthsB (update_nth digitB (update_by_concat_bits indexB bitsA) out). - Proof. + Proof using limb_widthsB_nonneg. repeat match goal with | |- _ => progress intros | |- _ => progress autorewrite with Ztestbit @@ -134,7 +134,7 @@ Section Conversion. 0 < dist -> Z.of_nat i < bitsIn limb_widthsA -> Z.of_nat i + dist <= bitsIn limb_widthsA. - Proof. + Proof using limb_widthsA_nonneg. pose proof (rem_bits_in_digit_le_rem_bits limb_widthsA). pose proof (rem_bits_in_digit_le_rem_bits limb_widthsA). repeat match goal with @@ -167,7 +167,7 @@ Section Conversion. Z.of_nat i < bitsIn limb_widthsA -> convert'_invariant inp (i + Z.to_nat dist)%nat (update_nth digitB (update_by_concat_bits indexB bitsA) out). - Proof. + Proof using Type*. Time repeat match goal with | |- _ => progress intros; cbv [convert'_invariant] in * @@ -229,7 +229,7 @@ Section Conversion. bounded limb_widthsA inp -> convert'_invariant inp i out -> convert'_invariant inp (Z.to_nat (bitsIn limb_widthsA)) (convert' inp i out). - Proof. + Proof using Type. intros until 2; functional induction (convert' inp i out); repeat match goal with | |- _ => progress intros @@ -253,7 +253,7 @@ Section Conversion. Lemma convert_correct : forall us, length us = length limb_widthsA -> bounded limb_widthsA us -> decodeA us = decodeB (convert us). - Proof. + Proof using Type. repeat match goal with | |- _ => progress intros | |- _ => progress cbv [convert convert'_invariant] in * @@ -283,7 +283,7 @@ Section Conversion. Lemma convert'_bounded : forall inp i out, bounded limb_widthsB out -> bounded limb_widthsB (convert' inp i out). - Proof. + Proof using Type. intros; functional induction (convert' inp i out); auto. apply IHl. apply convert'_bounded_step; auto. @@ -295,7 +295,7 @@ Section Conversion. Qed. Lemma convert_bounded : forall us, bounded limb_widthsB (convert us). - Proof. + Proof using Type. intros; apply convert'_bounded. apply bounded_iff; intros. rewrite nth_default_zeros. @@ -305,12 +305,12 @@ Section Conversion. (* This is part of convert'_invariant, but proving it separately strips preconditions *) Lemma length_convert' : forall inp i out, length (convert' inp i out) = length out. - Proof. + Proof using Type. intros; functional induction (convert' inp i out); distr_length. Qed. Lemma length_convert : forall us, length (convert us) = length limb_widthsB. - Proof. + Proof using Type. cbv [convert]; intros. rewrite length_convert', length_zeros. reflexivity. diff --git a/src/ModularArithmetic/ExtPow2BaseMulProofs.v b/src/ModularArithmetic/ExtPow2BaseMulProofs.v index af2c1a679..38e9cf634 100644 --- a/src/ModularArithmetic/ExtPow2BaseMulProofs.v +++ b/src/ModularArithmetic/ExtPow2BaseMulProofs.v @@ -27,7 +27,7 @@ Section ext_mul. (length us <= length base)%nat -> (length vs <= length base)%nat -> (BaseSystem.decode base us) * (BaseSystem.decode base vs) = BaseSystem.decode (ext_base limb_widths) (BaseSystem.mul (ext_base limb_widths) us vs). - Proof. + Proof using Type*. intros; apply mul_rep_two_base; auto; distr_length. Qed. diff --git a/src/ModularArithmetic/ExtendedBaseVector.v b/src/ModularArithmetic/ExtendedBaseVector.v index b9d6ffe4c..2236461ce 100644 --- a/src/ModularArithmetic/ExtendedBaseVector.v +++ b/src/ModularArithmetic/ExtendedBaseVector.v @@ -41,7 +41,7 @@ Section ExtendedBaseVector. Definition ext_limb_widths := limb_widths ++ limb_widths. Definition ext_base := base_from_limb_widths ext_limb_widths. Lemma ext_base_alt : ext_base = base ++ (map (Z.mul (2^k)) base). - Proof. + Proof using Type*. unfold ext_base, ext_limb_widths. rewrite base_from_limb_widths_app by auto. rewrite two_p_equiv. @@ -49,13 +49,13 @@ Section ExtendedBaseVector. Qed. Lemma ext_base_positive : forall b, In b ext_base -> b > 0. - Proof. + Proof using Type*. apply base_positive; unfold ext_limb_widths. intros ? H. apply in_app_or in H; destruct H; auto. Qed. Lemma b0_1 : forall x, nth_default x base 0 = 1 -> nth_default x ext_base 0 = 1. - Proof. + Proof using Type*. intros. rewrite ext_base_alt, nth_default_app. destruct base; assumption. Qed. @@ -63,7 +63,7 @@ Section ExtendedBaseVector. Lemma map_nth_default_base_high : forall n, (n < (length base))%nat -> nth_default 0 (map (Z.mul (2 ^ k)) base) n = (2 ^ k) * (nth_default 0 base n). - Proof. + Proof using Type. intros. erewrite map_nth_default; auto. Qed. @@ -71,14 +71,14 @@ Section ExtendedBaseVector. Lemma ext_limb_widths_nonneg (limb_widths_nonneg : forall w : Z, In w limb_widths -> 0 <= w) : forall w : Z, In w ext_limb_widths -> 0 <= w. - Proof. + Proof using Type*. unfold ext_limb_widths; setoid_rewrite in_app_iff. intros ? [?|?]; auto. Qed. Lemma ext_limb_widths_upper_bound : upper_bound ext_limb_widths = upper_bound limb_widths * upper_bound limb_widths. - Proof. + Proof using Type*. unfold ext_limb_widths. autorewrite with push_upper_bound; reflexivity. Qed. @@ -105,7 +105,7 @@ Section ExtendedBaseVector. (2 ^ k * (nth_default 0 base i * nth_default 0 base j')) / (2 ^ k * nth_default 0 base (i + j')) * (2 ^ k * nth_default 0 base (i + j')). - Proof. + Proof using base_good two_k_nonzero. clear limb_widths_match_modulus. intros. remember (nth_default 0 base) as b. @@ -124,7 +124,7 @@ Section ExtendedBaseVector. let b := nth_default 0 ext_base in let r := (b i * b j) / b (i+j)%nat in b i * b j = r * b (i+j)%nat. - Proof. + Proof using Type*. intros. subst b. subst r. rewrite ext_base_alt in *. @@ -160,7 +160,7 @@ Section ExtendedBaseVector. Lemma extended_base_length: length ext_base = (length base + length base)%nat. - Proof. + Proof using Type. clear limb_widths_nonnegative. unfold ext_base, ext_limb_widths; autorewrite with distr_length; reflexivity. Qed. @@ -168,7 +168,7 @@ Section ExtendedBaseVector. Lemma firstn_us_base_ext_base : forall (us : BaseSystem.digits), (length us <= length base)%nat -> firstn (length us) base = firstn (length us) ext_base. - Proof. + Proof using Type*. rewrite ext_base_alt; intros. rewrite firstn_app_inleft; auto; omega. Qed. @@ -176,7 +176,7 @@ Section ExtendedBaseVector. Lemma decode_short : forall (us : BaseSystem.digits), (length us <= length base)%nat -> BaseSystem.decode base us = BaseSystem.decode ext_base us. - Proof. auto using decode_short_initial, firstn_us_base_ext_base. Qed. + Proof using Type*. auto using decode_short_initial, firstn_us_base_ext_base. Qed. Section BaseVector. Context {bv : BaseSystem.BaseVector base} diff --git a/src/ModularArithmetic/ModularArithmeticTheorems.v b/src/ModularArithmetic/ModularArithmeticTheorems.v index 863300dde..9cd211943 100644 --- a/src/ModularArithmetic/ModularArithmeticTheorems.v +++ b/src/ModularArithmetic/ModularArithmeticTheorems.v @@ -43,39 +43,39 @@ Module F. Local Open Scope F_scope. Theorem eq_to_Z_iff (x y : F m) : x = y <-> F.to_Z x = F.to_Z y. - Proof. destruct x, y; intuition; simpl in *; try apply (eqsig_eq _ _); congruence. Qed. + Proof using Type. destruct x, y; intuition; simpl in *; try apply (eqsig_eq _ _); congruence. Qed. Lemma eq_of_Z_iff : forall x y : Z, x mod m = y mod m <-> F.of_Z m x = F.of_Z m y. - Proof. split; unwrap_F; congruence. Qed. + Proof using Type. split; unwrap_F; congruence. Qed. Lemma to_Z_of_Z : forall z, F.to_Z (F.of_Z m z) = z mod m. - Proof. unwrap_F; trivial. Qed. + Proof using Type. unwrap_F; trivial. Qed. Lemma of_Z_to_Z x : F.of_Z m (F.to_Z x) = x :> F m. - Proof. unwrap_F; congruence. Qed. + Proof using Type. unwrap_F; congruence. Qed. Lemma of_Z_mod : forall x, F.of_Z m x = F.of_Z m (x mod m). - Proof. unwrap_F; trivial. Qed. + Proof using Type. unwrap_F; trivial. Qed. Lemma mod_to_Z : forall (x:F m), F.to_Z x mod m = F.to_Z x. - Proof. unwrap_F. congruence. Qed. + Proof using Type. unwrap_F. congruence. Qed. Lemma to_Z_0 : F.to_Z (0:F m) = 0%Z. - Proof. unwrap_F. apply Zmod_0_l. Qed. + Proof using Type. unwrap_F. apply Zmod_0_l. Qed. Lemma of_Z_small_nonzero z : (0 < z < m)%Z -> F.of_Z m z <> 0. - Proof. intros Hrange Hnz. inversion Hnz. rewrite Zmod_small, Zmod_0_l in *; omega. Qed. + Proof using Type. intros Hrange Hnz. inversion Hnz. rewrite Zmod_small, Zmod_0_l in *; omega. Qed. Lemma to_Z_nonzero (x:F m) : x <> 0 -> F.to_Z x <> 0%Z. - Proof. intros Hnz Hz. rewrite <- Hz, of_Z_to_Z in Hnz; auto. Qed. + Proof using Type. intros Hnz Hz. rewrite <- Hz, of_Z_to_Z in Hnz; auto. Qed. Lemma to_Z_range (x : F m) : 0 < m -> 0 <= F.to_Z x < m. - Proof. intros. rewrite <- mod_to_Z. apply Z.mod_pos_bound. trivial. Qed. + Proof using Type. intros. rewrite <- mod_to_Z. apply Z.mod_pos_bound. trivial. Qed. Lemma to_Z_nonzero_range (x : F m) : (x <> 0) -> 0 < m -> (1 <= F.to_Z x < m)%Z. - Proof. + Proof using Type. unfold not; intros Hnz Hlt. rewrite eq_to_Z_iff, to_Z_0 in Hnz; pose proof (to_Z_range x Hlt). omega. @@ -83,27 +83,27 @@ Module F. Lemma of_Z_add : forall (x y : Z), F.of_Z m (x + y) = F.of_Z m x + F.of_Z m y. - Proof. unwrap_F; trivial. Qed. + Proof using Type. unwrap_F; trivial. Qed. Lemma to_Z_add : forall x y : F m, F.to_Z (x + y) = ((F.to_Z x + F.to_Z y) mod m)%Z. - Proof. unwrap_F; trivial. Qed. + Proof using Type. unwrap_F; trivial. Qed. Lemma of_Z_mul x y : F.of_Z m (x * y) = F.of_Z _ x * F.of_Z _ y :> F m. - Proof. unwrap_F. trivial. Qed. + Proof using Type. unwrap_F. trivial. Qed. Lemma to_Z_mul : forall x y : F m, F.to_Z (x * y) = ((F.to_Z x * F.to_Z y) mod m)%Z. - Proof. unwrap_F; trivial. Qed. + Proof using Type. unwrap_F; trivial. Qed. Lemma of_Z_sub x y : F.of_Z _ (x - y) = F.of_Z _ x - F.of_Z _ y :> F m. - Proof. unwrap_F. trivial. Qed. + Proof using Type. unwrap_F. trivial. Qed. Lemma to_Z_opp : forall x : F m, F.to_Z (F.opp x) = (- F.to_Z x) mod m. - Proof. unwrap_F; trivial. Qed. + Proof using Type. unwrap_F; trivial. Qed. Lemma of_Z_pow x n : F.of_Z _ x ^ n = F.of_Z _ (x ^ (Z.of_N n) mod m) :> F m. - Proof. + Proof using Type. intros. induction n using N.peano_ind; destruct (pow_spec (F.of_Z m x)) as [pow_0 pow_succ] . { @@ -121,7 +121,7 @@ Module F. Lemma to_Z_pow : forall (x : F m) n, F.to_Z (x ^ n)%F = (F.to_Z x ^ Z.of_N n mod m)%Z. - Proof. + Proof using Type. intros. symmetry. induction n using N.peano_ind; @@ -140,7 +140,7 @@ Module F. Lemma square_iff (x:F m) : (exists y : F m, y * y = x) <-> (exists y : Z, y * y mod m = F.to_Z x)%Z. - Proof. + Proof using Type. setoid_rewrite eq_to_Z_iff; setoid_rewrite to_Z_mul; split; intro H; destruct H as [x' H]. - eauto. - exists (F.of_Z _ x'); rewrite !to_Z_of_Z; pull_Zmod; auto. @@ -155,7 +155,7 @@ Module F. Context {m:BinPos.positive}. Lemma to_nat_of_nat (n:nat) : F.to_nat (F.of_nat m n) = (n mod (Z.to_nat m))%nat. - Proof. + Proof using Type. unfold F.to_nat, F.of_nat. rewrite F.to_Z_of_Z. assert (Pos.to_nat m <> 0)%nat as HA by (pose proof Pos2Nat.is_pos m; omega). @@ -166,6 +166,8 @@ Module F. Qed. Lemma of_nat_to_nat x : F.of_nat m (F.to_nat x) = x. + Proof using Type. + unfold F.to_nat, F.of_nat. rewrite Z2Nat.id; [ eapply F.of_Z_to_Z | eapply F.to_Z_range; reflexivity]. Qed. @@ -174,7 +176,7 @@ Module F. Admitted. Lemma of_nat_mod (n:nat) : F.of_nat m (n mod (Z.to_nat m)) = F.of_nat m n. - Proof. + Proof using Type. unfold F.of_nat. rewrite (F.of_Z_mod (Z.of_nat n)), ?mod_Zmod, ?Z2Nat.id; [reflexivity|..]. { apply Pos2Z.is_nonneg. } @@ -182,6 +184,8 @@ Module F. Qed. Lemma to_nat_mod (x:F m) (Hm:(0 < m)%Z) : F.to_nat x mod (Z.to_nat m) = F.to_nat x. + Proof using Type. + unfold F.to_nat. rewrite <-F.mod_to_Z at 2. apply Z.mod_to_nat; [assumption|]. @@ -190,11 +194,11 @@ Module F. Lemma of_nat_add x y : F.of_nat m (x + y) = (F.of_nat m x + F.of_nat m y)%F. - Proof. unfold F.of_nat; rewrite Nat2Z.inj_add, F.of_Z_add; reflexivity. Qed. + Proof using Type. unfold F.of_nat; rewrite Nat2Z.inj_add, F.of_Z_add; reflexivity. Qed. Lemma of_nat_mul x y : F.of_nat m (x * y) = (F.of_nat m x * F.of_nat m y)%F. - Proof. unfold F.of_nat; rewrite Nat2Z.inj_mul, F.of_Z_mul; reflexivity. Qed. + Proof using Type. unfold F.of_nat; rewrite Nat2Z.inj_mul, F.of_Z_mul; reflexivity. Qed. End FandNat. Section RingTacticGadgets. @@ -204,7 +208,7 @@ Module F. := Algebra.Ring.ring_theory_for_stdlib_tactic. Lemma pow_pow_N (x : F m) : forall (n : N), (x ^ id n)%F = pow_N 1%F F.mul x n. - Proof. + Proof using Type. destruct (pow_spec x) as [HO HS]; intros. destruct n; auto; unfold id. rewrite Pre.N_pos_1plus at 1. @@ -218,13 +222,13 @@ Module F. Qed. Lemma power_theory : power_theory 1%F (@F.mul m) eq id (@F.pow m). - Proof. split; apply pow_pow_N. Qed. + Proof using Type. split; apply pow_pow_N. Qed. (***** Division Theory *****) Definition quotrem(a b: F m): F m * F m := let '(q, r) := (Z.quotrem (F.to_Z a) (F.to_Z b)) in (F.of_Z _ q , F.of_Z _ r). Lemma div_theory : div_theory eq (@F.add m) (@F.mul m) (@id _) quotrem. - Proof. + Proof using Type. constructor; intros; unfold quotrem, id. replace (Z.quotrem (F.to_Z a) (F.to_Z b)) with (Z.quot (F.to_Z a) (F.to_Z b), Z.rem (F.to_Z a) (F.to_Z b)) by @@ -241,12 +245,12 @@ Module F. * to inject the result afterward. *) Lemma ring_morph: ring_morph 0%F 1%F F.add F.mul F.sub F.opp eq 0%Z 1%Z Z.add Z.mul Z.sub Z.opp Z.eqb (F.of_Z m). - Proof. split; intros; unwrap_F; solve [ auto | rewrite (proj1 (Z.eqb_eq x y)); trivial]. Qed. + Proof using Type. split; intros; unwrap_F; solve [ auto | rewrite (proj1 (Z.eqb_eq x y)); trivial]. Qed. (* Redefine our division theory under the ring morphism *) Lemma morph_div_theory: Ring_theory.div_theory eq Zplus Zmult (F.of_Z m) Z.quotrem. - Proof. + Proof using Type. split; intros. replace (Z.quotrem a b) with (Z.quot a b, Z.rem a b); try (unfold Z.quot, Z.rem; rewrite <- surjective_pairing; trivial). @@ -269,10 +273,10 @@ Module F. power_tac (power_theory m) [is_pow_constant]). Lemma mul_nonzero_l : forall a b : F m, a*b <> 0 -> a <> 0. - Proof. intros a b Hnz Hz. rewrite Hz in Hnz; apply Hnz; ring. Qed. + Proof using Type. intros a b Hnz Hz. rewrite Hz in Hnz; apply Hnz; ring. Qed. Lemma mul_nonzero_r : forall a b : F m, a*b <> 0 -> b <> 0. - Proof. intros a b Hnz Hz. rewrite Hz in Hnz; apply Hnz; ring. Qed. + Proof using Type. intros a b Hnz Hz. rewrite Hz in Hnz; apply Hnz; ring. Qed. End VariousModulo. Section Pow. @@ -287,7 +291,7 @@ Module F. Import Algebra.ScalarMult. Global Instance pow_is_scalarmult : is_scalarmult (G:=F m) (eq:=eq) (add:=F.mul) (zero:=1%F) (mul := fun n x => x ^ (N.of_nat n)). - Proof. + Proof using Type. split; intros; rewrite ?Nat2N.inj_succ, <-?N.add_1_l; match goal with | [x:F m |- _ ] => solve [destruct (@pow_spec m P); auto] @@ -320,24 +324,24 @@ Module F. end). Lemma pow_0_r (x:F m) : x^0 = 1. - Proof. pow_to_scalarmult_ref. apply scalarmult_0_l. Qed. + Proof using Type. pow_to_scalarmult_ref. apply scalarmult_0_l. Qed. Lemma pow_add_r (x:F m) (a b:N) : x^(a+b) = x^a * x^b. - Proof. pow_to_scalarmult_ref; apply scalarmult_add_l. Qed. + Proof using Type. pow_to_scalarmult_ref; apply scalarmult_add_l. Qed. Lemma pow_0_l (n:N) : n <> 0%N -> 0^n = 0 :> F m. - Proof. pow_to_scalarmult_ref; destruct n; simpl; intros; [congruence|ring]. Qed. + Proof using Type. pow_to_scalarmult_ref; destruct n; simpl; intros; [congruence|ring]. Qed. Lemma pow_pow_l (x:F m) (a b:N) : (x^a)^b = x^(a*b). - Proof. pow_to_scalarmult_ref. apply scalarmult_assoc. Qed. + Proof using Type. pow_to_scalarmult_ref. apply scalarmult_assoc. Qed. Lemma pow_1_r (x:F m) : x^1 = x. - Proof. pow_to_scalarmult_ref; simpl; ring. Qed. + Proof using Type. pow_to_scalarmult_ref; simpl; ring. Qed. Lemma pow_2_r (x:F m) : x^2 = x*x. - Proof. pow_to_scalarmult_ref; simpl; ring. Qed. + Proof using Type. pow_to_scalarmult_ref; simpl; ring. Qed. Lemma pow_3_r (x:F m) : x^3 = x*x*x. - Proof. pow_to_scalarmult_ref; simpl; ring. Qed. + Proof using Type. pow_to_scalarmult_ref; simpl; ring. Qed. End Pow. End F. diff --git a/src/ModularArithmetic/ModularBaseSystem.v b/src/ModularArithmetic/ModularBaseSystem.v index 9d7ce7c1f..0e09386f5 100644 --- a/src/ModularArithmetic/ModularBaseSystem.v +++ b/src/ModularArithmetic/ModularBaseSystem.v @@ -102,7 +102,7 @@ Section ModularBaseSystem. Import Morphisms. Global Instance eq_Equivalence : Equivalence eq. - Proof. + Proof using Type. split; cbv [eq]; repeat intro; congruence. Qed. diff --git a/src/ModularArithmetic/ModularBaseSystemListProofs.v b/src/ModularArithmetic/ModularBaseSystemListProofs.v index 83db33dfe..8d749dfdd 100644 --- a/src/ModularArithmetic/ModularBaseSystemListProofs.v +++ b/src/ModularArithmetic/ModularBaseSystemListProofs.v @@ -26,7 +26,7 @@ Section LengthProofs. Local Notation base := (base_from_limb_widths limb_widths). Lemma length_encode {x} : length (encode x) = length limb_widths. - Proof. + Proof using Type. cbv [encode encodeZ]; intros. rewrite encode'_spec; auto using encode'_length, limb_widths_nonneg, Nat.eq_le_incl, base_from_limb_widths_length. @@ -35,7 +35,7 @@ Section LengthProofs. Lemma length_reduce : forall us, (length limb_widths <= length us <= length (ext_base limb_widths))%nat -> (length (reduce us) = length limb_widths)%nat. - Proof. + Proof using Type. rewrite extended_base_length. unfold reduce; intros. rewrite add_length_exact. @@ -48,7 +48,7 @@ Section LengthProofs. length u = length limb_widths -> length v = length limb_widths -> length (mul u v) = length limb_widths. - Proof. + Proof using Type. cbv [mul]; intros. apply length_reduce. destruct u; try congruence. @@ -75,7 +75,7 @@ Section LengthProofs. length u = length limb_widths -> length v = length limb_widths -> length (sub mm u v) = length limb_widths. - Proof. + Proof using Type*. cbv [sub]; intros. rewrite sub_length, add_length_exact. repeat rewrite Max.max_r; omega. @@ -83,19 +83,19 @@ Section LengthProofs. End Sub. Lemma length_carry_and_reduce {us}: forall i, length (carry_and_reduce i us) = length us. - Proof. intros; unfold carry_and_reduce; autorewrite with distr_length; reflexivity. Qed. + Proof using Type. intros; unfold carry_and_reduce; autorewrite with distr_length; reflexivity. Qed. Hint Rewrite @length_carry_and_reduce : distr_length. Lemma length_carry {u i} : length u = length limb_widths -> length (carry i u) = length limb_widths. - Proof. intros; unfold carry; break_if; autorewrite with distr_length; omega. Qed. + Proof using Type. intros; unfold carry; break_if; autorewrite with distr_length; omega. Qed. Hint Rewrite @length_carry : distr_length. Lemma length_carry_sequence {u i} : length u = length limb_widths -> length (carry_sequence i u) = length limb_widths. - Proof. + Proof using Type. induction i; intros; unfold carry_sequence; simpl; autorewrite with distr_length; auto. Qed. Hint Rewrite @length_carry_sequence : distr_length. @@ -103,11 +103,11 @@ Section LengthProofs. Lemma length_carry_full {u} : length u = length limb_widths -> length (carry_full u) = length limb_widths. - Proof. intros; unfold carry_full; autorewrite with distr_length; congruence. Qed. + Proof using Type. intros; unfold carry_full; autorewrite with distr_length; congruence. Qed. Hint Rewrite @length_carry_full : distr_length. Lemma length_modulus_digits : length modulus_digits = length limb_widths. - Proof. + Proof using Type. intros; unfold modulus_digits, encodeZ. rewrite encode'_spec, encode'_length; auto using encode'_length, limb_widths_nonneg, Nat.eq_le_incl, base_from_limb_widths_length. @@ -117,7 +117,7 @@ Section LengthProofs. Lemma length_conditional_subtract_modulus {int_width u cond} : length u = length limb_widths -> length (conditional_subtract_modulus int_width u cond) = length limb_widths. - Proof. + Proof using Type. intros; unfold conditional_subtract_modulus. rewrite map2_length, map_length, length_modulus_digits. apply Min.min_case; omega. @@ -127,7 +127,7 @@ Section LengthProofs. Lemma length_freeze {int_width u} : length u = length limb_widths -> length (freeze int_width u) = length limb_widths. - Proof. + Proof using Type. intros; unfold freeze; repeat autorewrite with distr_length; congruence. Qed. @@ -135,7 +135,7 @@ Section LengthProofs. {target_widths_nonneg : forall x, In x target_widths -> 0 <= x} {pf us}, length (pack target_widths_nonneg pf us) = length target_widths. - Proof. + Proof using Type. cbv [pack]; intros. apply length_convert. Qed. @@ -144,7 +144,7 @@ Section LengthProofs. {target_widths_nonneg : forall x, In x target_widths -> 0 <= x} {pf us}, length (unpack target_widths_nonneg pf us) = length limb_widths. - Proof. + Proof using Type. cbv [pack]; intros. apply length_convert. Qed. @@ -159,7 +159,7 @@ Section ModulusDigitsProofs. Local Hint Resolve limb_widths_nonneg. Lemma decode_modulus_digits : decode' base modulus_digits = modulus. - Proof. + Proof using Type. cbv [modulus_digits]. pose proof c_pos. pose proof modulus_pos. rewrite encodeZ_spec by eauto using limb_widths_nonnil, limb_widths_good. @@ -170,14 +170,14 @@ Section ModulusDigitsProofs. Qed. Lemma bounded_modulus_digits : bounded limb_widths modulus_digits. - Proof. + Proof using Type. apply bounded_encodeZ; auto using limb_widths_nonneg. pose proof modulus_pos; omega. Qed. Lemma modulus_digits_ones : forall i, (0 < i < length limb_widths)%nat -> nth_default 0 modulus_digits i = Z.ones (nth_default 0 limb_widths i). - Proof. + Proof using Type*. repeat match goal with | |- _ => progress (cbv [BaseSystem.decode]; intros) | |- _ => progress autorewrite with Ztestbit @@ -212,7 +212,7 @@ Section ModulusDigitsProofs. Lemma bounded_le_modulus_digits : forall us i, length us = length limb_widths -> bounded limb_widths us -> (0 < i < length limb_widths)%nat -> nth_default 0 us i <= nth_default 0 modulus_digits i. - Proof. + Proof using Type*. intros until 0; rewrite bounded_iff; intros. rewrite modulus_digits_ones by omega. specialize (H0 i). @@ -247,7 +247,7 @@ Section ModulusComparisonProofs. length vs = length limb_widths -> bounded limb_widths vs -> (Z.compare (decode' base (firstn i us)) (decode' base (firstn i vs)) = compare' us vs i). - Proof. + Proof using Type. induction i; repeat match goal with | |- _ => progress intros @@ -275,7 +275,7 @@ Section ModulusComparisonProofs. length vs = length limb_widths -> bounded limb_widths vs -> (Z.compare (decode' base us) (decode' base vs) = compare' us vs (length limb_widths)). - Proof. + Proof using Type. intros. rewrite <-decode_firstn_compare' by (auto || omega). rewrite !firstn_all by auto. @@ -284,14 +284,14 @@ Section ModulusComparisonProofs. Lemma ge_modulus'_0 : forall {A} f us i, ge_modulus' (A := A) f us 0 i = f 0. - Proof. + Proof using Type. induction i; intros; simpl; cbv [cmovne cmovl]; break_if; auto. Qed. Lemma ge_modulus'_01 : forall {A} f us i b, (b = 0 \/ b = 1) -> (ge_modulus' (A := A) f us b i = f 0 \/ ge_modulus' (A := A) f us b i = f 1). - Proof. + Proof using Type. induction i; intros; try intuition (subst; cbv [ge_modulus' LetIn.Let_In cmovl cmovne]; break_if; tauto). simpl; cbv [LetIn.Let_In cmovl cmovne]. @@ -300,7 +300,7 @@ Section ModulusComparisonProofs. Lemma ge_modulus_01 : forall us, (ge_modulus us = 0 \/ ge_modulus us = 1). - Proof. + Proof using Type. cbv [ge_modulus]; intros; apply ge_modulus'_01; tauto. Qed. @@ -309,7 +309,7 @@ Section ModulusComparisonProofs. forall i, (i < length us)%nat -> ge_modulus' id us 1 i = 1 -> forall j, (j <= i)%nat -> nth_default 0 modulus_digits j <= nth_default 0 us j. - Proof. + Proof using Type. induction i; repeat match goal with | |- _ => progress intros; simpl in * @@ -328,7 +328,7 @@ Section ModulusComparisonProofs. Lemma ge_modulus'_compare' : forall us, length us = length limb_widths -> bounded limb_widths us -> forall i, (i < length limb_widths)%nat -> (ge_modulus' id us 1 i = 0 <-> compare' us modulus_digits (S i) = Lt). - Proof. + Proof using Type*. induction i; repeat match goal with | |- _ => progress (intros; cbv [LetIn.Let_In id cmovne cmovl]) @@ -360,7 +360,7 @@ Section ModulusComparisonProofs. Lemma ge_modulus_spec : forall u, length u = length limb_widths -> bounded limb_widths u -> (ge_modulus u = 0 <-> 0 <= BaseSystem.decode base u < modulus). - Proof. + Proof using Type*. cbv [ge_modulus]; intros. assert (0 < length limb_widths)%nat by (pose proof limb_widths_nonnil; destruct limb_widths; @@ -391,14 +391,14 @@ Section ConditionalSubtractModulusProofs. Lemma map2_sub_eq : forall us vs, length us = length vs -> map2 (fun x y => x - y) us vs = BaseSystem.sub us vs. - Proof. + Proof using lt_1_length_limb_widths. induction us; destruct vs; boring; try omega. Qed. (* TODO : ListUtil *) Lemma map_id_strong : forall {A} f (xs : list A), (forall x, In x xs -> f x = x) -> map f xs = xs. - Proof. + Proof using Type. induction xs; intros; auto. simpl; f_equal; auto using in_eq, in_cons. Qed. @@ -406,7 +406,7 @@ Section ConditionalSubtractModulusProofs. Lemma bounded_digit_fits : forall us, length us = length limb_widths -> bounded limb_widths us -> forall x, In x us -> 0 <= x < 2 ^ B. - Proof. + Proof using B_compat c_upper_bound lt_1_length_limb_widths. intros. let i := fresh "i" in match goal with H : In ?x ?us, Hb : bounded _ _ |- _ => @@ -421,7 +421,7 @@ Section ConditionalSubtractModulusProofs. Lemma map_land_max_ones : forall us, length us = length limb_widths -> bounded limb_widths us -> map (Z.land (Z.ones B)) us = us. - Proof. + Proof using Type*. repeat match goal with | |- _ => progress intros | |- _ => apply map_id_strong @@ -433,7 +433,7 @@ Section ConditionalSubtractModulusProofs. Qed. Lemma map_land_zero : forall us, map (Z.land 0) us = zeros (length us). - Proof. + Proof using Type. induction us; boring. Qed. @@ -443,7 +443,7 @@ Section ConditionalSubtractModulusProofs. length u = length limb_widths -> BaseSystem.decode base (conditional_subtract_modulus B u cond) = BaseSystem.decode base u - cond * modulus. - Proof. + Proof using Type*. repeat match goal with | |- _ => progress (cbv [conditional_subtract_modulus neg]; intros) | |- _ => destruct cond_01; subst @@ -463,7 +463,7 @@ Section ConditionalSubtractModulusProofs. length u = length limb_widths -> bounded limb_widths u -> bounded limb_widths (conditional_subtract_modulus B u (ge_modulus u)). - Proof. + Proof using Type*. repeat match goal with | |- _ => progress (cbv [conditional_subtract_modulus neg]; intros) | |- _ => unique pose proof bounded_modulus_digits @@ -491,7 +491,7 @@ Section ConditionalSubtractModulusProofs. Lemma bounded_mul2_modulus : forall u, length u = length limb_widths -> bounded limb_widths u -> ge_modulus u = 1 -> modulus <= BaseSystem.decode base u < 2 * modulus. - Proof. + Proof using c_upper_bound lt_1_length_limb_widths. intros. pose proof (@decode_upper_bound _ limb_widths_nonneg u). specialize_by auto. @@ -525,7 +525,7 @@ Section ConditionalSubtractModulusProofs. length u = length limb_widths -> bounded limb_widths u -> ge_modulus (conditional_subtract_modulus B u (ge_modulus u)) = 0. - Proof. + Proof using Type*. intros. rewrite ge_modulus_spec by auto using length_conditional_subtract_modulus, conditional_subtract_modulus_preserves_bounded. pose proof (ge_modulus_01 u) as Hgm01. diff --git a/src/ModularArithmetic/ModularBaseSystemOpt.v b/src/ModularArithmetic/ModularBaseSystemOpt.v index 121e605a3..0a240568b 100644 --- a/src/ModularArithmetic/ModularBaseSystemOpt.v +++ b/src/ModularArithmetic/ModularBaseSystemOpt.v @@ -596,7 +596,7 @@ Section Multiplication. Definition mul_bi'_opt_correct (i : nat) (vsr : list Z) (bs : list Z) : mul_bi'_opt i vsr bs = mul_bi' bs i vsr. - Proof. + Proof using Type. revert i; induction vsr as [|vsr vsrs IHvsr]; intros. { reflexivity. } { simpl mul_bi'. @@ -621,7 +621,7 @@ Section Multiplication. Lemma map_zeros : forall a n l, List.map (Z.mul a) (zeros n ++ l) = zeros n ++ List.map (Z.mul a) l. - Proof. + Proof using prm. induction n; simpl; [ reflexivity | intros; apply f_equal2; [ omega | congruence ] ]. Qed. @@ -660,7 +660,7 @@ Section Multiplication. Definition mul'_opt_correct (usr vs : list Z) (bs : list Z) : mul'_opt usr vs bs = mul' bs usr vs. - Proof. + Proof using prm. revert vs; induction usr as [|usr usrs IHusr]; intros. { reflexivity. } { simpl. @@ -769,7 +769,7 @@ Section PowInv. Lemma fold_chain_opt_correct : forall {T} (id : T) op chain acc, fold_chain_opt id op chain acc = fold_chain id op chain acc. - Proof. + Proof using Type. reflexivity. Qed. @@ -940,7 +940,7 @@ Section Canonicalization. Lemma ge_modulus'_cps : forall {A} (f : Z -> A) (us : list Z) i b, f (ge_modulus' id us b i) = ge_modulus' f us b i. - Proof. + Proof using Type. induction i; intros; simpl; cbv [Let_In cmovl cmovne]; break_if; try reflexivity; apply IHi. Qed. @@ -1029,7 +1029,7 @@ Section SquareRoots. Lemma if_equiv : forall {A} (eqA : A -> A -> Prop) (x0 x1 : bool) y0 y1 z0 z1, x0 = x1 -> eqA y0 y1 -> eqA z0 z1 -> eqA (if x0 then y0 else z0) (if x1 then y1 else z1). - Proof. + Proof using Type. intros; repeat break_if; congruence. Qed. diff --git a/src/ModularArithmetic/ModularBaseSystemProofs.v b/src/ModularArithmetic/ModularBaseSystemProofs.v index 57ae4e10d..9b22187bd 100644 --- a/src/ModularArithmetic/ModularBaseSystemProofs.v +++ b/src/ModularArithmetic/ModularBaseSystemProofs.v @@ -61,25 +61,25 @@ Section FieldOperationProofs. Local Hint Unfold rep decode ModularBaseSystemList.decode. Lemma rep_decode : forall us x, us ~= x -> decode us = x. - Proof. + Proof using Type. autounfold; intuition. Qed. Lemma decode_rep : forall us, rep us (decode us). - Proof. + Proof using Type. cbv [rep]; auto. Qed. Lemma encode_eq : forall x : F modulus, ModularBaseSystemList.encode x = BaseSystem.encode base (F.to_Z x) (2 ^ k). - Proof. + Proof using Type. cbv [ModularBaseSystemList.encode BaseSystem.encode encodeZ]; intros. rewrite base_from_limb_widths_length. apply encode'_spec; auto using Nat.eq_le_incl. Qed. Lemma encode_rep : forall x : F modulus, encode x ~= x. - Proof. + Proof using Type. autounfold; cbv [encode]; intros. rewrite to_list_from_list; autounfold. rewrite encode_eq, encode_rep. @@ -94,7 +94,7 @@ Section FieldOperationProofs. Qed. Lemma bounded_encode : forall x, bounded limb_widths (to_list (encode x)). - Proof. + Proof using Type. intros. cbv [encode]; rewrite to_list_from_list. cbv [ModularBaseSystemList.encode]. @@ -118,7 +118,7 @@ Section FieldOperationProofs. Lemma add_rep : forall u v x y, u ~= x -> v ~= y -> add u v ~= (x+y)%F. - Proof. + Proof using Type. autounfold; cbv [add]; intros. rewrite to_list_from_list; autounfold. rewrite add_rep, F.of_Z_add. @@ -126,18 +126,18 @@ Section FieldOperationProofs. Qed. Lemma eq_rep_iff : forall u v, (eq u v <-> u ~= decode v). - Proof. + Proof using Type. reflexivity. Qed. Lemma eq_dec : forall x y, Decidable.Decidable (eq x y). - Proof. + Proof using Type. intros. destruct (F.eq_dec (decode x) (decode y)); [ left | right ]; congruence. Qed. Lemma modular_base_system_add_monoid : @monoid digits eq add zero. - Proof. + Proof using Type. repeat match goal with | |- _ => progress intro | |- _ => cbv [zero]; rewrite encode_rep @@ -171,7 +171,7 @@ Section FieldOperationProofs. Qed. Lemma mul_rep : forall u v x y, u ~= x -> v ~= y -> mul u v ~= (x*y)%F. - Proof. + Proof using Type. autounfold in *; unfold ModularBaseSystem.mul in *. intuition idtac; subst. rewrite to_list_from_list. @@ -185,7 +185,7 @@ Section FieldOperationProofs. Qed. Lemma modular_base_system_mul_monoid : @monoid digits eq mul one. - Proof. + Proof using Type. repeat match goal with | |- _ => progress intro | |- _ => cbv [one]; rewrite encode_rep @@ -207,7 +207,7 @@ Section FieldOperationProofs. Lemma Fdecode_decode_mod : forall us x, decode us = x -> BaseSystem.decode base (to_list us) mod modulus = F.to_Z x. - Proof. + Proof using Type. autounfold; intros. rewrite <-H. apply F.to_Z_of_Z. @@ -227,7 +227,7 @@ Section FieldOperationProofs. Qed. Lemma opp_rep : forall mm pf u x, u ~= x -> opp mm pf u ~= F.opp x. - Proof. + Proof using Type. cbv [opp rep]; intros. rewrite sub_rep by (apply encode_rep || eassumption). apply F.eq_to_Z_iff. @@ -244,7 +244,7 @@ Section FieldOperationProofs. Lemma scalarmult_rep : forall u x n, u ~= x -> (@ScalarMult.scalarmult_ref digits mul one n u) ~= (x ^ (N.of_nat n))%F. - Proof. + Proof using Type. induction n; intros. + cbv [N.to_nat ScalarMult.scalarmult_ref]. rewrite F.pow_0_r. apply encode_rep. @@ -256,7 +256,7 @@ Section FieldOperationProofs. Lemma pow_rep : forall chain u x, u ~= x -> pow u chain ~= F.pow x (fold_chain 0%N N.add chain (1%N :: nil)). - Proof. + Proof using Type. cbv [pow rep]; intros. erewrite (@fold_chain_exp _ _ _ _ modular_base_system_mul_monoid) by (apply @ScalarMult.scalarmult_ref_is_scalarmult; apply modular_base_system_mul_monoid). @@ -267,7 +267,7 @@ Section FieldOperationProofs. Lemma inv_rep : forall chain pf u x, u ~= x -> inv chain pf u ~= F.inv x. - Proof. + Proof using modulus_gt_2. cbv [inv]; intros. rewrite (@F.Fq_inv_fermat _ prime_modulus modulus_gt_2). etransitivity; [ apply pow_rep; eassumption | ]. @@ -280,13 +280,13 @@ Section FieldOperationProofs. Import Morphisms. Global Instance encode_Proper : Proper (Logic.eq ==> eq) encode. - Proof. + Proof using Type. repeat intro; cbv [eq]. rewrite !encode_rep. assumption. Qed. Global Instance add_Proper : Proper (eq ==> eq ==> eq) add. - Proof. + Proof using Type. repeat intro. cbv beta delta [eq] in *. erewrite !add_rep; cbv [rep] in *; try reflexivity; assumption. @@ -294,7 +294,7 @@ Section FieldOperationProofs. Global Instance sub_Proper mm mm_correct : Proper (eq ==> eq ==> eq) (sub mm mm_correct). - Proof. + Proof using Type. repeat intro. cbv beta delta [eq] in *. erewrite !sub_rep; cbv [rep] in *; try reflexivity; assumption. @@ -302,20 +302,20 @@ Section FieldOperationProofs. Global Instance opp_Proper mm mm_correct : Proper (eq ==> eq) (opp mm mm_correct). - Proof. + Proof using Type. cbv [opp]; repeat intro. apply sub_Proper; assumption || reflexivity. Qed. Global Instance mul_Proper : Proper (eq ==> eq ==> eq) mul. - Proof. + Proof using Type. repeat intro. cbv beta delta [eq] in *. erewrite !mul_rep; cbv [rep] in *; try reflexivity; assumption. Qed. Global Instance pow_Proper : Proper (eq ==> Logic.eq ==> eq) pow. - Proof. + Proof using Type. repeat intro. cbv beta delta [eq] in *. erewrite !pow_rep; cbv [rep] in *; subst; try reflexivity. @@ -323,13 +323,13 @@ Section FieldOperationProofs. Qed. Global Instance inv_Proper chain chain_correct : Proper (eq ==> eq) (inv chain chain_correct). - Proof. + Proof using Type. cbv [inv]; repeat intro. apply pow_Proper; assumption || reflexivity. Qed. Global Instance div_Proper : Proper (eq ==> eq ==> eq) div. - Proof. + Proof using Type. cbv [div]; repeat intro; congruence. Qed. @@ -339,7 +339,7 @@ Section FieldOperationProofs. {ec : ExponentiationChain (modulus - 2)}. Lemma _zero_neq_one : not (eq zero one). - Proof. + Proof using Type. cbv [eq zero one]; erewrite !encode_rep. pose proof (@F.field_modulo modulus prime_modulus). apply zero_neq_one. @@ -347,7 +347,7 @@ Section FieldOperationProofs. Lemma modular_base_system_field : @field digits eq zero one (opp coeff coeff_mod) add (sub coeff coeff_mod) mul (inv chain chain_correct) div. - Proof. + Proof using modulus_gt_2. eapply (Field.isomorphism_to_subfield_field (phi := decode) (fieldR := @F.field_modulo modulus prime_modulus)). Grab Existential Variables. + intros; eapply encode_rep. @@ -375,7 +375,7 @@ Section CarryProofs. Local Hint Resolve log_cap_nonneg. Lemma base_length_lt_pred : (pred (length base) < length base)%nat. - Proof. + Proof using Type. pose proof limb_widths_nonnil; rewrite base_from_limb_widths_length. destruct limb_widths; congruence || distr_length. Qed. @@ -386,7 +386,7 @@ Section CarryProofs. Lemma carry_done_bounds : forall us, (length us = length base) -> (carry_done us <-> forall i, 0 <= nth_default 0 us i < 2 ^ log_cap i). - Proof. + Proof using Type. intros ? ?; unfold carry_done; split; [ intros Hcarry_done i | intros Hbounds i i_lt ]. + destruct (lt_dec i (length base)) as [i_lt | i_nlt]. - specialize (Hcarry_done i i_lt). @@ -410,7 +410,7 @@ Section CarryProofs. (length us = length limb_widths) -> BaseSystem.decode base (carry_and_reduce (pred (length limb_widths)) us) mod modulus = BaseSystem.decode base us mod modulus. - Proof. + Proof using Type. cbv [carry_and_reduce]; intros. rewrite carry_gen_decode_eq; auto. distr_length. @@ -443,7 +443,7 @@ Section CarryProofs. (i < length limb_widths)%nat -> forall pf1 pf2, from_list _ us pf1 ~= x -> from_list _ (carry i us) pf2 ~= x. - Proof. + Proof using Type. cbv [carry rep decode]; intros. rewrite to_list_from_list. pose proof carry_decode_eq_reduce. pose proof (@carry_simple_decode_eq limb_widths). @@ -462,7 +462,7 @@ Section CarryProofs. Lemma decode_mod_Fdecode : forall u, length u = length limb_widths -> BaseSystem.decode base u mod modulus= F.to_Z (decode (from_list_default 0 _ u)). - Proof. + Proof using Type. intros. rewrite <-(to_list_from_list _ u) with (pf := H). erewrite Fdecode_decode_mod by reflexivity. @@ -474,7 +474,7 @@ Section CarryProofs. Lemma carry_sequence_rep : forall is us x, (forall i, In i is -> (i < length limb_widths)%nat) -> us ~= x -> forall pf, from_list _ (carry_sequence is (to_list _ us)) pf ~= x. - Proof. + Proof using Type. induction is; intros. + cbv [carry_sequence fold_right]. rewrite from_list_to_list. assumption. + simpl. apply carry_rep with (pf1 := length_carry_sequence (length_to_list us)); @@ -486,7 +486,7 @@ Section CarryProofs. Lemma carry_mul_rep : forall us vs x y, rep us x -> rep vs y -> rep (carry_mul carry_chain us vs) (x * y)%F. - Proof. + Proof using Type. cbv [carry_mul]; intros; apply carry_sequence_rep; auto using carry_chain_valid, mul_rep. Qed. @@ -495,7 +495,7 @@ Section CarryProofs. eq (carry_sub carry_chain coeff coeff_mod a b) (sub coeff coeff_mod a b). - Proof. + Proof using Type. cbv [carry_sub carry_]; intros. eapply carry_sequence_rep; auto using carry_chain_valid. reflexivity. @@ -503,7 +503,7 @@ Section CarryProofs. Lemma carry_add_rep : forall a b, eq (carry_add carry_chain a b) (add a b). - Proof. + Proof using Type. cbv [carry_add carry_]; intros. eapply carry_sequence_rep; auto using carry_chain_valid. reflexivity. @@ -513,7 +513,7 @@ Section CarryProofs. eq (carry_opp carry_chain coeff coeff_mod a) (opp coeff coeff_mod a). - Proof. + Proof using Type. cbv [carry_opp opp]; intros. apply carry_sub_rep. Qed. @@ -556,7 +556,7 @@ Section CanonicalizationProofs. then c * (us [i mod length limb_widths]) >> (limb_widths [i mod length limb_widths]) else 0 else 0. - Proof. + Proof using Type. cbv [carry_and_reduce]; intros. autorewrite with push_nth_default. reflexivity. @@ -582,7 +582,7 @@ Section CanonicalizationProofs. then (us [i]) >> (limb_widths [i]) else 0 else 0. - Proof. + Proof using Type*. intros. cbv [carry]. break_innermost_match_step. @@ -622,7 +622,7 @@ Section CanonicalizationProofs. else 0) else Z.pow2_mod (us {{ pred i }} [n]) (limb_widths [n]) else 0. - Proof. + Proof using Type*. induction i; intros; cbv [carry_sequence]. + cbv [pred make_chain fold_right]. break_match; subst; omega || reflexivity || auto using Z.add_0_r. @@ -641,14 +641,14 @@ Section CanonicalizationProofs. (i < length us)%nat -> nth_default 0 (carry i us) i = Z.pow2_mod (us [i]) (limb_widths [i]). - Proof. + Proof using Type*. intros; pose proof lt_1_length_limb_widths; autorewrite with push_nth_default natsimplify; break_match; omega. Qed. Hint Rewrite @nth_default_carry using (omega || distr_length; omega) : push_nth_default. Lemma pow_limb_widths_gt_1 : forall i, (i < length limb_widths)%nat -> 1 < 2 ^ limb_widths [i]. - Proof. + Proof using Type. intros. apply Z.pow_gt_1; try omega. apply nth_default_preserves_properties_length_dep; intros; try omega. @@ -656,7 +656,7 @@ Section CanonicalizationProofs. Qed. Lemma carry_sequence_nil_l : forall us, carry_sequence nil us = us. - Proof. + Proof using Type. reflexivity. Qed. @@ -719,7 +719,7 @@ Section CanonicalizationProofs. if eq_nat_dec n 0 then 2 * 2 ^ limb_widths [n] else 2 ^ limb_widths [n]. - Proof. + Proof using Type*. induction i; bound_during_loop. Qed. @@ -738,7 +738,7 @@ Section CanonicalizationProofs. length (f us) = length limb_widths -> (forall n, (n < length limb_widths)%nat -> 0 <= us [n] < bound us n) -> forall n, (n < length limb_widths)%nat -> 0 <= (carry_full (f us)) [n] < bound'' (f us) n. - Proof. + Proof using Type*. pose proof lt_1_length_limb_widths. cbv [carry_full full_carry_chain]; intros ? ? ? ? ? ? ? ? Hloop Hfbound Hflength Hbound n. specialize (Hfbound Hbound). @@ -762,7 +762,7 @@ Section CanonicalizationProofs. -> length (f us) = length limb_widths -> (forall n, (n < length limb_widths)%nat -> 0 <= us [n] < bound us n) -> forall n, 0 <= (carry_full (f us)) [n] < bound'' (f us) n. - Proof. + Proof using Type*. pose proof lt_1_length_limb_widths. cbv [carry_full full_carry_chain]; intros ? ? ? ? ? ? ? ? Hloop Hfbound Hflength Hbound n. specialize (Hfbound Hbound). @@ -779,7 +779,7 @@ Section CanonicalizationProofs. if eq_nat_dec n 0 then 2 * 2 ^ limb_widths [n] else 2 ^ limb_widths [n]. - Proof. + Proof using Type*. intros ? ?. apply (bound_after_loop_length_preconditions us H id bound_during_first_loop); auto. Qed. @@ -792,7 +792,7 @@ Section CanonicalizationProofs. if eq_nat_dec n 0 then 2 * 2 ^ limb_widths [n] else 2 ^ limb_widths [n]. - Proof. + Proof using Type*. intros. destruct (lt_dec n (length limb_widths)); auto using bound_after_first_loop_pre. @@ -819,7 +819,7 @@ Section CanonicalizationProofs. if eq_nat_dec n 0 then 2 ^ limb_widths [n] + c else 2 ^ limb_widths [n]. - Proof. + Proof using Type*. induction i; bound_during_loop. Qed. @@ -831,7 +831,7 @@ Section CanonicalizationProofs. if eq_nat_dec n 0 then 2 ^ limb_widths [n] + c else 2 ^ limb_widths [n]. - Proof. + Proof using Type*. intros ? ?; apply (bound_after_loop us H carry_full bound_during_second_loop); auto using length_carry_full, bound_after_first_loop. Qed. @@ -858,7 +858,7 @@ Section CanonicalizationProofs. else us[n] + 1 else 2 ^ limb_widths [n]. - Proof. + Proof using Type*. induction i; bound_during_loop. Qed. @@ -867,7 +867,7 @@ Section CanonicalizationProofs. (forall n, (n < length limb_widths)%nat -> 0 <= us [n] < 2 ^ B - if eq_nat_dec n 0 then 0 else ((2 ^ B) >> (limb_widths [pred n]))) -> forall n, 0 <= (carry_full (carry_full (carry_full us))) [n] < 2 ^ limb_widths [n]. - Proof. + Proof using Type*. intros ? ?. apply (bound_after_loop us H (fun x => carry_full (carry_full x)) bound_during_third_loop); auto using length_carry_full, bound_after_second_loop. @@ -886,7 +886,7 @@ Section CanonicalizationProofs. Lemma decode_bitwise_eq_iff : forall u v, minimal_rep u -> minimal_rep v -> (fieldwise Logic.eq u v <-> decode_bitwise limb_widths (to_list _ u) = decode_bitwise limb_widths (to_list _ v)). - Proof. + Proof using Type. intros. rewrite !decode_bitwise_spec by (tauto || auto using length_to_list). rewrite fieldwise_to_list_iff. @@ -899,14 +899,14 @@ Section CanonicalizationProofs. Qed. Lemma c_upper_bound : c - 1 < 2 ^ limb_widths[0]. - Proof. + Proof using Type*. pose proof c_reduce2. pose proof c_pos. omega. Qed. Hint Resolve c_upper_bound. Lemma minimal_rep_encode : forall x, minimal_rep (encode x). - Proof. + Proof using Type*. split; intros; auto using bounded_encode. apply ge_modulus_spec; auto using bounded_encode, length_to_list. apply encode_range. @@ -914,7 +914,7 @@ Section CanonicalizationProofs. Lemma encode_minimal_rep : forall u x, rep u x -> minimal_rep u -> fieldwise Logic.eq u (encode x). - Proof. + Proof using Type*. intros. apply decode_bitwise_eq_iff; auto using minimal_rep_encode. rewrite !decode_bitwise_spec by (intuition auto; distr_length; try apply minimal_rep_encode). @@ -928,7 +928,7 @@ Section CanonicalizationProofs. Lemma bounded_canonical : forall u v x y, rep u x -> rep v y -> minimal_rep u -> minimal_rep v -> (x = y <-> fieldwise Logic.eq u v). - Proof. + Proof using Type*. intros. eapply encode_minimal_rep in H1; eauto. eapply encode_minimal_rep in H2; eauto. @@ -944,14 +944,14 @@ Section CanonicalizationProofs. Qed. Lemma int_width_compat : forall x, In x limb_widths -> x < int_width. - Proof. + Proof using Type*. intros. apply B_compat in H. eapply Z.lt_le_trans; eauto using B_le_int_width. Qed. Lemma minimal_rep_freeze : forall u, initial_bounds u -> minimal_rep (freeze int_width u). - Proof. + Proof using Type*. repeat match goal with | |- _ => progress (cbv [freeze ModularBaseSystemList.freeze]) | |- _ => progress intros @@ -968,7 +968,7 @@ Section CanonicalizationProofs. Lemma freeze_decode : forall u, BaseSystem.decode base (to_list _ (freeze int_width u)) mod modulus = BaseSystem.decode base (to_list _ u) mod modulus. - Proof. + Proof using Type*. repeat match goal with | |- _ => progress cbv [freeze ModularBaseSystemList.freeze] | |- _ => progress intros @@ -996,7 +996,7 @@ Section CanonicalizationProofs. Qed. Lemma freeze_rep : forall u x, rep u x -> rep (freeze int_width u) x. - Proof. + Proof using Type*. cbv [rep]; intros. apply F.eq_to_Z_iff. erewrite <-!Fdecode_decode_mod by eauto. @@ -1007,7 +1007,7 @@ Section CanonicalizationProofs. initial_bounds u -> initial_bounds v -> (x = y <-> fieldwise Logic.eq (freeze int_width u) (freeze int_width v)). - Proof. + Proof using Type*. intros; apply bounded_canonical; auto using freeze_rep, minimal_rep_freeze. Qed. @@ -1032,7 +1032,7 @@ Section SquareRootProofs. Lemma eqb_true_iff : forall u v x y, bounded_by u freeze_input_bounds -> bounded_by v freeze_input_bounds -> u ~= x -> v ~= y -> (x = y <-> eqb int_width u v = true). - Proof. + Proof using Type*. cbv [eqb freeze_input_bounds]. intros. rewrite fieldwiseb_fieldwise by (apply Z.eqb_eq). eauto using freeze_canonical. @@ -1041,7 +1041,7 @@ Section SquareRootProofs. Lemma eqb_false_iff : forall u v x y, bounded_by u freeze_input_bounds -> bounded_by v freeze_input_bounds -> u ~= x -> v ~= y -> (x <> y <-> eqb int_width u v = false). - Proof. + Proof using Type*. intros. case_eq (eqb int_width u v). + rewrite <-eqb_true_iff by eassumption; split; intros; @@ -1058,7 +1058,7 @@ Section SquareRootProofs. Lemma sqrt_3mod4_correct : forall u x, u ~= x -> (sqrt_3mod4 chain chain_correct u) ~= F.sqrt_3mod4 x. - Proof. + Proof using Type. repeat match goal with | |- _ => progress (cbv [sqrt_3mod4 F.sqrt_3mod4]; intros) | |- _ => rewrite @F.pow_2_r in * @@ -1079,7 +1079,7 @@ Section SquareRootProofs. ModularBaseSystem.eq powx (pow u chain) -> ModularBaseSystem.eq powx_squared (mul powx powx) -> (sqrt_5mod8 int_width powx powx_squared chain chain_correct sqrt_m1 u) ~= F.sqrt_5mod8 (decode sqrt_m1) x. - Proof. + Proof using freeze_pre. cbv [sqrt_5mod8 F.sqrt_5mod8]. intros. repeat match goal with @@ -1120,7 +1120,7 @@ Section ConversionProofs. (BaseSystem.decode target_base (to_list _ (pack target_widths_nonneg bits_eq w)))). - Proof. + Proof using Type. intros; cbv [pack ModularBaseSystemList.pack rep]. rewrite Tuple.to_list_from_list. apply F.eq_to_Z_iff. @@ -1132,7 +1132,7 @@ Section ConversionProofs. bounded target_widths (to_list _ w) -> rep (unpack target_widths_nonneg bits_eq w) (F.of_Z modulus (BaseSystem.decode target_base (to_list _ w))). - Proof. + Proof using Type. intros; cbv [unpack ModularBaseSystemList.unpack rep]. apply F.eq_to_Z_iff. rewrite <-from_list_default_eq with (d := 0). diff --git a/src/ModularArithmetic/Montgomery/ZBounded.v b/src/ModularArithmetic/Montgomery/ZBounded.v index 2e9f3b3cc..2c5936d30 100644 --- a/src/ModularArithmetic/Montgomery/ZBounded.v +++ b/src/ModularArithmetic/Montgomery/ZBounded.v @@ -90,7 +90,7 @@ Section montgomery. (decode_small (proj1_sig (reduce_via_partial v))) (decode_large v * R') /\ Z.min 0 (small_bound - modulus) <= (decode_small (proj1_sig (reduce_via_partial v))) < modulus. - Proof. + Proof using H Hmod Hmod' Hv. rewrite (proj1 (proj2_sig (reduce_via_partial v) H)). eauto 6 using reduce_via_partial_correct, reduce_via_partial_in_range, decode_small_valid. Qed. @@ -100,7 +100,7 @@ Section montgomery. (decode_small (proj1_sig (reduce_via_partial v))) (decode_large v * R') /\ 0 <= (decode_small (proj1_sig (reduce_via_partial v))) < modulus. - Proof. + Proof using H Hmod Hmod' Hv. pose proof (proj2 (proj2_sig (reduce_via_partial v) H)) as H'. apply decode_small_valid in H'. destruct reduce_via_partial_correct'; split; eauto; omega. @@ -108,7 +108,7 @@ Section montgomery. Theorem reduce_via_partial_correct : decode_small (proj1_sig (reduce_via_partial v)) = (decode_large v * R') mod modulus. - Proof. + Proof using H Hmod Hmod' Hv. rewrite <- (proj1 reduce_via_partial_correct''). rewrite Z.mod_small by apply reduce_via_partial_correct''. reflexivity. diff --git a/src/ModularArithmetic/Montgomery/ZProofs.v b/src/ModularArithmetic/Montgomery/ZProofs.v index 9a7ee1e3d..2d8f6155d 100644 --- a/src/ModularArithmetic/Montgomery/ZProofs.v +++ b/src/ModularArithmetic/Montgomery/ZProofs.v @@ -27,19 +27,19 @@ Section montgomery. (R'_good : R * R' ≡ 1). Lemma R'_good' : R' * R ≡ 1. - Proof. rewrite <- R'_good; apply f_equal2; lia. Qed. + Proof using R'_good. rewrite <- R'_good; apply f_equal2; lia. Qed. Local Notation to_montgomery_naive := (to_montgomery_naive R) (only parsing). Local Notation from_montgomery_naive := (from_montgomery_naive R') (only parsing). Lemma to_from_montgomery_naive x : to_montgomery_naive (from_montgomery_naive x) ≡ x. - Proof. + Proof using R'_good. unfold Z.to_montgomery_naive, Z.from_montgomery_naive. rewrite <- Z.mul_assoc, R'_good'. autorewrite with zsimplify; reflexivity. Qed. Lemma from_to_montgomery_naive x : from_montgomery_naive (to_montgomery_naive x) ≡ x. - Proof. + Proof using R'_good. unfold Z.to_montgomery_naive, Z.from_montgomery_naive. rewrite <- Z.mul_assoc, R'_good. autorewrite with zsimplify; reflexivity. @@ -52,18 +52,18 @@ Section montgomery. Local Infix "*" := (mul_naive R') : montgomery_scope. Lemma add_correct_naive x y : from_montgomery_naive (x + y) = from_montgomery_naive x + from_montgomery_naive y. - Proof. unfold Z.from_montgomery_naive, add; lia. Qed. + Proof using Type. unfold Z.from_montgomery_naive, add; lia. Qed. Lemma add_correct_naive_to x y : to_montgomery_naive (x + y) = (to_montgomery_naive x + to_montgomery_naive y)%montgomery. - Proof. unfold Z.to_montgomery_naive, add; autorewrite with push_Zmul; reflexivity. Qed. + Proof using Type. unfold Z.to_montgomery_naive, add; autorewrite with push_Zmul; reflexivity. Qed. Lemma sub_correct_naive x y : from_montgomery_naive (x - y) = from_montgomery_naive x - from_montgomery_naive y. - Proof. unfold Z.from_montgomery_naive, sub; lia. Qed. + Proof using Type. unfold Z.from_montgomery_naive, sub; lia. Qed. Lemma sub_correct_naive_to x y : to_montgomery_naive (x - y) = (to_montgomery_naive x - to_montgomery_naive y)%montgomery. - Proof. unfold Z.to_montgomery_naive, sub; autorewrite with push_Zmul; reflexivity. Qed. + Proof using Type. unfold Z.to_montgomery_naive, sub; autorewrite with push_Zmul; reflexivity. Qed. Theorem mul_correct_naive x y : from_montgomery_naive (x * y) = from_montgomery_naive x * from_montgomery_naive y. - Proof. unfold Z.from_montgomery_naive, mul_naive; lia. Qed. + Proof using Type. unfold Z.from_montgomery_naive, mul_naive; lia. Qed. Theorem mul_correct_naive_to x y : to_montgomery_naive (x * y) ≡ (to_montgomery_naive x * to_montgomery_naive y)%montgomery. - Proof. + Proof using R'_good. unfold Z.to_montgomery_naive, mul_naive. rewrite <- !Z.mul_assoc, R'_good. autorewrite with zsimplify; apply (f_equal2 Z.modulo); lia. @@ -77,10 +77,10 @@ Section montgomery. (N'_good : N * N' ≡ᵣ -1). Lemma N'_good' : N' * N ≡ᵣ -1. - Proof. rewrite <- N'_good; apply f_equal2; lia. Qed. + Proof using N'_good. rewrite <- N'_good; apply f_equal2; lia. Qed. Lemma N'_good'_alt x : (((x mod R) * (N' mod R)) mod R) * (N mod R) ≡ᵣ x * -1. - Proof. + Proof using N'_good. rewrite <- N'_good', Z.mul_assoc. unfold Z.equiv_modulo; push_Zmod. reflexivity. @@ -96,7 +96,7 @@ Section montgomery. unfold Z.equiv_modulo; push_Zmod; autorewrite with zsimplify; reflexivity. Lemma prereduce_correct : prereduce T ≡ T * R'. - Proof. + Proof using N'_good N'_in_range N_reasonable R'_good. transitivity ((T + m * N) * R'). { unfold Z.prereduce. autorewrite with zstrip_div; push_Zmod. @@ -107,19 +107,19 @@ Section montgomery. Qed. Lemma reduce_correct : reduce N R N' T ≡ T * R'. - Proof. + Proof using N'_good N'_in_range N_reasonable R'_good. unfold reduce. break_match; rewrite prereduce_correct; t_fin_correct. Qed. Lemma partial_reduce_correct : partial_reduce N R N' T ≡ T * R'. - Proof. + Proof using N'_good N'_in_range N_reasonable R'_good. unfold partial_reduce. break_match; rewrite prereduce_correct; t_fin_correct. Qed. Lemma reduce_via_partial_correct : reduce_via_partial N R N' T ≡ T * R'. - Proof. + Proof using N'_good N'_in_range N_reasonable R'_good. unfold reduce_via_partial. break_match; rewrite partial_reduce_correct; t_fin_correct. Qed. @@ -131,7 +131,7 @@ Section montgomery. : 0 <= N -> 0 <= T <= R * B -> 0 <= prereduce T < B + N. - Proof. unfold Z.prereduce; auto with zarith nia. Qed. + Proof using N_reasonable m_small. unfold Z.prereduce; auto with zarith nia. Qed. End generic. Section N_very_small. @@ -140,7 +140,7 @@ Section montgomery. Lemma prereduce_in_range_very_small : 0 <= T <= (2 * N - 1) * (2 * N - 1) -> 0 <= prereduce T < 2 * N. - Proof. pose proof (prereduce_in_range_gen N); nia. Qed. + Proof using N_reasonable N_very_small m_small. pose proof (prereduce_in_range_gen N); nia. Qed. End N_very_small. Section N_small. @@ -149,12 +149,12 @@ Section montgomery. Lemma prereduce_in_range_small : 0 <= T <= (2 * N - 1) * (N - 1) -> 0 <= prereduce T < 2 * N. - Proof. pose proof (prereduce_in_range_gen N); nia. Qed. + Proof using N_reasonable N_small m_small. pose proof (prereduce_in_range_gen N); nia. Qed. Lemma prereduce_in_range_small_fully_reduced : 0 <= T <= 2 * N -> 0 <= prereduce T <= N. - Proof. pose proof (prereduce_in_range_gen 1); nia. Qed. + Proof using N_reasonable N_small m_small. pose proof (prereduce_in_range_gen 1); nia. Qed. End N_small. Section N_small_enough. @@ -163,12 +163,12 @@ Section montgomery. Lemma prereduce_in_range_small_enough : 0 <= T <= R * R -> 0 <= prereduce T < R + N. - Proof. pose proof (prereduce_in_range_gen R); nia. Qed. + Proof using N_reasonable N_small_enough m_small. pose proof (prereduce_in_range_gen R); nia. Qed. Lemma reduce_in_range_R : 0 <= T <= R * R -> 0 <= reduce N R N' T < R. - Proof. + Proof using N_reasonable N_small_enough m_small. intro H; pose proof (prereduce_in_range_small_enough H). unfold reduce, Z.prereduce in *; break_match; Z.ltb_to_lt; nia. Qed. @@ -176,7 +176,7 @@ Section montgomery. Lemma partial_reduce_in_range_R : 0 <= T <= R * R -> 0 <= partial_reduce N R N' T < R. - Proof. + Proof using N_reasonable N_small_enough m_small. intro H; pose proof (prereduce_in_range_small_enough H). unfold partial_reduce, Z.prereduce in *; break_match; Z.ltb_to_lt; nia. Qed. @@ -184,7 +184,7 @@ Section montgomery. Lemma reduce_via_partial_in_range_R : 0 <= T <= R * R -> 0 <= reduce_via_partial N R N' T < R. - Proof. + Proof using N_reasonable N_small_enough m_small. intro H; pose proof (prereduce_in_range_small_enough H). unfold reduce_via_partial, partial_reduce, Z.prereduce in *; break_match; Z.ltb_to_lt; nia. Qed. @@ -194,12 +194,12 @@ Section montgomery. Lemma prereduce_in_range : 0 <= T <= R * N -> 0 <= prereduce T < 2 * N. - Proof. pose proof (prereduce_in_range_gen N); nia. Qed. + Proof using N_reasonable m_small. pose proof (prereduce_in_range_gen N); nia. Qed. Lemma reduce_in_range : 0 <= T <= R * N -> 0 <= reduce N R N' T < N. - Proof. + Proof using N_reasonable m_small. intro H; pose proof (prereduce_in_range H). unfold reduce, Z.prereduce in *; break_match; Z.ltb_to_lt; nia. Qed. @@ -207,7 +207,7 @@ Section montgomery. Lemma partial_reduce_in_range : 0 <= T <= R * N -> Z.min 0 (R - N) <= partial_reduce N R N' T < 2 * N. - Proof. + Proof using N_reasonable m_small. intro H; pose proof (prereduce_in_range H). unfold partial_reduce, Z.prereduce in *; break_match; Z.ltb_to_lt; apply Z.min_case_strong; nia. @@ -216,7 +216,7 @@ Section montgomery. Lemma reduce_via_partial_in_range : 0 <= T <= R * N -> Z.min 0 (R - N) <= reduce_via_partial N R N' T < N. - Proof. + Proof using N_reasonable m_small. intro H; pose proof (partial_reduce_in_range H). unfold reduce_via_partial in *; break_match; Z.ltb_to_lt; lia. Qed. @@ -226,7 +226,7 @@ Section montgomery. Context (N_in_range : 0 <= N < R) (T_representable : 0 <= T < R * R). Lemma partial_reduce_alt_eq : partial_reduce_alt N R N' T = partial_reduce N R N' T. - Proof. + Proof using N_in_range N_reasonable T_representable m_small. assert (0 <= T + m * N < 2 * (R * R)) by nia. assert (0 <= T + m * N < R * (R + N)) by nia. assert (0 <= (T + m * N) / R < R + N) by auto with zarith. @@ -252,7 +252,7 @@ Section montgomery. Local Notation to_montgomery := (to_montgomery N R N'). Local Notation from_montgomery := (from_montgomery N R N'). Lemma to_from_montgomery a : to_montgomery (from_montgomery a) ≡ a. - Proof. + Proof using N'_good N'_in_range N_reasonable R'_good. unfold Z.to_montgomery, Z.from_montgomery. transitivity ((a * 1) * 1); [ | apply f_equal2; lia ]. rewrite <- !R'_good, !reduce_correct. @@ -260,7 +260,7 @@ Section montgomery. apply f_equal2; lia. Qed. Lemma from_to_montgomery a : from_montgomery (to_montgomery a) ≡ a. - Proof. + Proof using N'_good N'_in_range N_reasonable R'_good. unfold Z.to_montgomery, Z.from_montgomery. rewrite !reduce_correct. transitivity (a * ((R * (R * R' mod N) * R') mod N)). @@ -273,12 +273,12 @@ Section montgomery. Qed. Theorem mul_correct x y : from_montgomery (x * y) ≡ from_montgomery x * from_montgomery y. - Proof. + Proof using N'_good N'_in_range N_reasonable R'_good. unfold Z.from_montgomery, mul. rewrite !reduce_correct; apply f_equal2; lia. Qed. Theorem mul_correct_to x y : to_montgomery (x * y) ≡ (to_montgomery x * to_montgomery y)%montgomery. - Proof. + Proof using N'_good N'_in_range N_reasonable R'_good. unfold Z.to_montgomery, mul. rewrite !reduce_correct. transitivity (x * y * R * 1 * 1 * 1); diff --git a/src/ModularArithmetic/Pow2BaseProofs.v b/src/ModularArithmetic/Pow2BaseProofs.v index 914b19c11..7a5bb4255 100644 --- a/src/ModularArithmetic/Pow2BaseProofs.v +++ b/src/ModularArithmetic/Pow2BaseProofs.v @@ -31,7 +31,7 @@ Section Pow2BaseProofs. Local Notation base := (base_from_limb_widths limb_widths). Lemma base_from_limb_widths_length ls : length (base_from_limb_widths ls) = length ls. - Proof. + Proof using Type. clear limb_widths limb_widths_nonneg. induction ls; [ reflexivity | simpl in * ]. autorewrite with distr_length; auto. @@ -40,16 +40,16 @@ Section Pow2BaseProofs. Lemma base_from_limb_widths_cons : forall l0 l, base_from_limb_widths (l0 :: l) = 1 :: map (Z.mul (two_p l0)) (base_from_limb_widths l). - Proof. reflexivity. Qed. + Proof using Type. reflexivity. Qed. Hint Rewrite base_from_limb_widths_cons : push_base_from_limb_widths. Hint Rewrite <- base_from_limb_widths_cons : pull_base_from_limb_widths. Lemma base_from_limb_widths_nil : base_from_limb_widths nil = nil. - Proof. reflexivity. Qed. + Proof using Type. reflexivity. Qed. Hint Rewrite base_from_limb_widths_nil : push_base_from_limb_widths. Lemma firstn_base_from_limb_widths : forall n, firstn n (base_from_limb_widths limb_widths) = base_from_limb_widths (firstn n limb_widths). - Proof. + Proof using Type. clear limb_widths_nonneg. (* don't use this in the inductive hypothesis *) induction limb_widths as [|l ls IHls]; intros [|n]; try reflexivity. autorewrite with push_base_from_limb_widths push_firstn; boring. @@ -60,23 +60,23 @@ Section Pow2BaseProofs. Hint Rewrite @firstn_base_from_limb_widths : push_firstn. Lemma sum_firstn_limb_widths_nonneg : forall n, 0 <= sum_firstn limb_widths n. - Proof. + Proof using Type*. unfold sum_firstn; intros. apply fold_right_invariant; try omega. eauto using Z.add_nonneg_nonneg, limb_widths_nonneg, In_firstn. Qed. Hint Resolve sum_firstn_limb_widths_nonneg. Lemma two_sum_firstn_limb_widths_pos n : 0 < 2^sum_firstn limb_widths n. - Proof. auto with zarith. Qed. + Proof using Type*. auto with zarith. Qed. Lemma two_sum_firstn_limb_widths_nonzero n : 2^sum_firstn limb_widths n <> 0. - Proof. pose proof (two_sum_firstn_limb_widths_pos n); omega. Qed. + Proof using Type*. pose proof (two_sum_firstn_limb_widths_pos n); omega. Qed. Lemma base_from_limb_widths_step : forall i b w, (S i < length limb_widths)%nat -> nth_error base i = Some b -> nth_error limb_widths i = Some w -> nth_error base (S i) = Some (two_p w * b). - Proof. + Proof using Type. clear limb_widths_nonneg. (* don't use this in the inductive hypothesis *) induction limb_widths; intros ? ? ? ? nth_err_w nth_err_b; unfold base_from_limb_widths in *; fold base_from_limb_widths in *; @@ -101,7 +101,7 @@ Section Pow2BaseProofs. Lemma nth_error_base : forall i, (i < length limb_widths)%nat -> nth_error base i = Some (two_p (sum_firstn limb_widths i)). - Proof. + Proof using Type*. induction i; intros. + unfold sum_firstn, base_from_limb_widths in *; case_eq limb_widths; try reflexivity. intro lw_nil; rewrite lw_nil, (@nil_length0 Z) in *; omega. @@ -126,7 +126,7 @@ Section Pow2BaseProofs. Lemma nth_default_base : forall d i, (i < length limb_widths)%nat -> nth_default d base i = 2 ^ (sum_firstn limb_widths i). - Proof. + Proof using Type*. intros ? ? i_lt_length. apply nth_error_value_eq_nth_default. rewrite nth_error_base, two_p_correct by assumption. @@ -135,7 +135,7 @@ Section Pow2BaseProofs. Lemma base_succ : forall i, ((S i) < length limb_widths)%nat -> nth_default 0 base (S i) mod nth_default 0 base i = 0. - Proof. + Proof using Type*. intros. repeat rewrite nth_default_base by omega. apply Z.mod_same_pow. @@ -157,7 +157,7 @@ Section Pow2BaseProofs. Lemma nth_error_subst : forall i b, nth_error base i = Some b -> b = 2 ^ (sum_firstn limb_widths i). - Proof. + Proof using Type*. intros i b nth_err_b. pose proof (nth_error_value_length _ _ _ _ nth_err_b). rewrite base_from_limb_widths_length in *. @@ -167,7 +167,7 @@ Section Pow2BaseProofs. Qed. Lemma base_positive : forall b : Z, In b base -> b > 0. - Proof. + Proof using Type*. intros b In_b_base. apply In_nth_error_value in In_b_base. destruct In_b_base as [i nth_err_b]. @@ -178,7 +178,7 @@ Section Pow2BaseProofs. Qed. Lemma b0_1 : forall x : Z, limb_widths <> nil -> nth_default x base 0 = 1. - Proof. + Proof using Type. case_eq limb_widths; intros; [congruence | reflexivity]. Qed. @@ -187,7 +187,7 @@ Section Pow2BaseProofs. (l_nonneg : forall x, In x l -> 0 <= x), base_from_limb_widths (l0 ++ l) = base_from_limb_widths l0 ++ map (Z.mul (two_p (sum_firstn l0 (length l0)))) (base_from_limb_widths l). - Proof. + Proof using Type. induction l0 as [|?? IHl0]. { simpl; intros; rewrite <- map_id at 1; apply map_ext; intros; omega. } { simpl; intros; rewrite !IHl0, !map_app, map_map, sum_firstn_succ_cons, two_p_is_exp by auto with znonzero. @@ -195,7 +195,7 @@ Section Pow2BaseProofs. Qed. Lemma skipn_base_from_limb_widths : forall n, skipn n (base_from_limb_widths limb_widths) = map (Z.mul (two_p (sum_firstn limb_widths n))) (base_from_limb_widths (skipn n limb_widths)). - Proof. + Proof using Type*. intro n; pose proof (base_from_limb_widths_app (firstn n limb_widths) (skipn n limb_widths)) as H. specialize_by eauto using In_firstn, In_skipn. autorewrite with simpl_firstn simpl_skipn in *. @@ -212,7 +212,7 @@ Section Pow2BaseProofs. Lemma pow2_mod_bounded :forall lw us i, (forall w, In w lw -> 0 <= w) -> bounded lw us -> Z.pow2_mod (nth_default 0 us i) (nth_default 0 lw i) = nth_default 0 us i. - Proof. + Proof using Type. clear. repeat match goal with | |- _ => progress (cbv [bounded]; intros) @@ -231,7 +231,7 @@ Section Pow2BaseProofs. Lemma pow2_mod_bounded_iff :forall lw us, (forall w, In w lw -> 0 <= w) -> (bounded lw us <-> (forall i, Z.pow2_mod (nth_default 0 us i) (nth_default 0 lw i) = nth_default 0 us i)). - Proof. + Proof using Type. clear. split; intros; auto using pow2_mod_bounded. cbv [bounded]; intros. @@ -251,7 +251,7 @@ Section Pow2BaseProofs. Qed. Lemma bounded_nil_iff : forall us, bounded nil us <-> (forall u, In u us -> u = 0). - Proof. + Proof using Type. clear. split; cbv [bounded]; intros. + edestruct (In_nth_error_value us u); try assumption. @@ -267,7 +267,7 @@ Section Pow2BaseProofs. Qed. Lemma bounded_iff : forall lw us, bounded lw us <-> forall i, 0 <= nth_default 0 us i < 2 ^ nth_default 0 lw i. - Proof. + Proof using Type. clear. cbv [bounded]; intros. reflexivity. @@ -275,7 +275,7 @@ Section Pow2BaseProofs. Lemma digit_select : forall us i, bounded limb_widths us -> nth_default 0 us i = Z.pow2_mod (BaseSystem.decode base us >> sum_firstn limb_widths i) (nth_default 0 limb_widths i). - Proof. + Proof using Type*. intro; revert limb_widths limb_widths_nonneg; induction us; intros. + rewrite nth_default_nil, decode_nil, Z.shiftr_0_l, Z.pow2_mod_spec, Z.mod_0_l by (try (apply Z.pow_nonzero; try omega); apply nth_default_preserves_properties; auto; omega). @@ -330,7 +330,7 @@ Section Pow2BaseProofs. Qed. Lemma nth_default_limb_widths_nonneg : forall i, 0 <= nth_default 0 limb_widths i. - Proof. + Proof using Type*. intros; apply nth_default_preserves_properties; auto; omega. Qed. Hint Resolve nth_default_limb_widths_nonneg. @@ -338,7 +338,7 @@ Section Pow2BaseProofs. (0 < nth_default 0 limb_widths 0) -> length x = length limb_widths -> Z.odd (BaseSystem.decode base x) = Z.odd (nth_default 0 x 0). - Proof. + Proof using Type*. intros. destruct limb_widths, x; simpl in *; try discriminate; try reflexivity. rewrite peel_decode, nth_default_cons. @@ -355,7 +355,7 @@ Section Pow2BaseProofs. length us = length limb_widths -> bounded limb_widths us -> BaseSystem.decode' base (firstn i us) = Z.pow2_mod (BaseSystem.decode' base us) (sum_firstn limb_widths i). - Proof. + Proof using Type*. intros; induction i; repeat match goal with | |- _ => rewrite sum_firstn_0, decode_nil, Z.pow2_mod_0_r; reflexivity @@ -392,7 +392,7 @@ Section Pow2BaseProofs. bounded limb_widths us -> sum_firstn limb_widths i <= n -> Z.testbit (BaseSystem.decode base (firstn i us)) n = false. - Proof. + Proof using Type*. repeat match goal with | |- _ => progress intros | |- _ => progress autorewrite with Ztestbit @@ -410,7 +410,7 @@ Section Pow2BaseProofs. bounded limb_widths us -> sum_firstn limb_widths (length us) <= n -> Z.testbit (BaseSystem.decode base us) n = false. - Proof. + Proof using Type*. intros. erewrite <-(firstn_all _ us) by reflexivity. auto using testbit_decode_firstn_high. @@ -421,7 +421,7 @@ Section Pow2BaseProofs. length us = length limb_widths -> bounded limb_widths us -> 0 <= BaseSystem.decode base us. - Proof. + Proof using Type*. intros. unfold bounded, BaseSystem.decode, BaseSystem.decode' in *; simpl in *. pose 0 as zero. @@ -450,7 +450,7 @@ Section Pow2BaseProofs. length us = length limb_widths -> bounded limb_widths us -> 0 <= BaseSystem.decode base us < upper_bound limb_widths. - Proof. + Proof using Type*. cbv [upper_bound]; intros. split. { apply decode_nonneg; auto. } @@ -465,7 +465,7 @@ Section Pow2BaseProofs. length us = length limb_widths -> BaseSystem.decode base (firstn (S i) us) = Z.lor (BaseSystem.decode base (firstn i us)) (nth_default 0 us i << sum_firstn limb_widths i). - Proof. + Proof using Type*. repeat match goal with | |- _ => progress intros | |- _ => progress autorewrite with Ztestbit @@ -498,7 +498,7 @@ Section Pow2BaseProofs. bounded limb_widths us -> sum_firstn limb_widths i <= n < sum_firstn limb_widths (S i) -> Z.testbit (BaseSystem.decode base us) n = Z.testbit (nth_default 0 us i) (n - sum_firstn limb_widths i). - Proof. + Proof using Type*. repeat match goal with | |- _ => progress intros | |- _ => erewrite digit_select by eauto @@ -513,7 +513,7 @@ Section Pow2BaseProofs. Lemma testbit_bounded_high : forall i n us, bounded limb_widths us -> nth_default 0 limb_widths i <= n -> Z.testbit (nth_default 0 us i) n = false. - Proof. + Proof using Type*. repeat match goal with | |- _ => progress intros | |- _ => break_if @@ -528,7 +528,7 @@ Section Pow2BaseProofs. Lemma decode_shift_app : forall us0 us1, (length (us0 ++ us1) <= length limb_widths)%nat -> BaseSystem.decode base (us0 ++ us1) = (BaseSystem.decode (base_from_limb_widths (firstn (length us0) limb_widths)) us0) + ((BaseSystem.decode (base_from_limb_widths (skipn (length us0) limb_widths)) us1) << sum_firstn limb_widths (length us0)). - Proof. + Proof using Type*. unfold BaseSystem.decode; intros us0 us1 ?. assert (0 <= sum_firstn limb_widths (length us0)) by auto using sum_firstn_nonnegative. rewrite decode'_splice; autorewrite with push_firstn. @@ -539,17 +539,17 @@ Section Pow2BaseProofs. Lemma decode_shift : forall us u0, (length (u0 :: us) <= length limb_widths)%nat -> BaseSystem.decode base (u0 :: us) = u0 + ((BaseSystem.decode (base_from_limb_widths (tl limb_widths)) us) << (nth_default 0 limb_widths 0)). - Proof. + Proof using Type*. intros; etransitivity; [ apply (decode_shift_app (u0::nil)); assumption | ]. transitivity (u0 * 1 + 0 + ((BaseSystem.decode (base_from_limb_widths (tl limb_widths)) us) << (nth_default 0 limb_widths 0 + 0))); [ | autorewrite with zsimplify; reflexivity ]. destruct limb_widths; distr_length; reflexivity. Qed. Lemma upper_bound_nil : upper_bound nil = 1. - Proof. reflexivity. Qed. + Proof using Type. reflexivity. Qed. Lemma upper_bound_cons x xs : 0 <= x -> 0 <= sum_firstn xs (length xs) -> upper_bound (x::xs) = 2^x * upper_bound xs. - Proof. + Proof using Type. intros Hx Hxs. unfold upper_bound; simpl. autorewrite with simpl_sum_firstn pull_Zpow. @@ -557,7 +557,7 @@ Section Pow2BaseProofs. Qed. Lemma upper_bound_app xs ys : 0 <= sum_firstn xs (length xs) -> 0 <= sum_firstn ys (length ys) -> upper_bound (xs ++ ys) = upper_bound xs * upper_bound ys. - Proof. + Proof using Type. intros Hxs Hys. unfold upper_bound; simpl. autorewrite with distr_length simpl_sum_firstn pull_Zpow. @@ -565,7 +565,7 @@ Section Pow2BaseProofs. Qed. Lemma bounded_nil_r : forall l, (forall x, In x l -> 0 <= x) -> bounded l nil. - Proof. + Proof using Type. cbv [bounded]; intros. rewrite nth_default_nil. apply nth_default_preserves_properties; intros; split; zero_bounds. @@ -590,7 +590,7 @@ Section Pow2BaseProofs. let b := nth_default 0 base in let r := (b i * b j) / (2^k * b (i+j-length base)%nat) in b i * b j = r * (2^k * b (i+j-length base)%nat). - Proof. + Proof using limb_widths_match_modulus limb_widths_nonneg. intros. rewrite (Z.mul_comm r). subst r. @@ -615,7 +615,7 @@ Section Pow2BaseProofs. let b := nth_default 0 base in let r := b i * b j / b (i + j)%nat in b i * b j = r * b (i + j)%nat. - Proof. + Proof using limb_widths_good limb_widths_nonneg. intros; subst b r. clear limb_widths_match_modulus. rewrite base_from_limb_widths_length in *. @@ -662,7 +662,7 @@ Section BitwiseDecodeEncode. Lemma encode'_spec : forall x i, (i <= length limb_widths)%nat -> encode' limb_widths x i = BaseSystem.encode' base x upper_bound i. - Proof. + Proof using limb_widths_nonneg. induction i; intros. + rewrite encode'_zero. reflexivity. + rewrite encode'_succ, <-IHi by omega. @@ -678,14 +678,14 @@ Section BitwiseDecodeEncode. Qed. Lemma length_encode' : forall lw z i, length (encode' lw z i) = i. - Proof. + Proof using Type. induction i; intros; simpl encode'; distr_length. Qed. Hint Rewrite length_encode' : distr_length. Lemma bounded_encode' : forall z i, (0 <= z) -> bounded (firstn i limb_widths) (encode' limb_widths z i). - Proof. + Proof using limb_widths_nonneg. intros; induction i; simpl encode'; repeat match goal with | |- _ => progress intros @@ -715,14 +715,14 @@ Section BitwiseDecodeEncode. Lemma bounded_encodeZ : forall z, (0 <= z) -> bounded limb_widths (encodeZ limb_widths z). - Proof. + Proof using limb_widths_nonneg. cbv [encodeZ]; intros. pose proof (bounded_encode' z (length limb_widths)) as Hencode'. rewrite firstn_all in Hencode'; auto. Qed. Lemma base_upper_bound_compatible : @base_max_succ_divide base upper_bound. - Proof. + Proof using limb_widths_nonneg. unfold base_max_succ_divide; intros i lt_Si_length. rewrite base_from_limb_widths_length in lt_Si_length. rewrite Nat.lt_eq_cases in lt_Si_length; destruct lt_Si_length; @@ -757,7 +757,7 @@ Section BitwiseDecodeEncode. Qed. Lemma encodeZ_length : forall x, length (encodeZ limb_widths x) = length limb_widths. - Proof. + Proof using limb_widths_nonneg. cbv [encodeZ]; intros. rewrite encode'_spec by omega. apply encode'_length. @@ -771,7 +771,7 @@ Section BitwiseDecodeEncode. bounded limb_widths us -> forall i acc, decode_bitwise'_invariant us (S i) acc -> decode_bitwise'_invariant us i (Z.lor (nth_default 0 us i) (acc << nth_default 0 limb_widths i)). - Proof. + Proof using limb_widths_nonneg. repeat match goal with | |- _ => progress cbv [decode_bitwise'_invariant]; intros | |- _ => erewrite testbit_bounded_high by (omega || eauto) @@ -793,7 +793,7 @@ Section BitwiseDecodeEncode. bounded limb_widths us -> decode_bitwise'_invariant us i acc -> decode_bitwise'_invariant us 0 (decode_bitwise' limb_widths us i acc). - Proof. + Proof using limb_widths_nonneg. repeat match goal with | |- _ => progress intros | |- _ => solve [auto using decode_bitwise'_invariant_step] @@ -805,7 +805,7 @@ Section BitwiseDecodeEncode. Lemma decode_bitwise_spec : forall us, bounded limb_widths us -> length us = length limb_widths -> decode_bitwise limb_widths us = BaseSystem.decode base us. - Proof. + Proof using limb_widths_nonneg. repeat match goal with | |- _ => progress cbv [decode_bitwise decode_bitwise'_invariant] in * | |- _ => progress intros @@ -833,7 +833,7 @@ Section UniformBase. Lemma bounded_uniform : forall us, (length us <= length limb_widths)%nat -> (bounded limb_widths us <-> (forall u, In u us -> 0 <= u < 2 ^ width)). - Proof. + Proof using Type*. cbv [bounded]; split; intro A; intros. + let G := fresh "G" in match goal with H : In _ us |- _ => @@ -853,7 +853,7 @@ Section UniformBase. Qed. Lemma uniform_limb_widths_nonneg : forall w, In w limb_widths -> 0 <= w. - Proof. + Proof using Type*. intros. replace w with width by (symmetry; auto). assumption. @@ -866,14 +866,14 @@ Section UniformBase. Lemma nth_default_uniform_base : forall i, (i < length limb_widths)%nat -> nth_default 0 limb_widths i = width. - Proof. + Proof using Type*. intros; rewrite nth_default_uniform_base_full. edestruct lt_dec; omega. Qed. Lemma sum_firstn_uniform_base : forall i, (i <= length limb_widths)%nat -> sum_firstn limb_widths i = Z.of_nat i * width. - Proof. + Proof using limb_widths_uniform. clear limb_width_nonneg. (* clear this before induction so we don't depend on this *) induction limb_widths as [|x xs IHxs]; (intros [|i] ?); simpl @length in *; @@ -886,18 +886,18 @@ Section UniformBase. Lemma sum_firstn_uniform_base_strong : forall i, (length limb_widths <= i)%nat -> sum_firstn limb_widths i = Z.of_nat (length limb_widths) * width. - Proof. + Proof using limb_widths_uniform. intros; rewrite sum_firstn_all, sum_firstn_uniform_base by omega; reflexivity. Qed. Lemma upper_bound_uniform : upper_bound limb_widths = 2^(Z.of_nat (length limb_widths) * width). - Proof. + Proof using limb_widths_uniform. unfold upper_bound; rewrite sum_firstn_uniform_base_strong by omega; reflexivity. Qed. (* TODO : move *) Lemma decode_truncate_base : forall us bs, BaseSystem.decode bs us = BaseSystem.decode (firstn (length us) bs) us. - Proof. + Proof using Type. clear. induction us; intros. + rewrite !decode_nil; reflexivity. @@ -913,7 +913,7 @@ Section UniformBase. Lemma tl_repeat : forall {A} xs n (x : A), (forall y, In y xs -> y = x) -> (n < length xs)%nat -> firstn n xs = firstn n (tl xs). - Proof. + Proof using Type. intros. erewrite (repeat_spec_eq xs) by first [ eassumption | reflexivity ]. rewrite ListUtil.tl_repeat. @@ -923,7 +923,7 @@ Section UniformBase. Lemma decode_tl_base : forall us, (length us < length limb_widths)%nat -> BaseSystem.decode base us = BaseSystem.decode (base_from_limb_widths (tl limb_widths)) us. - Proof. + Proof using limb_widths_uniform. intros. match goal with |- BaseSystem.decode ?b1 _ = BaseSystem.decode ?b2 _ => rewrite (decode_truncate_base _ b1), (decode_truncate_base _ b2) end. @@ -934,7 +934,7 @@ Section UniformBase. Lemma decode_shift_uniform_tl : forall us u0, (length (u0 :: us) <= length limb_widths)%nat -> BaseSystem.decode base (u0 :: us) = u0 + ((BaseSystem.decode (base_from_limb_widths (tl limb_widths)) us) << width). - Proof. + Proof using Type*. intros. rewrite <- (nth_default_uniform_base 0) by distr_length. rewrite decode_shift by auto using uniform_limb_widths_nonneg. @@ -943,7 +943,7 @@ Section UniformBase. Lemma decode_shift_uniform_app : forall us0 us1, (length (us0 ++ us1) <= length limb_widths)%nat -> BaseSystem.decode base (us0 ++ us1) = (BaseSystem.decode (base_from_limb_widths (firstn (length us0) limb_widths)) us0) + ((BaseSystem.decode (base_from_limb_widths (skipn (length us0) limb_widths)) us1) << (Z.of_nat (length us0) * width)). - Proof. + Proof using Type*. intros. rewrite <- sum_firstn_uniform_base by (distr_length; omega). rewrite decode_shift_app by auto using uniform_limb_widths_nonneg. @@ -952,7 +952,7 @@ Section UniformBase. Lemma decode_shift_uniform : forall us u0, (length (u0 :: us) <= length limb_widths)%nat -> BaseSystem.decode base (u0 :: us) = u0 + ((BaseSystem.decode base us) << width). - Proof. + Proof using Type*. intros. rewrite decode_tl_base with (us := us) by distr_length. apply decode_shift_uniform_tl; assumption. @@ -1074,7 +1074,7 @@ Section SplitIndex. length us = length limb_widths -> bounded limb_widths us -> Z.testbit (BaseSystem.decode base us) n = Z.testbit (us # digit_index n) (bit_index n). - Proof. + Proof using Type*. cbv [digit_index bit_index split_index]; intros. pose proof (split_index'_correct n 0 limb_widths). pose proof (snd_split_index'_nonneg 0 limb_widths n). @@ -1108,7 +1108,7 @@ Section SplitIndex. then Z.testbit (us # digit_index n) (bit_index n) else false) else false. - Proof. + Proof using Type*. repeat match goal with | |- _ => progress intros | |- _ => break_if @@ -1120,13 +1120,13 @@ Section SplitIndex. Qed. Lemma bit_index_nonneg : forall i, 0 <= i -> 0 <= bit_index i. - Proof. + Proof using Type. apply snd_split_index'_nonneg. Qed. Lemma digit_index_lt_length : forall i, 0 <= i < bitsIn limb_widths -> (digit_index i < length limb_widths)%nat. - Proof. + Proof using Type*. cbv [bit_index digit_index split_index]; intros. pose proof (split_index'_done_case i 0 limb_widths). specialize_by lia. specialize_by eauto. @@ -1135,6 +1135,8 @@ Section SplitIndex. Lemma bit_index_not_done : forall i, 0 <= i < bitsIn limb_widths -> (bit_index i < limb_widths # digit_index i). + Proof using Type. + cbv [bit_index digit_index split_index]; intros. eapply Z.lt_le_trans; try apply (snd_split_index'_small i 0 limb_widths); try assumption. rewrite Nat.sub_0_r; lia. @@ -1142,7 +1144,7 @@ Section SplitIndex. Lemma split_index_eqn : forall i, 0 <= i < bitsIn limb_widths -> sum_firstn limb_widths (digit_index i) + bit_index i = i. - Proof. + Proof using Type. cbv [bit_index digit_index split_index]; intros. etransitivity;[ | apply (split_index'_correct i 0 limb_widths) ]. repeat f_equal; omega. @@ -1150,7 +1152,7 @@ Section SplitIndex. Lemma rem_bits_in_digit_pos : forall i, 0 <= i < bitsIn limb_widths -> 0 < (limb_widths # digit_index i) - bit_index i. - Proof. + Proof using Type. repeat match goal with | |- _ => progress intros | |- 0 < ?a - ?b => destruct (Z_lt_dec b a); [ lia | exfalso ] @@ -1162,7 +1164,7 @@ Section SplitIndex. Lemma rem_bits_in_digit_le_rem_bits : forall i, 0 <= i < bitsIn limb_widths -> i + ((limb_widths # digit_index i) - bit_index i) <= bitsIn limb_widths. - Proof. + Proof using Type*. intros. rewrite <-(split_index_eqn i) at 1 by lia. match goal with @@ -1178,7 +1180,7 @@ Section SplitIndex. j < bitsIn limb_widths -> j < i + ((limb_widths # (digit_index i)) - bit_index i) -> (digit_index i = digit_index j)%nat. - Proof. + Proof using Type*. intros. pose proof (split_index_eqn i). pose proof (split_index_eqn j). @@ -1206,7 +1208,7 @@ Section SplitIndex. Lemma same_digit_bit_index_sub : forall i j, 0 <= i <= j -> j < bitsIn limb_widths -> digit_index i = digit_index j -> bit_index j - bit_index i = j - i. - Proof. + Proof using Type. intros. pose proof (split_index_eqn i). pose proof (split_index_eqn j). @@ -1225,7 +1227,7 @@ Section carrying_helper. Lemma update_nth_sum : forall n f us, (n < length us \/ n >= length limb_widths)%nat -> BaseSystem.decode base (update_nth n f us) = (let v := nth_default 0 us n in f v - v) * nth_default 0 base n + BaseSystem.decode base us. - Proof. + Proof using Type. intros. unfold BaseSystem.decode. destruct H as [H|H]. @@ -1272,7 +1274,7 @@ Section carrying_helper. | x'::xs' => x'::add_to_nth n' x xs' end end. - Proof. + Proof using Type. induction n; destruct xs; reflexivity. Qed. @@ -1283,7 +1285,7 @@ Section carrying_helper. | nil => nil | x'::xs' => x + x'::xs' end. - Proof. intro; rewrite unfold_add_to_nth; reflexivity. Qed. + Proof using Type. intro; rewrite unfold_add_to_nth; reflexivity. Qed. Lemma simpl_add_to_nth_S x n : forall xs, @@ -1292,25 +1294,25 @@ Section carrying_helper. | nil => nil | x'::xs' => x'::add_to_nth n x xs' end. - Proof. intro; rewrite unfold_add_to_nth; reflexivity. Qed. + Proof using Type. intro; rewrite unfold_add_to_nth; reflexivity. Qed. Hint Rewrite @simpl_set_nth_S @simpl_set_nth_0 : simpl_add_to_nth. Lemma add_to_nth_cons : forall x u0 us, add_to_nth 0 x (u0 :: us) = x + u0 :: us. - Proof. reflexivity. Qed. + Proof using Type. reflexivity. Qed. Hint Rewrite @add_to_nth_cons : simpl_add_to_nth. Lemma cons_add_to_nth : forall n f y us, y :: add_to_nth n f us = add_to_nth (S n) f (y :: us). - Proof. + Proof using Type. induction n; boring. Qed. Hint Rewrite <- @cons_add_to_nth : simpl_add_to_nth. Lemma add_to_nth_nil : forall n f, add_to_nth n f nil = nil. - Proof. + Proof using Type. induction n; boring. Qed. @@ -1319,7 +1321,7 @@ Section carrying_helper. Lemma add_to_nth_set_nth n x xs : add_to_nth n x xs = set_nth n (x + nth_default 0 xs n) xs. - Proof. + Proof using Type. revert xs; induction n; destruct xs; autorewrite with simpl_set_nth simpl_add_to_nth; try rewrite IHn; @@ -1328,7 +1330,7 @@ Section carrying_helper. Lemma add_to_nth_update_nth n x xs : add_to_nth n x xs = update_nth n (fun y => x + y) xs. - Proof. + Proof using Type. revert xs; induction n; destruct xs; autorewrite with simpl_update_nth simpl_add_to_nth; try rewrite IHn; @@ -1336,19 +1338,19 @@ Section carrying_helper. Qed. Lemma length_add_to_nth i x xs : length (add_to_nth i x xs) = length xs. - Proof. unfold add_to_nth; distr_length; reflexivity. Qed. + Proof using Type. unfold add_to_nth; distr_length; reflexivity. Qed. Hint Rewrite @length_add_to_nth : distr_length. Lemma set_nth_sum : forall n x us, (n < length us \/ n >= length limb_widths)%nat -> BaseSystem.decode base (set_nth n x us) = (x - nth_default 0 us n) * nth_default 0 base n + BaseSystem.decode base us. - Proof. intros; unfold set_nth; rewrite update_nth_sum by assumption; reflexivity. Qed. + Proof using Type. intros; unfold set_nth; rewrite update_nth_sum by assumption; reflexivity. Qed. Lemma add_to_nth_sum : forall n x us, (n < length us \/ n >= length limb_widths)%nat -> BaseSystem.decode base (add_to_nth n x us) = x * nth_default 0 base n + BaseSystem.decode base us. - Proof. intros; rewrite add_to_nth_set_nth, set_nth_sum; try ring_simplify; auto. Qed. + Proof using Type. intros; rewrite add_to_nth_set_nth, set_nth_sum; try ring_simplify; auto. Qed. Lemma add_to_nth_nth_default_full : forall n x l i d, nth_default d (add_to_nth n x l) i = @@ -1356,17 +1358,17 @@ Section carrying_helper. if (eq_nat_dec i n) then x + nth_default d l i else nth_default d l i else d. - Proof. intros; rewrite add_to_nth_update_nth; apply update_nth_nth_default_full; assumption. Qed. + Proof using Type. intros; rewrite add_to_nth_update_nth; apply update_nth_nth_default_full; assumption. Qed. Hint Rewrite @add_to_nth_nth_default_full : push_nth_default. Lemma add_to_nth_nth_default : forall n x l i, (0 <= i < length l)%nat -> nth_default 0 (add_to_nth n x l) i = if (eq_nat_dec i n) then x + nth_default 0 l i else nth_default 0 l i. - Proof. intros; rewrite add_to_nth_update_nth; apply update_nth_nth_default; assumption. Qed. + Proof using Type. intros; rewrite add_to_nth_update_nth; apply update_nth_nth_default; assumption. Qed. Hint Rewrite @add_to_nth_nth_default using omega : push_nth_default. Lemma log_cap_nonneg : forall i, 0 <= log_cap i. - Proof. + Proof using Type*. unfold nth_default; intros. case_eq (nth_error limb_widths i); intros; try omega. apply limb_widths_nonneg. @@ -1389,17 +1391,17 @@ Section carrying. Local Hint Resolve limb_widths_nonneg sum_firstn_limb_widths_nonneg. Lemma length_carry_gen : forall fc fi i us, length (carry_gen limb_widths fc fi i us) = length us. - Proof. intros; unfold carry_gen, carry_single; distr_length; reflexivity. Qed. + Proof using Type. intros; unfold carry_gen, carry_single; distr_length; reflexivity. Qed. Hint Rewrite @length_carry_gen : distr_length. Lemma length_carry_simple : forall i us, length (carry_simple limb_widths i us) = length us. - Proof. intros; unfold carry_simple; distr_length; reflexivity. Qed. + Proof using Type. intros; unfold carry_simple; distr_length; reflexivity. Qed. Hint Rewrite @length_carry_simple : distr_length. Lemma nth_default_base_succ : forall i, (S i < length limb_widths)%nat -> nth_default 0 base (S i) = 2 ^ log_cap i * nth_default 0 base i. - Proof. + Proof using Type*. intros. rewrite !nth_default_base, <- Z.pow_add_r by (omega || eauto using log_cap_nonneg). autorewrite with simpl_sum_firstn; reflexivity. @@ -1418,7 +1420,7 @@ Section carrying. else nth_default 0 base Si) - 2 ^ log_cap i * (nth_default 0 us i / 2 ^ log_cap i) * nth_default 0 base i) + BaseSystem.decode base us. - Proof. + Proof using Type*. intros fc fi i' us i Si H; intros. destruct (eq_nat_dec 0 (length limb_widths)); [ destruct limb_widths, us, i; simpl in *; try congruence; @@ -1454,7 +1456,7 @@ Section carrying. (length us = length limb_widths) -> (i < (pred (length limb_widths)))%nat -> BaseSystem.decode base (carry_simple limb_widths i us) = BaseSystem.decode base us. - Proof. + Proof using Type*. unfold carry_simple; intros; rewrite carry_gen_decode_eq by assumption. autorewrite with natsimplify. break_match; try lia; autorewrite with zsimplify; lia. @@ -1462,7 +1464,7 @@ Section carrying. Lemma length_carry_simple_sequence : forall is us, length (carry_simple_sequence limb_widths is us) = length us. - Proof. + Proof using Type. unfold carry_simple_sequence. induction is; [ reflexivity | simpl; intros ]. distr_length. @@ -1471,20 +1473,20 @@ Section carrying. Hint Rewrite @length_carry_simple_sequence : distr_length. Lemma length_make_chain : forall i, length (make_chain i) = i. - Proof. induction i; simpl; congruence. Qed. + Proof using Type. induction i; simpl; congruence. Qed. Hint Rewrite @length_make_chain : distr_length. Lemma length_full_carry_chain : length (full_carry_chain limb_widths) = length limb_widths. - Proof. unfold full_carry_chain; distr_length; reflexivity. Qed. + Proof using Type. unfold full_carry_chain; distr_length; reflexivity. Qed. Hint Rewrite @length_full_carry_chain : distr_length. Lemma length_carry_simple_full us : length (carry_simple_full limb_widths us) = length us. - Proof. unfold carry_simple_full; distr_length; reflexivity. Qed. + Proof using Type. unfold carry_simple_full; distr_length; reflexivity. Qed. Hint Rewrite @length_carry_simple_full : distr_length. (* TODO : move? *) Lemma make_chain_lt : forall x i : nat, In i (make_chain x) -> (i < x)%nat. - Proof. + Proof using Type. induction x; simpl; intuition auto with arith lia. Qed. @@ -1498,7 +1500,7 @@ Section carrying. then fc (nth_default 0 us (fi i) >> log_cap (fi i)) else 0 else d. - Proof. + Proof using Type. unfold carry_gen, carry_single. intros; autorewrite with push_nth_default natsimplify distr_length. edestruct (lt_dec n (length us)) as [H|H]; [ | reflexivity ]. @@ -1516,7 +1518,7 @@ Section carrying. else nth_default 0 us n + if eq_nat_dec n (S i) then nth_default 0 us i >> log_cap i else 0 else d. - Proof. + Proof using Type. intros; unfold carry_simple; autorewrite with push_nth_default. repeat break_match; try omega; try reflexivity. Qed. @@ -1533,7 +1535,7 @@ Section carrying. if eq_nat_dec i (fi (S (fi i))) then fc (nth_default 0 us (fi i) >> log_cap (fi i)) else 0. - Proof. + Proof using Type. intros; autorewrite with push_nth_default natsimplify; break_match; omega. Qed. Hint Rewrite @nth_default_carry_gen using (omega || distr_length; omega) : push_nth_default. @@ -1543,7 +1545,7 @@ Section carrying. (0 <= i < length us)%nat -> nth_default 0 (carry_simple limb_widths i us) i = Z.pow2_mod (nth_default 0 us i) (log_cap i). - Proof. + Proof using Type. intros; autorewrite with push_nth_default natsimplify; break_match; omega. Qed. Hint Rewrite @nth_default_carry_simple using (omega || distr_length; omega) : push_nth_default. diff --git a/src/ModularArithmetic/PrimeFieldTheorems.v b/src/ModularArithmetic/PrimeFieldTheorems.v index d48aab36e..eba1af740 100644 --- a/src/ModularArithmetic/PrimeFieldTheorems.v +++ b/src/ModularArithmetic/PrimeFieldTheorems.v @@ -22,13 +22,13 @@ Module F. Context (q:positive) {prime_q:prime q}. Lemma inv_spec : F.inv 0%F = (0%F : F q) /\ (prime q -> forall x : F q, x <> 0%F -> (F.inv x * x)%F = 1%F). - Proof. change (@F.inv q) with (proj1_sig (@F.inv_with_spec q)); destruct (@F.inv_with_spec q); eauto. Qed. + Proof using Type. change (@F.inv q) with (proj1_sig (@F.inv_with_spec q)); destruct (@F.inv_with_spec q); eauto. Qed. - Lemma inv_0 : F.inv 0%F = F.of_Z q 0. Proof. destruct inv_spec; auto. Qed. - Lemma inv_nonzero (x:F q) : (x <> 0 -> F.inv x * x%F = 1)%F. Proof. destruct inv_spec; auto. Qed. + Lemma inv_0 : F.inv 0%F = F.of_Z q 0. Proof using Type. destruct inv_spec; auto. Qed. + Lemma inv_nonzero (x:F q) : (x <> 0 -> F.inv x * x%F = 1)%F. Proof using Type*. destruct inv_spec; auto. Qed. Global Instance field_modulo : @Algebra.field (F q) Logic.eq 0%F 1%F F.opp F.add F.sub F.mul F.inv F.div. - Proof. + Proof using Type*. repeat match goal with | _ => solve [ solve_proper | apply F.commutative_ring_modulo @@ -45,10 +45,10 @@ Module F. (* TODO: move to PrimeFieldTheorems *) Lemma to_Z_1 : @F.to_Z q 1 = 1%Z. - Proof. simpl. rewrite Zmod_small; omega. Qed. + Proof using two_lt_q. simpl. rewrite Zmod_small; omega. Qed. Lemma Fq_inv_fermat (x:F q) : F.inv x = x ^ Z.to_N (q - 2)%Z. - Proof. + Proof using Type*. destruct (dec (x = 0%F)) as [?|Hnz]. { subst x; rewrite inv_0, F.pow_0_l; trivial. change (0%N) with (Z.to_N 0%Z); rewrite Z2N.inj_iff; omega. } @@ -59,7 +59,7 @@ Module F. Lemma euler_criterion (a : F q) (a_nonzero : a <> 0) : (a ^ (Z.to_N (q / 2)) = 1) <-> (exists b, b*b = a). - Proof. + Proof using Type*. pose proof F.to_Z_nonzero_range a; pose proof (odd_as_div q). specialize_by (destruct (Z.prime_odd_or_2 _ prime_q); try omega; trivial). rewrite F.eq_to_Z_iff, !F.to_Z_pow, !to_Z_1, !Z2N.id by omega. @@ -86,10 +86,10 @@ Module F. Definition sqrt_3mod4 (a : F q) : F q := a ^ Z.to_N (q / 4 + 1). Global Instance Proper_sqrt_3mod4 : Proper (eq ==> eq ) sqrt_3mod4. - Proof. repeat intro; subst; reflexivity. Qed. + Proof using Type. repeat intro; subst; reflexivity. Qed. Lemma two_lt_q_3mod4 : 2 < q. - Proof. + Proof using Type*. pose proof (prime_ge_2 q _) as two_le_q. destruct (Zle_lt_or_eq _ _ two_le_q) as [H|H]; [exact H|]. rewrite <-H in q_3mod4; discriminate. @@ -98,7 +98,7 @@ Module F. Lemma sqrt_3mod4_correct (x:F q) : ((exists y, y*y = x) <-> (sqrt_3mod4 x)*(sqrt_3mod4 x) = x)%F. - Proof. + Proof using Type*. cbv [sqrt_3mod4]; intros. destruct (F.eq_dec x 0); repeat match goal with @@ -136,7 +136,7 @@ Module F. Context (sqrt_minus1 : F q) (sqrt_minus1_valid : sqrt_minus1 * sqrt_minus1 = F.opp 1). Lemma two_lt_q_5mod8 : 2 < q. - Proof. + Proof using prime_q q_5mod8. pose proof (prime_ge_2 q _) as two_le_q. destruct (Zle_lt_or_eq _ _ two_le_q) as [H|H]; [exact H|]. rewrite <-H in *. discriminate. @@ -150,11 +150,11 @@ Module F. else sqrt_minus1 * b. Global Instance Proper_sqrt_5mod8 : Proper (eq ==> eq ) sqrt_5mod8. - Proof. repeat intro; subst; reflexivity. Qed. + Proof using Type. repeat intro; subst; reflexivity. Qed. Lemma eq_b4_a2 (x : F q) (Hex:exists y, y*y = x) : ((x ^ Z.to_N (q / 8 + 1)) ^ 2) ^ 2 = x ^ 2. - Proof. + Proof using prime_q q_5mod8. pose proof two_lt_q_5mod8. assert (0 <= q/8)%Z by (apply Z.div_le_lower_bound; rewrite ?Z.mul_0_r; omega). assert (Z.to_N (q / 8 + 1) <> 0%N) by @@ -185,7 +185,7 @@ Module F. Qed. Lemma mul_square_sqrt_minus1 : forall x, sqrt_minus1 * x * (sqrt_minus1 * x) = F.opp (x * x). - Proof. + Proof using prime_q sqrt_minus1_valid. intros. transitivity (F.opp 1 * (x * x)); [ | field]. rewrite <-sqrt_minus1_valid. @@ -194,7 +194,7 @@ Module F. Lemma eq_b4_a2_iff (x : F q) : x <> 0 -> ((exists y, y*y = x) <-> ((x ^ Z.to_N (q / 8 + 1)) ^ 2) ^ 2 = x ^ 2). - Proof. + Proof using Type*. split; try apply eq_b4_a2. intro Hyy. rewrite !@F.pow_2_r in *. @@ -207,7 +207,7 @@ Module F. Lemma sqrt_5mod8_correct : forall x, ((exists y, y*y = x) <-> (sqrt_5mod8 x)*(sqrt_5mod8 x) = x). - Proof. + Proof using Type*. cbv [sqrt_5mod8]; intros. destruct (F.eq_dec x 0). { @@ -261,7 +261,7 @@ Module F. @Algebra.ring H eq zero one opp add sub mul /\ @Ring.is_homomorphism (F q) Logic.eq F.one F.add F.mul H eq one add mul phi /\ @Ring.is_homomorphism H eq one add mul (F q) Logic.eq F.one F.add F.mul phi'. - Proof. eapply @Ring.ring_by_isomorphism; assumption || exact _. Qed. + Proof using phi'_add phi'_iff phi'_mul phi'_one phi'_opp phi'_phi phi'_sub phi'_zero. eapply @Ring.ring_by_isomorphism; assumption || exact _. Qed. Local Instance _iso_ring : Algebra.ring := proj1 ring. Local Instance _iso_hom1 : Ring.is_homomorphism := proj1 (proj2 ring). Local Instance _iso_hom2 : Ring.is_homomorphism := proj2 (proj2 ring). @@ -287,7 +287,7 @@ Module F. @Algebra.field H eq zero one opp add sub mul inv div /\ @Ring.is_homomorphism (F q) Logic.eq F.one F.add F.mul H eq one add mul phi /\ @Ring.is_homomorphism H eq one add mul (F q) Logic.eq F.one F.add F.mul phi'. - Proof. eapply @Field.field_and_homomorphism_from_redundant_representation; + Proof using Type*. eapply @Field.field_and_homomorphism_from_redundant_representation; assumption || exact _ || exact inv_proof || exact div_proof. Qed. End IsomorphicRings. End Iso. diff --git a/src/ModularArithmetic/PseudoMersenneBaseParamProofs.v b/src/ModularArithmetic/PseudoMersenneBaseParamProofs.v index 3a530c377..85ed920a2 100644 --- a/src/ModularArithmetic/PseudoMersenneBaseParamProofs.v +++ b/src/ModularArithmetic/PseudoMersenneBaseParamProofs.v @@ -17,29 +17,31 @@ Section PseudoMersenneBaseParamProofs. Local Notation base := (base_from_limb_widths limb_widths). Lemma limb_widths_nonneg : forall w, In w limb_widths -> 0 <= w. - Proof. auto using Z.lt_le_incl, limb_widths_pos. Qed. + Proof using Type. auto using Z.lt_le_incl, limb_widths_pos. Qed. Lemma k_nonneg : 0 <= k. - Proof. apply sum_firstn_limb_widths_nonneg, limb_widths_nonneg. Qed. + Proof using Type. apply sum_firstn_limb_widths_nonneg, limb_widths_nonneg. Qed. Lemma lt_modulus_2k : modulus < 2 ^ k. - Proof. + Proof using Type. replace (2 ^ k) with (modulus + c) by (unfold c; ring). pose proof c_pos; omega. Qed. Hint Resolve lt_modulus_2k. Lemma modulus_pos : 0 < modulus. - Proof. + Proof using Type*. pose proof (NumTheoryUtil.lt_1_p _ prime_modulus); omega. Qed. Hint Resolve modulus_pos. Lemma modulus_nonzero : Z.pos modulus <> 0. + Proof using Type*. + pose proof (Znumtheory.prime_ge_2 _ prime_modulus); omega. Qed. (* a = r + s(2^k) = r + s(2^k - c + c) = r + s(2^k - c) + cs = r + cs *) Lemma pseudomersenne_add: forall x y, (x + ((2^k) * y)) mod modulus = (x + (c * y)) mod modulus. - Proof. + Proof using Type. intros. replace (2^k) with ((2^k - c) + c) by ring. rewrite Z.mul_add_distr_r, Zplus_mod. @@ -50,7 +52,7 @@ Section PseudoMersenneBaseParamProofs. Qed. Lemma pseudomersenne_add': forall x y0 y1 z, (z - x + ((2^k) * y0 * y1)) mod modulus = (c * y0 * y1 - x + z) mod modulus. - Proof. + Proof using Type. intros; rewrite <- !Z.add_opp_r, <- !Z.mul_assoc, pseudomersenne_add; apply f_equal2; omega. Qed. @@ -58,7 +60,7 @@ Section PseudoMersenneBaseParamProofs. decode (ext_base limb_widths) us = decode base (firstn (length base) us) + (2 ^ k * decode base (skipn (length base) us)). - Proof. + Proof using Type. intros. unfold decode; rewrite <- mul_each_rep. rewrite ext_base_alt by apply limb_widths_nonneg. @@ -75,7 +77,7 @@ Section PseudoMersenneBaseParamProofs. Lemma nth_default_base_positive : forall i, (i < length base)%nat -> nth_default 0 base i > 0. - Proof. + Proof using Type. intros. pose proof (nth_error_length_exists_value _ _ H). destruct H0. @@ -88,7 +90,7 @@ Section PseudoMersenneBaseParamProofs. Lemma base_succ_div_mult : forall i, ((S i) < length base)%nat -> nth_default 0 base (S i) = nth_default 0 base i * (nth_default 0 base (S i) / nth_default 0 base i). - Proof. + Proof using Type. intros. apply Z_div_exact_2; try (apply nth_default_base_positive; omega). apply base_succ; distr_length; eauto using limb_widths_nonneg. diff --git a/src/MontgomeryX.v b/src/MontgomeryX.v index 1cb9f1971..a9cbd8836 100644 --- a/src/MontgomeryX.v +++ b/src/MontgomeryX.v @@ -77,6 +77,6 @@ Module M. (H1:match M.coordinates (add Q (opp Q')) with∞=>False|(x,y)=>x=x1/\x<>0 end): match M.coordinates (add Q Q) with∞=>z2=0/\x2<>0|(xQQ,_)=>xQQ=x2/z2/\z2<>0 end /\ match M.coordinates (add Q Q') with∞=>z3=0/\x3<>0|(xQQ',_)=>xQQ'=x3/z3/\z3<>0 end. - Proof. t; abstract fsatz. Qed. + Proof using a24_correct char_ge_5. t; abstract fsatz. Qed. End MontgomeryCurve. End M. diff --git a/src/MxDHRepChange.v b/src/MxDHRepChange.v index c5e1e7f95..995c11409 100644 --- a/src/MxDHRepChange.v +++ b/src/MxDHRepChange.v @@ -18,7 +18,7 @@ Section MxDHRepChange. (* TODO: move to algebra *) Lemma homomorphism_multiplicative_inverse_complete' x : Keq (FtoK (Finv x)) (Kinv (FtoK x)). - Proof. + Proof using Feq_dec Keq_dec field homom homomorphism_inv_zero impl_field. eapply (homomorphism_multiplicative_inverse_complete). intro J; rewrite J. rewrite homomorphism_inv_zero, homomorphism_id. reflexivity. @@ -44,7 +44,7 @@ Section MxDHRepChange. Global Instance Proper_ladderstep : Proper (Keq ==> (fieldwise (n:=2) Keq) ==> fieldwise (n:=2) Keq ==> fieldwise (n:=2) (fieldwise (n:=2) Keq)) (@MxDH.ladderstep K Kadd Ksub Kmul Ka24). - Proof. + Proof using Keq_dec impl_field. cbv [MxDH.ladderstep tuple tuple' fieldwise fieldwise' fst snd]; repeat intro; destruct_head' prod; destruct_head' and; repeat split; repeat match goal with [H:Keq ?x ?y |- _ ] => rewrite !H; clear H x end; reflexivity. @@ -54,7 +54,7 @@ Section MxDHRepChange. fieldwise (n:=2) (fieldwise (n:=2) Keq) ((Tuple.map (n:=2) (Tuple.map (n:=2) FtoK)) (@MxDH.ladderstep F Fadd Fsub Fmul Fa24 u P Q)) (@MxDH.ladderstep K Kadd Ksub Kmul Ka24 Ku (Tuple.map (n:=2) FtoK P) (Tuple.map (n:=2) FtoK Q)). - Proof. + Proof using Feq_dec Keq_dec field homom homomorphism_a24 impl_field. destruct P as [? ?], Q as [? ?]; cbv; repeat split; rewrite <-?Ku_correct; t. Qed. @@ -72,7 +72,7 @@ Section MxDHRepChange. fieldwise (n:=2) (fieldwise (n:=2) Keq) (fst a) (fst b) /\ snd a = snd b. Local Instance Equivalence_loopiter_eq : Equivalence loopiter_eq. - Proof. + Proof using Keq_dec impl_field loopiter_phi. unfold loopiter_eq; split; repeat intro; intuition (reflexivity||symmetry;eauto||etransitivity;symmetry;eauto). Qed. @@ -80,7 +80,7 @@ Section MxDHRepChange. Lemma MxLoopIterRepChange b Fu s i Ku (HKu:Keq (FtoK Fu) Ku) : loopiter_eq (loopiter_phi (loopiter F Fzero Fone Fadd Fsub Fmul Finv Fa24 Fcswap b tb1 Fu s i)) (loopiter K Kzero Kone Kadd Ksub Kmul Kinv Ka24 Kcswap b tb2 Ku (loopiter_phi s) i). - Proof. + Proof using Fcswap_correct Feq_dec Kcswap_correct Keq_dec field homom homomorphism_a24 impl_field tb2_correct. destruct_head' prod; break_match. simpl. rewrite !Fcswap_correct, !Kcswap_correct, tb2_correct in *. @@ -91,14 +91,14 @@ Section MxDHRepChange. Global Instance Proper_fold_left {A RA B RB} : Proper ((RA==>RB==>RA) ==> SetoidList.eqlistA RB ==> RA ==> RA) (@fold_left A B). - Proof. + Proof using Type. intros ? ? ? ? ? Hl; induction Hl; repeat intro; [assumption|]. simpl; cbv [Proper respectful] in *; eauto. Qed. Lemma proj_fold_left {A B L} R {Equivalence_R:@Equivalence B R} (proj:A->B) step step' {Proper_step':(R ==> eq ==> R)%signature step' step'} (xs:list L) init init' (H0:R (proj init) init') (Hproj:forall x i, R (proj (step x i)) (step' (proj x) i)) : R (proj (fold_left step xs init)) (fold_left step' xs init'). - Proof. + Proof using Type. generalize dependent init; generalize dependent init'. induction xs; [solve [eauto]|]. repeat intro; simpl; rewrite IHxs by eauto. @@ -109,7 +109,7 @@ Section MxDHRepChange. Global Instance Proper_downto {T R} {Equivalence_R:@Equivalence T R} : Proper (R ==> Logic.eq ==> (R==>Logic.eq==>R) ==> R) MxDH.downto. - Proof. + Proof using Type. intros s0 s0' Hs0 n' n Hn'; subst n'; generalize dependent s0; generalize dependent s0'. induction n; repeat intro; [assumption|]. unfold MxDH.downto; simpl. @@ -119,7 +119,7 @@ Section MxDHRepChange. Global Instance Proper_loopiter a b c : Proper (loopiter_eq ==> eq ==> loopiter_eq) (loopiter K Kzero Kone Kadd Ksub Kmul Kinv Ka24 Kcswap a b c). - Proof. + Proof using Kcswap_correct Keq_dec impl_field. unfold loopiter; intros [? ?] [? ?] [[[] []] ?]; repeat intro ; cbv [fst snd] in * |-; subst. repeat VerdiTactics.break_match; subst; repeat (VerdiTactics.find_injection; intros; subst). split; [|reflexivity]. @@ -137,7 +137,7 @@ Section MxDHRepChange. Keq (FtoK (@MxDH.montladder F Fzero Fone Fadd Fsub Fmul Finv Fa24 Fcswap b tb1 x)) (@MxDH.montladder K Kzero Kone Kadd Ksub Kmul Kinv Ka24 Kcswap b tb2 (FtoK x)). - Proof. + Proof using Fcswap_correct Feq_dec Kcswap_correct Keq_dec field homom homomorphism_a24 homomorphism_inv_zero impl_field tb2_correct. cbv [MxDH.montladder]. repeat break_match. assert (Hrel:loopiter_eq (loopiter_phi (p, p0, b0)) (p1, p3, b1)). diff --git a/src/NewBaseSystem.v b/src/NewBaseSystem.v index 620011fa7..4dec23846 100644 --- a/src/NewBaseSystem.v +++ b/src/NewBaseSystem.v @@ -437,14 +437,14 @@ Module B. Lemma carryterm_cps_id w fw t {T} f : @carryterm_cps w fw t T f = f (@carryterm w fw t). - Proof. cbv [carryterm_cps carryterm Let_In]; prove_id. Qed. + Proof using Type. cbv [carryterm_cps carryterm Let_In]; prove_id. Qed. Hint Opaque carryterm : uncps. Hint Rewrite carryterm_cps_id : uncps. Lemma eval_carryterm w fw (t:limb) (fw_nonzero:fw<>0): eval (carryterm w fw t) = eval [t]. - Proof. + Proof using Type*. cbv [carryterm_cps carryterm Let_In]; prove_eval. specialize (div_mod (snd t) fw fw_nonzero). nsatz. @@ -456,13 +456,13 @@ Module B. Definition carry w fw p := carry_cps w fw p id. Lemma carry_cps_id w fw p {T} f: @carry_cps w fw p T f = f (carry w fw p). - Proof. cbv [carry_cps carry]; prove_id. Qed. + Proof using Type. cbv [carry_cps carry]; prove_id. Qed. Hint Opaque carry : uncps. Hint Rewrite carry_cps_id : uncps. Lemma eval_carry w fw p (fw_nonzero:fw<>0): eval (carry w fw p) = eval p. - Proof. cbv [carry_cps carry]; induction p; prove_eval. Qed. + Proof using Type*. cbv [carry_cps carry]; induction p; prove_eval. Qed. Hint Rewrite eval_carry using auto : push_basesystem_eval. End Carries. @@ -492,7 +492,7 @@ Module B. @to_associational_cps n xs _ id. Lemma to_associational_cps_id {n} x {T} f: @to_associational_cps n x T f = f (to_associational x). - Proof. cbv [to_associational_cps to_associational]; prove_id. Qed. + Proof using Type. cbv [to_associational_cps to_associational]; prove_id. Qed. Hint Opaque to_associational : uncps. Hint Rewrite @to_associational_cps_id : uncps. @@ -501,7 +501,7 @@ Module B. Lemma eval_to_associational {n} x : Associational.eval (@to_associational n x) = eval x. - Proof. + Proof using Type. cbv [to_associational_cps eval to_associational]; prove_eval. Qed. Hint Rewrite @eval_to_associational : push_basesystem_eval. @@ -513,7 +513,7 @@ Module B. Definition zeros n : tuple Z n := Tuple.repeat 0 n. Lemma eval_zeros n : eval (zeros n) = 0. - Proof. + Proof using Type. cbv [eval Associational.eval to_associational_cps zeros]. pose proof (seq_length n 0). generalize dependent (seq 0 n). intro xs; revert n; induction xs; intros; @@ -531,7 +531,7 @@ Module B. Definition add_to_nth {n} i x t := @add_to_nth_cps n i x t _ id. Lemma add_to_nth_cps_id {n} i x xs {T} f: @add_to_nth_cps n i x xs T f = f (add_to_nth i x xs). - Proof. + Proof using weight. cbv [add_to_nth_cps add_to_nth]; erewrite !on_tuple_cps_correct by (intros; autorewrite with uncps; reflexivity); prove_id. Unshelve. @@ -542,7 +542,7 @@ Module B. Lemma eval_add_to_nth {n} (i:nat) (x:Z) (H:(i<n)%nat) (xs:tuple Z n): eval (@add_to_nth n i x xs) = weight i * x + eval xs. - Proof. + Proof using Type. cbv [eval to_associational_cps add_to_nth add_to_nth_cps runtime_add]. erewrite on_tuple_cps_correct by (intros; autorewrite with uncps; reflexivity). prove_eval. @@ -569,17 +569,17 @@ Module B. Definition place t i := place_cps t i id. Lemma place_cps_id t i {T} f : @place_cps t i T f = f (place t i). - Proof. cbv [place]; induction i; prove_id. Qed. + Proof using Type. cbv [place]; induction i; prove_id. Qed. Hint Opaque place : uncps. Hint Rewrite place_cps_id : uncps. Lemma place_cps_in_range (t:limb) (n:nat) : (fst (place_cps t n id) < S n)%nat. - Proof. induction n; simpl; break_match; simpl; omega. Qed. + Proof using Type. induction n; simpl; break_match; simpl; omega. Qed. Lemma weight_place_cps t i : weight (fst (place_cps t i id)) * snd (place_cps t i id) = fst t * snd t. - Proof. + Proof using Type*. induction i; cbv [id]; simpl place_cps; break_match; autorewrite with cancel_pair; try find_apply_lem_hyp Z_div_exact_full_2; nsatz || auto. @@ -596,7 +596,7 @@ Module B. Definition from_associational n p := from_associational_cps n p id. Lemma from_associational_cps_id {n} p {T} f: @from_associational_cps n p T f = f (from_associational n p). - Proof. + Proof using Type. cbv [from_associational_cps from_associational]; prove_id. Qed. Hint Opaque from_associational : uncps. @@ -604,7 +604,7 @@ Module B. Lemma eval_from_associational {n} p (n_nonzero:n<>O): eval (from_associational n p) = Associational.eval p. - Proof. + Proof using Type*. cbv [from_associational_cps from_associational]; induction p; [|pose proof (place_cps_in_range a (pred n))]; prove_eval. cbv [place]; rewrite weight_place_cps. nsatz. @@ -659,14 +659,14 @@ Module B. Definition chained_carries {n} p idxs := @chained_carries_cps n p idxs _ id. Lemma chained_carries_id {n} p idxs : forall {T} f, @chained_carries_cps n p idxs T f = f (chained_carries p idxs). - Proof. cbv [chained_carries_cps chained_carries]; prove_id. Qed. + Proof using Type. cbv [chained_carries_cps chained_carries]; prove_id. Qed. Hint Opaque chained_carries : uncps. Hint Rewrite @chained_carries_id : uncps. Lemma eval_chained_carries {n} (p:tuple Z n) idxs : (forall i, In i idxs -> weight (S i) / weight i <> 0) -> eval (chained_carries p idxs) = eval p. - Proof. + Proof using Type*. cbv [chained_carries chained_carries_cps]; intros; autorewrite with uncps push_id. apply fold_right_invariant; [|intro; rewrite <-in_rev]; @@ -681,7 +681,7 @@ Module B. Lemma eval_encode {n} x : (n <> 0%nat) -> (forall i, In i (seq 0 n) -> weight (S i) / weight i <> 0) -> eval (@encode n x) = x. - Proof. cbv [encode]; intros; prove_eval; auto. Qed. + Proof using Type*. cbv [encode]; intros; prove_eval; auto. Qed. Hint Rewrite @eval_encode : push_basesystem_eval. End Carries. @@ -739,12 +739,12 @@ Module B. Definition sub p q := sub_cps p q id. Lemma sub_id p q {T} f : @sub_cps p q T f = f (sub p q). - Proof. cbv [sub_cps sub]; autounfold; prove_id. Qed. + Proof using Type. cbv [sub_cps sub]; autounfold; prove_id. Qed. Hint Opaque sub : uncps. Hint Rewrite sub_id : uncps. Lemma eval_sub p q : mod_eq m (eval (sub p q)) (eval p - eval q). - Proof. + Proof using Type*. cbv [sub sub_cps]; autounfold; destruct n; prove_eval. transitivity (eval coef + (eval p - eval q)). { apply f_equal2; ring. } @@ -770,14 +770,14 @@ Module B. Definition Fdecode (x : tuple Z sz) : F m := F.of_Z m (eval x). Lemma Fdecode_Fencode_id x : Fdecode (Fencode x) = x. - Proof. + Proof using div_mod sz_nonzero weight_0 weight_divides weight_nonzero. cbv [Fdecode Fencode]; rewrite @eval_encode by auto. apply F.of_Z_to_Z. Qed. Lemma eq_Feq_iff a b : Logic.eq (Fdecode a) (Fdecode b) <-> eq m a b. - Proof. cbv [Fdecode]; rewrite <-F.eq_of_Z_iff; reflexivity. Qed. + Proof using Type. cbv [Fdecode]; rewrite <-F.eq_of_Z_iff; reflexivity. Qed. End F. diff --git a/src/Reflection/BoundByCastInterp.v b/src/Reflection/BoundByCastInterp.v index cf6131a5e..46a50fd42 100644 --- a/src/Reflection/BoundByCastInterp.v +++ b/src/Reflection/BoundByCastInterp.v @@ -103,7 +103,7 @@ Section language. -> is_bounded_by (Interp interp_op e (interpf_smart_unbound input_bounds x)) output_bounds /\ interpf_smart_unbound _ (Interp interp_op e' x) = Interp interp_op e (interpf_smart_unbound input_bounds x). - Proof. + Proof using cast_val_squash interpf_Cast_id interpf_bound_op interpf_cast is_bounded_by_bound_op is_bounded_by_interp_op is_cast_correct strip_cast_val wff_Cast. intros; subst e' output_bounds. unfold Boundify. erewrite InterpExprEta, InterpInlineCast, InterpLinearize by eauto with wf. diff --git a/src/Reflection/BoundByCastWf.v b/src/Reflection/BoundByCastWf.v index f192fb06d..cc60f14b1 100644 --- a/src/Reflection/BoundByCastWf.v +++ b/src/Reflection/BoundByCastWf.v @@ -39,7 +39,7 @@ Section language. Cast is_cast is_const genericize_op failf t1 e1 args2). - Proof. + Proof using wff_Cast. unfold Boundify; auto 7 with wf. Qed. End language. diff --git a/src/Reflection/Conversion.v b/src/Reflection/Conversion.v index 8d2250a7a..bd0f4f695 100644 --- a/src/Reflection/Conversion.v +++ b/src/Reflection/Conversion.v @@ -44,7 +44,7 @@ Section language. (fun _ x => x) (fun _ x => x) t e = e. - Proof. + Proof using functional_extensionality. induction e; repeat match goal with | _ => reflexivity @@ -82,7 +82,7 @@ Section language. f_var12 f_var21 t e) = interpf interp_op e. - Proof. + Proof using f_var12_id f_var21_id. induction e; repeat match goal with | _ => progress unfold LetIn.Let_In diff --git a/src/Reflection/EtaInterp.v b/src/Reflection/EtaInterp.v index 4ab42a63f..deb551d7d 100644 --- a/src/Reflection/EtaInterp.v +++ b/src/Reflection/EtaInterp.v @@ -33,7 +33,7 @@ Section language. (eq_eta : forall A B x, @eta A B x = x). Lemma eq_interp_flat_type_eta_gen {var t T f} x : @interp_flat_type_eta_gen base_type_code var eta t T f x = f x. - Proof. induction t; t. Qed. + Proof using eq_eta. induction t; t. Qed. (* Local *) Hint Rewrite @eq_interp_flat_type_eta_gen. @@ -43,17 +43,17 @@ Section language. Lemma interp_expr_eta_gen {t e} : forall x, interp (@interp_op) (expr_eta_gen eta exprf_eta (t:=t) e) x = interp (@interp_op) e x. - Proof. t. Qed. + Proof using Type*. t. Qed. End gen_type. (* Local *) Hint Rewrite @interp_expr_eta_gen. Lemma interpf_exprf_eta_gen {t e} : interpf (@interp_op) (exprf_eta_gen eta (t:=t) e) = interpf (@interp_op) e. - Proof. induction e; t. Qed. + Proof using eq_eta. induction e; t. Qed. Lemma InterpExprEtaGen {t e} : forall x, Interp (@interp_op) (ExprEtaGen eta (t:=t) e) x = Interp (@interp_op) e x. - Proof. apply interp_expr_eta_gen; intros; apply interpf_exprf_eta_gen. Qed. + Proof using eq_eta. apply interp_expr_eta_gen; intros; apply interpf_exprf_eta_gen. Qed. End gen_flat_type. (* Local *) Hint Rewrite @eq_interp_flat_type_eta_gen. (* Local *) Hint Rewrite @interp_expr_eta_gen. @@ -61,45 +61,45 @@ Section language. Lemma eq_interp_flat_type_eta {var t T f} x : @interp_flat_type_eta base_type_code var t T f x = f x. - Proof. t. Qed. + Proof using Type. t. Qed. (* Local *) Hint Rewrite @eq_interp_flat_type_eta. Lemma eq_interp_flat_type_eta' {var t T f} x : @interp_flat_type_eta' base_type_code var t T f x = f x. - Proof. t. Qed. + Proof using Type. t. Qed. (* Local *) Hint Rewrite @eq_interp_flat_type_eta'. Lemma interpf_exprf_eta {t e} : interpf (@interp_op) (exprf_eta (t:=t) e) = interpf (@interp_op) e. - Proof. t. Qed. + Proof using Type. t. Qed. (* Local *) Hint Rewrite @interpf_exprf_eta. Lemma interpf_exprf_eta' {t e} : interpf (@interp_op) (exprf_eta' (t:=t) e) = interpf (@interp_op) e. - Proof. t. Qed. + Proof using Type. t. Qed. (* Local *) Hint Rewrite @interpf_exprf_eta'. Lemma interp_expr_eta {t e} : forall x, interp (@interp_op) (expr_eta (t:=t) e) x = interp (@interp_op) e x. - Proof. t. Qed. + Proof using Type. t. Qed. Lemma interp_expr_eta' {t e} : forall x, interp (@interp_op) (expr_eta' (t:=t) e) x = interp (@interp_op) e x. - Proof. t. Qed. + Proof using Type. t. Qed. Lemma InterpExprEta {t e} : forall x, Interp (@interp_op) (ExprEta (t:=t) e) x = Interp (@interp_op) e x. - Proof. apply interp_expr_eta. Qed. + Proof using Type. apply interp_expr_eta. Qed. Lemma InterpExprEta' {t e} : forall x, Interp (@interp_op) (ExprEta' (t:=t) e) x = Interp (@interp_op) e x. - Proof. apply interp_expr_eta'. Qed. + Proof using Type. apply interp_expr_eta'. Qed. Lemma InterpExprEta_arrow {s d e} : forall x, Interp (t:=Arrow s d) (@interp_op) (ExprEta (t:=Arrow s d) e) x = Interp (@interp_op) e x. - Proof. exact (@InterpExprEta (Arrow s d) e). Qed. + Proof using Type. exact (@InterpExprEta (Arrow s d) e). Qed. Lemma InterpExprEta'_arrow {s d e} : forall x, Interp (t:=Arrow s d) (@interp_op) (ExprEta' (t:=Arrow s d) e) x = Interp (@interp_op) e x. - Proof. exact (@InterpExprEta' (Arrow s d) e). Qed. + Proof using Type. exact (@InterpExprEta' (Arrow s d) e). Qed. Lemma eq_interp_eta {t e} : forall x, interp_eta interp_op (t:=t) e x = interp interp_op e x. - Proof. apply eq_interp_flat_type_eta. Qed. + Proof using Type. apply eq_interp_flat_type_eta. Qed. Lemma eq_InterpEta {t e} : forall x, InterpEta interp_op (t:=t) e x = Interp interp_op e x. - Proof. apply eq_interp_eta. Qed. + Proof using Type. apply eq_interp_eta. Qed. End language. Hint Rewrite @eq_interp_flat_type_eta @eq_interp_flat_type_eta' @interpf_exprf_eta @interpf_exprf_eta' @interp_expr_eta @interp_expr_eta' @InterpExprEta @InterpExprEta' @InterpExprEta_arrow @InterpExprEta'_arrow @eq_interp_eta @eq_InterpEta : reflective_interp. diff --git a/src/Reflection/EtaWf.v b/src/Reflection/EtaWf.v index abfef410b..240f5a1e3 100644 --- a/src/Reflection/EtaWf.v +++ b/src/Reflection/EtaWf.v @@ -53,13 +53,13 @@ Section language. : wf (expr_eta_gen eta exprf_eta1 (t:=t) e1) (expr_eta_gen eta exprf_eta2 (t:=t) e2) <-> wf e1 e2. - Proof. unfold expr_eta_gen; t; inversion_wf_step; t. Qed. + Proof using Type*. unfold expr_eta_gen; t; inversion_wf_step; t. Qed. End gen_type. Lemma wff_exprf_eta_gen {t e1 e2} G : wff G (exprf_eta_gen eta (t:=t) e1) (exprf_eta_gen eta (t:=t) e2) <-> @wff base_type_code op var1 var2 G t e1 e2. - Proof. + Proof using eq_eta. revert G; induction e1; first [ progress invert_expr | destruct e2 ]; t; inversion_wf_step; t. Qed. @@ -71,22 +71,22 @@ Section language. Lemma wff_exprf_eta {G t e1 e2} : wff G (exprf_eta (t:=t) e1) (exprf_eta (t:=t) e2) <-> @wff base_type_code op var1 var2 G t e1 e2. - Proof. setoid_rewrite wff_exprf_eta_gen; reflexivity. Qed. + Proof using Type. setoid_rewrite wff_exprf_eta_gen; reflexivity. Qed. Lemma wff_exprf_eta' {G t e1 e2} : wff G (exprf_eta' (t:=t) e1) (exprf_eta' (t:=t) e2) <-> @wff base_type_code op var1 var2 G t e1 e2. - Proof. setoid_rewrite wff_exprf_eta_gen; intuition. Qed. + Proof using Type. setoid_rewrite wff_exprf_eta_gen; intuition. Qed. Lemma wf_expr_eta {t e1 e2} : wf (expr_eta (t:=t) e1) (expr_eta (t:=t) e2) <-> @wf base_type_code op var1 var2 t e1 e2. - Proof. + Proof using Type. unfold expr_eta, exprf_eta. setoid_rewrite wf_expr_eta_gen; intuition (solve [ eapply wff_exprf_eta_gen; [ | eassumption ]; intuition ] || eauto). Qed. Lemma wf_expr_eta' {t e1 e2} : wf (expr_eta' (t:=t) e1) (expr_eta' (t:=t) e2) <-> @wf base_type_code op var1 var2 t e1 e2. - Proof. + Proof using Type. unfold expr_eta', exprf_eta'. setoid_rewrite wf_expr_eta_gen; intuition (solve [ eapply wff_exprf_eta_gen; [ | eassumption ]; intuition ] || eauto). Qed. @@ -97,7 +97,7 @@ Section language. (eq_eta : forall A B x, @eta A B x = x) {t e} : Wf (ExprEtaGen (@eta) e) <-> @Wf base_type_code op t e. - Proof. + Proof using Type. split; intros H var1 var2; specialize (H var1 var2); revert H; eapply wf_expr_eta_gen; try eassumption; intros; symmetry; apply wff_exprf_eta_gen; @@ -106,13 +106,13 @@ Section language. Lemma Wf_ExprEta_iff {t e} : Wf (ExprEta e) <-> @Wf base_type_code op t e. - Proof. + Proof using Type. unfold Wf; setoid_rewrite wf_expr_eta; reflexivity. Qed. Lemma Wf_ExprEta'_iff {t e} : Wf (ExprEta' e) <-> @Wf base_type_code op t e. - Proof. + Proof using Type. unfold Wf; setoid_rewrite wf_expr_eta'; reflexivity. Qed. Definition Wf_ExprEta {t e} : Wf e -> Wf (ExprEta e) := proj2 (@Wf_ExprEta_iff t e). diff --git a/src/Reflection/ExprInversion.v b/src/Reflection/ExprInversion.v index 450824f2f..645555cb5 100644 --- a/src/Reflection/ExprInversion.v +++ b/src/Reflection/ExprInversion.v @@ -147,7 +147,7 @@ Section language. Lemma interpf_invert_Abs interp_op {T e} x : Syntax.interpf interp_op (@invert_Abs interp_base_type T e x) = Syntax.interp interp_op e x. - Proof. destruct e; reflexivity. Qed. + Proof using Type. destruct e; reflexivity. Qed. End language. Global Arguments invert_Var {_ _ _ _} _. diff --git a/src/Reflection/InlineCastInterp.v b/src/Reflection/InlineCastInterp.v index aa9fbb119..f885fbd16 100644 --- a/src/Reflection/InlineCastInterp.v +++ b/src/Reflection/InlineCastInterp.v @@ -46,11 +46,11 @@ Section language. Lemma cast_val_id A (v : exprf _ _ (Tbase A)) : cast_val A A (interpf interp_op v) = interpf interp_op v. - Proof. rewrite <- !interpf_cast, !interpf_Cast_id; reflexivity. Qed. + Proof using interpf_Cast_id interpf_cast. rewrite <- !interpf_cast, !interpf_Cast_id; reflexivity. Qed. Lemma interpf_squash_cast a b c e1 : interpf interp_op (@squash_cast _ a b c e1) = interpf interp_op (Cast _ b c (Cast _ a b e1)). - Proof. + Proof using cast_val_squash interpf_Cast_id interpf_cast. unfold squash_cast; repeat first [ progress break_innermost_match | intro @@ -67,7 +67,7 @@ Section language. Lemma interpf_maybe_push_cast t e e' : @maybe_push_cast _ t e = Some e' -> interpf interp_op e' = interpf interp_op e. - Proof. + Proof using cast_val_squash interpf_Cast_id interpf_cast is_cast_correct. revert e'; induction e; repeat first [ reflexivity | discriminate @@ -97,7 +97,7 @@ Section language. Lemma interpf_exprf_of_push_cast t e : interpf interp_op (exprf_of_inline_directive (@push_cast _ t e)) = interpf interp_op e. - Proof. + Proof using cast_val_squash interpf_Cast_id interpf_cast is_cast_correct. unfold push_cast; break_innermost_match; simpl; try reflexivity. match goal with H : _ |- _ => apply interpf_maybe_push_cast in H end. assumption. @@ -109,7 +109,7 @@ Section language. : forall x, Interp interp_op (@InlineCast t e) x = Interp interp_op e x. - Proof. apply InterpInlineConstGen; auto. Qed. + Proof using cast_val_squash interpf_Cast_id interpf_cast is_cast_correct. apply InterpInlineConstGen; auto. Qed. End language. Hint Rewrite @interpf_exprf_of_push_cast @InterpInlineCast using solve [ eassumption | eauto with wf ] : reflective_interp. diff --git a/src/Reflection/InlineCastWf.v b/src/Reflection/InlineCastWf.v index c973335d0..a61455c4f 100644 --- a/src/Reflection/InlineCastWf.v +++ b/src/Reflection/InlineCastWf.v @@ -38,7 +38,7 @@ Section language. Lemma wff_squash_cast var1 var2 a b c e1 e2 G (Hwf : wff G e1 e2) : wff G (@squash_cast var1 a b c e1) (@squash_cast var2 a b c e2). - Proof. + Proof using wff_Cast. unfold squash_cast; break_innermost_match; auto with wf. Qed. @@ -51,7 +51,7 @@ Section language. | None, None => True | Some _, None | None, Some _ => False end. - Proof. + Proof using wff_Cast. induction Hwf; repeat match goal with | [ |- wff _ (squash_cast _ _ _ _) (squash_cast _ _ _ _) ] @@ -81,7 +81,7 @@ Section language. : @maybe_push_cast var1 t e1 = Some e1' -> @maybe_push_cast var2 t e2 = Some e2' -> wff G e1' e2'. - Proof. + Proof using wff_Cast. intros H0 H1; eapply wff_maybe_push_cast_match in Hwf. rewrite H0, H1 in Hwf; assumption. Qed. @@ -103,7 +103,7 @@ Section language. Lemma wff_push_cast var1 var2 t e1 e2 G (Hwf : wff G e1 e2) : wff_inline_directive G (@push_cast var1 t e1) (@push_cast var2 t e2). - Proof. + Proof using wff_Cast. pose proof (wff_maybe_push_cast_match Hwf). unfold push_cast; destruct t; break_innermost_match; @@ -119,13 +119,13 @@ Section language. : wff G (exprf_of_inline_directive (@push_cast var1 t e1)) (exprf_of_inline_directive (@push_cast var2 t e2)). - Proof. apply wff_push_cast; assumption. Qed. + Proof using wff_Cast. apply wff_push_cast; assumption. Qed. Local Hint Resolve wff_push_cast. Lemma Wf_InlineCast {t} e (Hwf : Wf e) : Wf (@InlineCast t e). - Proof. apply Wf_InlineConstGen; auto. Qed. + Proof using wff_Cast. apply Wf_InlineConstGen; auto. Qed. End language. Hint Resolve Wf_InlineCast : wf. diff --git a/src/Reflection/InlineInterp.v b/src/Reflection/InlineInterp.v index 7bee4a70c..cb9276d9a 100644 --- a/src/Reflection/InlineInterp.v +++ b/src/Reflection/InlineInterp.v @@ -73,14 +73,14 @@ Section language. (x, x')) G -> interpf interp_op x = x') : interpf interp_op (inline_const_genf postprocess e1) = interpf interp_op e2. - Proof. + Proof using Type. clear -wf H Hpostprocess. induction wf; t_fin. Qed. Lemma interpf_postprocess_for_const is_const t e : interpf interp_op (exprf_of_inline_directive (postprocess_for_const is_const t e)) = interpf interp_op e. - Proof. + Proof using Type. unfold postprocess_for_const; t_fin. Qed. @@ -94,7 +94,7 @@ Section language. (x, x')) G -> interpf interp_op x = x') : interpf interp_op (inline_constf is_const e1) = interpf interp_op e2. - Proof. eapply interpf_inline_const_genf; eauto. Qed. + Proof using Type. eapply interpf_inline_const_genf; eauto. Qed. Local Hint Resolve interpf_inline_constf. @@ -102,7 +102,7 @@ Section language. (wf : @wf _ _ t e1 e2) (Hpostprocess : forall t e, interpf interp_op (exprf_of_inline_directive (postprocess t e)) = interpf interp_op e) : forall x, interp interp_op (inline_const_gen postprocess e1) x = interp interp_op e2 x. - Proof. + Proof using Type. destruct wf. simpl in *; intro; eapply (interpf_inline_const_genf postprocess); eauto. Qed. @@ -112,7 +112,7 @@ Section language. Lemma interp_inline_const is_const {t} e1 e2 (wf : @wf _ _ t e1 e2) : forall x, interp interp_op (inline_const is_const e1) x = interp interp_op e2 x. - Proof. + Proof using Type. eapply interp_inline_const_gen; eauto. Qed. @@ -120,7 +120,7 @@ Section language. (wf : Wf e) (Hpostprocess : forall t e, interpf interp_op (exprf_of_inline_directive (postprocess _ t e)) = interpf interp_op e) : forall x, Interp interp_op (InlineConstGen postprocess e) x = Interp interp_op e x. - Proof. + Proof using Type. unfold Interp, InlineConst. eapply (interp_inline_const_gen (postprocess _)); simpl; intuition. Qed. @@ -128,7 +128,7 @@ Section language. Lemma InterpInlineConst is_const {t} (e : Expr t) (wf : Wf e) : forall x, Interp interp_op (InlineConst is_const e) x = Interp interp_op e x. - Proof. + Proof using Type. eapply InterpInlineConstGen; eauto. Qed. End language. diff --git a/src/Reflection/InlineWf.v b/src/Reflection/InlineWf.v index 084f0d46b..20ae25010 100644 --- a/src/Reflection/InlineWf.v +++ b/src/Reflection/InlineWf.v @@ -86,7 +86,7 @@ Section language. wff G e1 e2 -> wff_inline_directive G (postprocess1 t e1) (postprocess2 t e2)) : @wff var1 var2 G t (inline_const_genf postprocess1 e1) (inline_const_genf postprocess2 e2). - Proof. + Proof using Type. revert dependent G; induction wf; simpl in *; auto; intros; []. repeat match goal with | [ H : context[List.In _ (_ ++ _)] |- _ ] @@ -156,7 +156,7 @@ Section language. (e2 : @exprf var2 t) (Hwf : wff G e1 e2) : wff_inline_directive G (postprocess_for_const is_const t e1) (postprocess_for_const is_const t e2). - Proof. + Proof using Type. destruct e1; unfold postprocess_for_const; repeat first [ progress subst | intro @@ -182,7 +182,7 @@ Section language. -> wff G x x') (wf : wff G' e1 e2) : @wff var1 var2 G t (inline_constf is_const e1) (inline_constf is_const e2). - Proof. eapply wff_inline_const_genf; eauto. Qed. + Proof using Type. eapply wff_inline_const_genf; eauto. Qed. Lemma wf_inline_const_gen postprocess1 postprocess2 {t} e1 e2 (Hwf : wf e1 e2) @@ -190,7 +190,7 @@ Section language. wff G e1 e2 -> wff_inline_directive G (postprocess1 t e1) (postprocess2 t e2)) : @wf var1 var2 t (inline_const_gen postprocess1 e1) (inline_const_gen postprocess2 e2). - Proof. + Proof using Type. destruct Hwf; constructor; intros. eapply wff_inline_const_genf; eauto using wff_SmartVarVarf_nil. Qed. @@ -198,7 +198,7 @@ Section language. Lemma wf_inline_const is_const {t} e1 e2 (Hwf : wf e1 e2) : @wf var1 var2 t (inline_const is_const e1) (inline_const is_const e2). - Proof. eapply wf_inline_const_gen; eauto. Qed. + Proof using Type. eapply wf_inline_const_gen; eauto. Qed. End with_var. Lemma Wf_InlineConstGen postprocess {t} (e : Expr t) @@ -207,7 +207,7 @@ Section language. wff G e1 e2 -> wff_inline_directive G (postprocess var1 t e1) (postprocess var2 t e2)) : Wf (InlineConstGen postprocess e). - Proof. + Proof using Type. intros var1 var2. apply (@wf_inline_const_gen var1 var2 (postprocess _) (postprocess _) t (e _) (e _)); simpl; auto. Qed. @@ -215,7 +215,7 @@ Section language. Lemma Wf_InlineConst is_const {t} (e : Expr t) (Hwf : Wf e) : Wf (InlineConst is_const e). - Proof. + Proof using Type. intros var1 var2. apply (@wf_inline_const var1 var2 is_const t (e _) (e _)); simpl. apply Hwf. diff --git a/src/Reflection/InputSyntax.v b/src/Reflection/InputSyntax.v index 832f5fdfd..123e4f851 100644 --- a/src/Reflection/InputSyntax.v +++ b/src/Reflection/InputSyntax.v @@ -147,13 +147,13 @@ Section language. Lemma SmartConst_correct t v : Syntax.interpf interp_op (SmartConst make_const t v) = v. - Proof. + Proof using Type*. induction t; try destruct v; simpl in *; congruence. Qed. Lemma compilef_correct {t} (e : @exprf interp_flat_type t) : Syntax.interpf interp_op (compilef make_const e) = interpf interp_op e. - Proof. + Proof using Type*. induction e; repeat match goal with | _ => reflexivity @@ -170,7 +170,7 @@ Section language. Lemma compile_flat_correct {T} (e : expr (Tflat T)) : forall x, Syntax.interp interp_op (compile make_const e) x = interp interp_op e. - Proof. + Proof using Type*. intros []; simpl. let G := match goal with |- ?G => G end in let G := match (eval pattern T, e in G) with ?G _ _ => G end in @@ -187,11 +187,11 @@ Section language. Lemma Compile_flat_correct_flat {T} (e : Expr (Tflat T)) : forall x, Syntax.Interp interp_op (Compile make_const e) x = Interp interp_op e. - Proof. apply compile_flat_correct. Qed. + Proof using Type*. apply compile_flat_correct. Qed. Lemma Compile_correct {src dst} (e : @Expr (Arrow src (Tflat dst))) : forall x, Syntax.Interp interp_op (Compile make_const e) x = Interp interp_op e x. - Proof. + Proof using Type*. unfold Interp, Compile, Syntax.Interp; simpl. pose (e interp_flat_type) as E. repeat match goal with |- context[e ?f] => change (e f) with E end. diff --git a/src/Reflection/InterpByIsoProofs.v b/src/Reflection/InterpByIsoProofs.v index 2612a1c79..07ad8ed62 100644 --- a/src/Reflection/InterpByIsoProofs.v +++ b/src/Reflection/InterpByIsoProofs.v @@ -23,13 +23,13 @@ Section language. Lemma interpf_retr_id {t} (e : @exprf interp_base_type t) : interpf_retr (fun _ x => x) (fun _ x => x) e = interpf interp_op e. - Proof. + Proof using Type. induction e; simpl; cbv [LetIn.Let_In]; rewrite_hyp ?*; rewrite ?SmartVarfMap_id; reflexivity. Qed. Lemma interp_retr_id {t} (e : @expr interp_base_type t) : forall x, interp_retr (fun _ x => x) (fun _ x => x) e x = interp interp_op e x. - Proof. + Proof using Type. destruct e; simpl; intros; rewrite interpf_retr_id, SmartVarfMap_id; reflexivity. Qed. @@ -49,7 +49,7 @@ Section language. (SmartVarfMap (t:=t1) var1_of_interp e1) (SmartVarfMap var2_of_interp e1))) : interp_of_var1 t x1 = interp_of_var2 t x2. - Proof. + Proof using interp_of_var12. repeat first [ progress repeat autorewrite with core in * | progress subst | progress inversion_sigma @@ -75,7 +75,7 @@ Section language. (Hwf : wff G e1 e2) : interpf_retr var1_of_interp interp_of_var1 e1 = interpf_retr var2_of_interp interp_of_var2 e2. - Proof. + Proof using interp_of_var12. induction Hwf; simpl; rewrite_hyp ?*; try reflexivity; auto. { match goal with H : _ |- _ => apply H end. intros ???; rewrite List.in_app_iff. @@ -86,7 +86,7 @@ Section language. : forall x, interp_retr var1_of_interp interp_of_var1 e1 x = interp_retr var2_of_interp interp_of_var2 e2 x. - Proof. + Proof using interp_of_var12. destruct Hwf; simpl; repeat intro; subst; eapply wff_interpf_retr; eauto. Qed. End with_var2. @@ -102,7 +102,7 @@ Section language. -> interp_of_var t x1 = x2) (Hwf : wff G e1 e2) : interpf_retr var_of_interp interp_of_var e1 = interpf interp_op e2. - Proof. + Proof using var_is_retract. erewrite wff_interpf_retr, interpf_retr_id; eauto. Qed. Lemma wf_interp_retr_correct {t} (e1 : @expr var t) (e2 : @expr interp_base_type t) @@ -110,7 +110,7 @@ Section language. x : interp_retr var_of_interp interp_of_var e1 x = interp interp_op e2 x. - Proof. + Proof using var_is_retract. erewrite wf_interp_retr, interp_retr_id; eauto. Qed. End with_var. diff --git a/src/Reflection/InterpProofs.v b/src/Reflection/InterpProofs.v index 88ceaac56..5d8322441 100644 --- a/src/Reflection/InterpProofs.v +++ b/src/Reflection/InterpProofs.v @@ -22,11 +22,11 @@ Section language. : Syntax.interpf interp_op (LetIn (tx:=tx) ex (tC:=tC) eC) = dlet x := Syntax.interpf interp_op ex in Syntax.interpf interp_op (eC x). - Proof. reflexivity. Qed. + Proof using Type. reflexivity. Qed. Lemma interpf_SmartVarf t v : Syntax.interpf interp_op (SmartVarf (t:=t) v) = v. - Proof. + Proof using Type. unfold SmartVarf; induction t; repeat match goal with | _ => reflexivity @@ -42,7 +42,7 @@ Section language. t (x, x')) (flatten_binding_list (t := t') (SmartVarVarf v) v)) : interpf interp_op x = x'. - Proof. + Proof using Type. clear -Hin. induction t'; simpl in *; try tauto. { intuition (inversion_sigma; inversion_prod; subst; eauto). } @@ -57,7 +57,7 @@ Section language. t (x, x')) (flatten_binding_list (t := t') (SmartVarVarf v') v)) : interpf interp_op x = x'. - Proof. + Proof using Type. subst; eapply interpf_SmartVarVarf; eassumption. Qed. End language. diff --git a/src/Reflection/InterpWf.v b/src/Reflection/InterpWf.v index e4c3e7de0..5f76e0791 100644 --- a/src/Reflection/InterpWf.v +++ b/src/Reflection/InterpWf.v @@ -30,7 +30,7 @@ Section language. (HIn : List.In (existT (fun t : base_type_code => (interp_base_type t * interp_base_type t)%type) t (x, x')%core) (flatten_binding_list (t:=T) e e)) : x = x'. - Proof. + Proof using Type. induction T; simpl in *; [ | | rewrite List.in_app_iff in HIn ]; repeat first [ progress destruct_head or | progress destruct_head False @@ -53,7 +53,7 @@ Section language. -> x = x') (Rwf : wff G e1 e2) : interpf e1 = interpf e2. - Proof. + Proof using Type. induction Rwf; simpl; auto; specialize_by auto; try congruence. rewrite_hyp !*; auto. @@ -73,7 +73,7 @@ Section language. {t} {e1 e2 : expr t} (Rwf : wf e1 e2) : forall x, interp e1 x = interp e2 x. - Proof. + Proof using Type. destruct Rwf; simpl; eauto. Qed. End wf. diff --git a/src/Reflection/InterpWfRel.v b/src/Reflection/InterpWfRel.v index b827c235a..40288232a 100644 --- a/src/Reflection/InterpWfRel.v +++ b/src/Reflection/InterpWfRel.v @@ -39,7 +39,7 @@ Section language. (HIn : List.In (existT (fun t : base_type_code => (interp_base_type1 t * interp_base_type2 t)%type) t (x, x')%core) (flatten_binding_list (t:=T) e1 e2)) : R t x x'. - Proof. + Proof using Type. induction T; simpl in *; try tauto; [ | rewrite List.in_app_iff in HIn ]; repeat first [ progress destruct_head or | progress destruct_head False @@ -61,7 +61,7 @@ Section language. -> R t x x') (Rwf : wff G e1 e2) : interp_flat_type_rel_pointwise R (interpf1 e1) (interpf2 e2). - Proof. + Proof using Type*. induction Rwf; simpl; auto. repeat match goal with | [ H : context[List.In _ (_ ++ _)] |- _ ] @@ -79,7 +79,7 @@ Section language. {t} {e1 : expr1 t} {e2 : expr2 t} (Rwf : wf e1 e2) : interp_type_rel_pointwise R (interp1 e1) (interp2 e2). - Proof. + Proof using Type*. destruct Rwf; simpl; repeat intro; eauto. Qed. @@ -87,7 +87,7 @@ Section language. {t} {e : Expr t} (Rwf : Wf e) : interp_type_rel_pointwise R (Interp1 e) (Interp2 e). - Proof. + Proof using Type*. unfold Interp, Wf in *; apply interp_wf; simpl; intuition. Qed. End wf. diff --git a/src/Reflection/LinearizeInterp.v b/src/Reflection/LinearizeInterp.v index e6acac0d6..293d80a34 100644 --- a/src/Reflection/LinearizeInterp.v +++ b/src/Reflection/LinearizeInterp.v @@ -53,14 +53,14 @@ Section language. Lemma interpf_under_letsf {t tC} (ex : exprf t) (eC : _ -> exprf tC) : interpf interp_op (under_letsf ex eC) = let x := interpf interp_op ex in interpf interp_op (eC x). - Proof. + Proof using Type. clear. induction ex; t_fin. Qed. Lemma interpf_linearizef {t} e : interpf interp_op (linearizef (t:=t) e) = interpf interp_op e. - Proof. + Proof using Type. clear. induction e; repeat first [ progress rewrite ?interpf_under_letsf, ?interpf_SmartVarf @@ -72,13 +72,13 @@ Section language. Lemma interp_linearize {t} e : forall x, interp interp_op (linearize (t:=t) e) x = interp interp_op e x. - Proof. + Proof using Type. induction e; simpl; eauto. Qed. Lemma InterpLinearize {t} (e : Expr t) : forall x, Interp interp_op (Linearize e) x = Interp interp_op e x. - Proof. + Proof using Type. unfold Interp, Linearize. eapply interp_linearize. Qed. diff --git a/src/Reflection/LinearizeWf.v b/src/Reflection/LinearizeWf.v index 4e4b4fc38..b12e83b56 100644 --- a/src/Reflection/LinearizeWf.v +++ b/src/Reflection/LinearizeWf.v @@ -102,7 +102,7 @@ Section language. wff (flatten_binding_list x1 x2 ++ G) (eC1 x1) (eC2 x2)) {struct e1} : @wff var1 var2 G tC (under_letsf e1 eC1) (under_letsf e2 eC2). - Proof. + Proof using Type. revert H. set (e1v := e1) in *. destruct e1 as [ | | ? ? ? args | tx ex tC0 eC0 | ? ex ? ey ]; @@ -153,7 +153,7 @@ Section language. Lemma wff_linearizef G {t} e1 e2 : @wff var1 var2 G t e1 e2 -> @wff var1 var2 G t (linearizef e1) (linearizef e2). - Proof. + Proof using Type. induction 1; t_fin ltac:(apply wff_under_letsf). Qed. @@ -162,13 +162,13 @@ Section language. Lemma wf_linearize {t} e1 e2 : @wf var1 var2 t e1 e2 -> @wf var1 var2 t (linearize e1) (linearize e2). - Proof. + Proof using Type. destruct 1; constructor; auto. Qed. End with_var. Lemma Wf_Linearize {t} (e : Expr t) : Wf e -> Wf (Linearize e). - Proof. + Proof using Type. intros wf var1 var2; apply wf_linearize, wf. Qed. End language. diff --git a/src/Reflection/MapCastByDeBruijnInterp.v b/src/Reflection/MapCastByDeBruijnInterp.v index 74622223e..90cbad00c 100644 --- a/src/Reflection/MapCastByDeBruijnInterp.v +++ b/src/Reflection/MapCastByDeBruijnInterp.v @@ -78,7 +78,7 @@ Section language. Interp interp_op_bounds e input_bounds = b /\ @inbounds _ b (Interp interp_op e v) /\ cast_back _ _ (Interp interp_op e' v') = (Interp interp_op e v). - Proof. + Proof using base_type_code_lb interp_op_bounds_correct pull_cast_back. unfold MapCastByDeBruijn.MapCast, MapCastCompile, MapCastDoCast, MapCastDoInterp, option_map; intros b e'. break_innermost_match; try congruence; intros ? v v'. inversion_option; inversion_sigma; subst; simpl in *; intros. diff --git a/src/Reflection/MapCastByDeBruijnWf.v b/src/Reflection/MapCastByDeBruijnWf.v index fd8b824ca..4fd3975f7 100644 --- a/src/Reflection/MapCastByDeBruijnWf.v +++ b/src/Reflection/MapCastByDeBruijnWf.v @@ -72,7 +72,7 @@ Section language. (input_bounds : interp_flat_type interp_base_type_bounds (domain t)) : forall {b} e' (He':MapCast e input_bounds = Some (existT _ b e')) (Hwf : Wf e), Wf e'. - Proof. + Proof using base_type_code_lb. unfold MapCastByDeBruijn.MapCast, MapCastCompile, MapCastDoCast, MapCastDoInterp, option_map; intros b e'. break_innermost_match; try congruence; intros ? v v'. inversion_option; inversion_sigma; subst; simpl in *; intros. @@ -100,7 +100,7 @@ Section language. (He':MapCast e input_bounds = Some (existT _ b e')) (Hwf : Wf e), Wf e'. - Proof. exact (@Wf_MapCast (Arrow s d) e input_bounds). Qed. + Proof using base_type_code_lb. exact (@Wf_MapCast (Arrow s d) e input_bounds). Qed. End language. Hint Resolve Wf_MapCast Wf_MapCast_arrow : wf. diff --git a/src/Reflection/MapCastInterp.v b/src/Reflection/MapCastInterp.v index e3f93af86..528e69e12 100644 --- a/src/Reflection/MapCastInterp.v +++ b/src/Reflection/MapCastInterp.v @@ -64,7 +64,7 @@ Section language. R t x : is_true (@bounds_are_recursively_goodb R t x) <-> @bounds_are_recursively_good (fun t x => is_true (R t x)) t x. - Proof. + Proof using Type. unfold is_true. clear; induction x; simpl in *; rewrite ?Bool.andb_true_iff; try setoid_rewrite interp_flat_type_rel_pointwise1_gen_Prop_iff_bool; @@ -81,7 +81,7 @@ Section language. := (@interp_flat_type_rel_pointwise1 _ _ bound_is_good). Lemma bounds_are_good_when_recursively_good {t} e : @bounds_are_recursively_good bound_is_good t e -> bounds_are_good (interpf interp_op2 e). - Proof. + Proof using Type. induction e; simpl; unfold LetIn.Let_In; intuition auto. Qed. Local Hint Resolve bounds_are_good_when_recursively_good. @@ -227,7 +227,7 @@ Section language. = interpf interp_op1 e1 /\ R (interpf interp_op1 (@mapf_interp_cast interp_base_type1 t1 e1 t1 ebounds)) (interpf interp_op2 ebounds). - Proof. induction Hwf; repeat t_step. Qed. + Proof using R_transfer_op interpf_transfer_op. induction Hwf; repeat t_step. Qed. Local Hint Resolve interpf_mapf_interp_cast_and_rel. @@ -239,7 +239,7 @@ Section language. (Hwf : wff G e1 ebounds) : interpf interp_op1 (@mapf_interp_cast interp_base_type1 t1 e1 t1 ebounds) = interpf interp_op1 e1. - Proof. eapply interpf_mapf_interp_cast_and_rel; eassumption. Qed. + Proof using R_transfer_op interpf_transfer_op. eapply interpf_mapf_interp_cast_and_rel; eassumption. Qed. Lemma interp_map_interp_cast_and_rel {t1} e1 ebounds @@ -252,7 +252,7 @@ Section language. = interp interp_op1 e1 x /\ R (interp interp_op1 (@map_interp_cast interp_base_type1 t1 e1 t1 ebounds args2) x) (interp interp_op2 ebounds args2). - Proof. destruct Hwf; intros; eapply interpf_mapf_interp_cast_and_rel; eauto. Qed. + Proof using R_transfer_op interpf_transfer_op. destruct Hwf; intros; eapply interpf_mapf_interp_cast_and_rel; eauto. Qed. Lemma interp_map_interp_cast {t1} e1 ebounds @@ -263,7 +263,7 @@ Section language. R x args2 -> interp interp_op1 (@map_interp_cast interp_base_type1 t1 e1 t1 ebounds args2) x = interp interp_op1 e1 x. - Proof. intros; eapply interp_map_interp_cast_and_rel; eassumption. Qed. + Proof using R_transfer_op interpf_transfer_op. intros; eapply interp_map_interp_cast_and_rel; eassumption. Qed. Lemma InterpMapInterpCastAndRel {t} e @@ -276,7 +276,7 @@ Section language. = Interp interp_op1 e x /\ R (Interp interp_op1 (@MapInterpCast t e args) x) (Interp interp_op2 e args). - Proof. apply interp_map_interp_cast_and_rel; auto. Qed. + Proof using R_transfer_op interpf_transfer_op. apply interp_map_interp_cast_and_rel; auto. Qed. Lemma InterpMapInterpCast {t} e @@ -287,5 +287,5 @@ Section language. R x args -> Interp interp_op1 (@MapInterpCast t e args) x = Interp interp_op1 e x. - Proof. apply interp_map_interp_cast; auto. Qed. + Proof using R_transfer_op interpf_transfer_op. apply interp_map_interp_cast; auto. Qed. End language. diff --git a/src/Reflection/MapCastWf.v b/src/Reflection/MapCastWf.v index 717f8de60..54e8d0020 100644 --- a/src/Reflection/MapCastWf.v +++ b/src/Reflection/MapCastWf.v @@ -102,7 +102,7 @@ Section language. : wff G1 (@mapf_interp_cast ovar1 t1 e1 t1 ebounds) (@mapf_interp_cast ovar2 t1 e2 t1 ebounds). - Proof. + Proof using wff_transfer_op. revert dependent Gbounds; revert ebounds; induction Hwf; repeat match goal with @@ -130,7 +130,7 @@ Section language. (Hwf : wf e1 e2) : wf (@map_interp_cast ovar1 t1 e1 t1 ebounds args2) (@map_interp_cast ovar2 t1 e2 t1 ebounds args2). - Proof. + Proof using wff_transfer_op. destruct Hwf; repeat match goal with | _ => solve [ constructor; eauto @@ -163,7 +163,7 @@ Section language. args (Hwf : Wf e) : Wf (@MapInterpCast t e args). - Proof. + Proof using wff_transfer_op. intros ??; apply wf_map_interp_cast; auto. Qed. End gen. diff --git a/src/Reflection/Named/CompileInterp.v b/src/Reflection/Named/CompileInterp.v index 6cb075f08..100d53aa3 100644 --- a/src/Reflection/Named/CompileInterp.v +++ b/src/Reflection/Named/CompileInterp.v @@ -54,7 +54,7 @@ Section language. (HGls : forall t n x, List.In (existT _ t (n, x)%core) G -> List.In (Some n) ls -> False) : Named.interpf (interp_op:=interp_op) (ctx:=ctx) v = Some (interpf interp_op e'). - Proof. + Proof using ContextOk Name_dec base_type_dec. revert dependent ctx; revert dependent ls; induction Hwf; repeat first [ progress intros | progress subst @@ -135,7 +135,7 @@ Section language. (H : ocompile e ls = Some f) : forall v, Named.interp (interp_op:=interp_op) (ctx:=ctx) f v = Some (interp interp_op e' v). - Proof. + Proof using ContextOk Name_dec base_type_dec. revert H; destruct Hwf; repeat first [ progress simpl in * | progress unfold option_map, Named.interp in * @@ -179,7 +179,7 @@ Section language. (HGls : forall t n x, List.In (existT _ t (n, x)%core) G -> List.In n ls -> False) : Named.interpf (interp_op:=interp_op) (ctx:=ctx) v = Some (interpf interp_op e'). - Proof. + Proof using ContextOk Name_dec base_type_dec. eapply interpf_ocompilef; try eassumption. setoid_rewrite List.in_map_iff; intros; destruct_head' ex; destruct_head' and; inversion_option; subst. eauto. @@ -192,5 +192,5 @@ Section language. (H : compile e ls = Some f) : forall v, Named.interp (interp_op:=interp_op) (ctx:=ctx) f v = Some (interp interp_op e' v). - Proof. eapply interp_ocompile; eassumption. Qed. + Proof using ContextOk Name_dec base_type_dec. eapply interp_ocompile; eassumption. Qed. End language. diff --git a/src/Reflection/Named/CompileWf.v b/src/Reflection/Named/CompileWf.v index 3f322aed5..5fb17b18d 100644 --- a/src/Reflection/Named/CompileWf.v +++ b/src/Reflection/Named/CompileWf.v @@ -55,7 +55,7 @@ Section language. (Hls : oname_list_unique ls) (HGls : forall t n x, List.In (existT _ t (n, x)%core) G -> List.In (Some n) ls -> False) : prop_of_option (nwff ctx v). - Proof. + Proof using ContextOk Name_dec base_type_dec. revert dependent ctx; revert dependent ls; induction Hwf; repeat first [ progress intros | progress subst @@ -165,7 +165,7 @@ Section language. (Hls : oname_list_unique ls) (H : ocompile e ls = Some f) : nwf ctx f. - Proof. + Proof using ContextOk Name_dec base_type_dec. revert H; destruct Hwf; repeat first [ progress simpl in * | progress unfold option_map, Named.interp in * @@ -210,7 +210,7 @@ Section language. (Hls : name_list_unique ls) (HGls : forall t n x, List.In (existT _ t (n, x)%core) G -> List.In n ls -> False) : prop_of_option (nwff ctx v). - Proof. + Proof using ContextOk Name_dec base_type_dec. eapply wff_ocompilef; try eassumption. setoid_rewrite List.in_map_iff; intros; destruct_head' ex; destruct_head' and; inversion_option; subst. eauto. @@ -222,5 +222,5 @@ Section language. (Hls : name_list_unique ls) (H : compile e ls = Some f) : nwf ctx f. - Proof. eapply wf_ocompile; eassumption. Qed. + Proof using ContextOk Name_dec base_type_dec. eapply wf_ocompile; eassumption. Qed. End language. diff --git a/src/Reflection/Named/ContextProperties.v b/src/Reflection/Named/ContextProperties.v index 4bd0325fb..c031d0af2 100644 --- a/src/Reflection/Named/ContextProperties.v +++ b/src/Reflection/Named/ContextProperties.v @@ -31,7 +31,7 @@ Section with_context. T N t n v : lookupb (extend ctx N (t:=T) v) n t = find_Name_and_val t n N v (lookupb ctx n t). - Proof. revert ctx; induction T; t. Qed. + Proof using ContextOk. revert ctx; induction T; t. Qed. Lemma find_Name_and_val_Some_None {var' var''} @@ -42,7 +42,7 @@ Section with_context. (H0 : @find_Name_and_val var' t n T N x default = Some v) (H1 : @find_Name_and_val var'' t n T N y default' = None) : default = Some v /\ default' = None. - Proof. + Proof using Type. revert dependent default; revert dependent default'; induction T; t. Qed. @@ -54,7 +54,7 @@ Section with_context. (H : @find_Name n T N <> None) : @find_Name_and_val var' t n T N x default = @find_Name_and_val var' t n T N x None. - Proof. revert default; induction T; t. Qed. + Proof using Type. revert default; induction T; t. Qed. Hint Rewrite @find_Name_and_val_default_to_None using congruence : ctx_db. Lemma find_Name_and_val_different @@ -64,7 +64,7 @@ Section with_context. {default} (H : @find_Name n T N = None) : @find_Name_and_val var' t n T N x default = default. - Proof. revert default; induction T; t. Qed. + Proof using Type. revert default; induction T; t. Qed. Hint Rewrite @find_Name_and_val_different using assumption : ctx_db. Lemma find_Name_and_val_wrong_type_iff @@ -75,7 +75,7 @@ Section with_context. (H : @find_Name n T N = Some t') : t <> t' <-> @find_Name_and_val var' t n T N x default = None. - Proof. split; revert default; induction T; t. Qed. + Proof using Type. split; revert default; induction T; t. Qed. Lemma find_Name_and_val_wrong_type {var'} {t t' n T N} @@ -84,14 +84,14 @@ Section with_context. (H : @find_Name n T N = Some t') (Ht : t <> t') : @find_Name_and_val var' t n T N x default = None. - Proof. eapply find_Name_and_val_wrong_type_iff; eassumption. Qed. + Proof using Type. eapply find_Name_and_val_wrong_type_iff; eassumption. Qed. Hint Rewrite @find_Name_and_val_wrong_type using congruence : ctx_db. Lemma find_Name_find_Name_and_val_wrong {var' n t' T V N} : find_Name n N = Some t' -> @find_Name_and_val var' t' n T N V None = None -> False. - Proof. induction T; t. Qed. + Proof using Type. induction T; t. Qed. Lemma find_Name_and_val_None_iff {var'} @@ -101,7 +101,7 @@ Section with_context. : (@find_Name n T N <> Some t /\ (@find_Name n T N <> None \/ default = None)) <-> @find_Name_and_val var' t n T N x default = None. - Proof. + Proof using Type. destruct (@find_Name n T N) eqn:?; unfold not; t; try solve [ eapply find_Name_and_val_wrong_type; [ eassumption | congruence ] | eapply find_Name_find_Name_and_val_wrong; eassumption @@ -117,14 +117,14 @@ Section with_context. else None | None => default end. - Proof. + Proof using Type. t; erewrite find_Name_and_val_wrong_type by solve [ eassumption | congruence ]; reflexivity. Qed. Lemma find_Name_and_val_find_Name_Some {var' t n T N V v} (H : @find_Name_and_val var' t n T N V None = Some v) : @find_Name n T N = Some t. - Proof. + Proof using Type. rewrite find_Name_and_val_split in H; break_match_hyps; subst; congruence. Qed. End with_context. diff --git a/src/Reflection/Named/ContextProperties/NameUtil.v b/src/Reflection/Named/ContextProperties/NameUtil.v index c494acd2d..4853f9a41 100644 --- a/src/Reflection/Named/ContextProperties/NameUtil.v +++ b/src/Reflection/Named/ContextProperties/NameUtil.v @@ -46,7 +46,7 @@ Section with_context. (H : split_onames _ ls = (Some N, ls')%core) : (exists t, @find_Name n T N = Some t) <-> List.In (Some n) (List.firstn (CountLets.count_pairs T) ls). - Proof. + Proof using Type. revert dependent ls; intro ls; revert ls ls'; induction T; intros; [ | | specialize (IHT1 (fst N) ls (snd (split_onames T1 ls))); specialize (IHT2 (snd N) (snd (split_onames T1 ls)) (snd (split_onames (T1 * T2) ls))) ]; @@ -71,7 +71,7 @@ Section with_context. (H : split_onames _ ls = (Some N, ls')%core) : (exists t, @find_Name n T N = Some t) <-> List.In (Some n) ls /\ ~List.In (Some n) ls'. - Proof. + Proof using Type. rewrite (split_onames_find_Name (ls':=ls') (ls:=ls)) by assumption. rewrite (surjective_pairing (split_onames _ _)) in H. rewrite fst_split_onames_firstn, snd_split_onames_skipn in H. @@ -86,7 +86,7 @@ Section with_context. (H : split_onames _ ls = (Some N, ls')%core) (Hfind : @find_Name n T N = Some t) : List.In (Some n) ls /\ ~List.In (Some n) ls'. - Proof. + Proof using Type. eapply split_onames_find_Name_Some_unique_iff; eauto. Qed. @@ -96,7 +96,7 @@ Section with_context. (H : split_onames _ ls = (Some N, ls')%core) : @find_Name_and_val var' t n T N V None = Some v <-> List.In (existT (fun t => (Name * var' t)%type) t (n, v)) (Wf.flatten_binding_list N V). - Proof. + Proof using Type. revert dependent ls; intro ls; revert ls ls'; induction T; intros; [ | | specialize (IHT1 (fst N) (fst V) ls (snd (split_onames T1 ls))); specialize (IHT2 (snd N) (snd V) (snd (split_onames T1 ls)) (snd (split_onames (T1 * T2) ls))) ]; diff --git a/src/Reflection/Named/ContextProperties/SmartMap.v b/src/Reflection/Named/ContextProperties/SmartMap.v index fd2144bed..89d0d1c5d 100644 --- a/src/Reflection/Named/ContextProperties/SmartMap.v +++ b/src/Reflection/Named/ContextProperties/SmartMap.v @@ -25,7 +25,7 @@ Section with_context. (H1 : @find_Name_and_val var' t n T N V1 None = Some v1) (H2 : @find_Name_and_val var'' t n T N V2 None = Some v2) : List.In (existT (fun t => (var' t * var'' t)%type) t (v1, v2)) (Wf.flatten_binding_list V1 V2). - Proof. + Proof using Type. induction T; [ | | specialize (IHT1 (fst N) (fst V1) (fst V2)); specialize (IHT2 (snd N) (snd V1) (snd V2)) ]; @@ -38,7 +38,7 @@ Section with_context. : @find_Name n (SmartFlatTypeMap f (t:=T) V) (SmartFlatTypeMapInterp2 (var':=var') (fun _ _ (n' : Name) => n') V N) = None <-> find_Name n N = None. - Proof. + Proof using Type. split; (induction T; [ | | specialize (IHT1 (fst V) (fst N)); @@ -50,19 +50,19 @@ Section with_context. : @find_Name n (SmartFlatTypeMap f (t:=T) V) (SmartFlatTypeMapInterp2 (var':=var') (fun _ _ (n' : Name) => n') V N) = None -> find_Name n N = None. - Proof. apply find_Name_SmartFlatTypeMapInterp2_None_iff. Qed. + Proof using Type. apply find_Name_SmartFlatTypeMapInterp2_None_iff. Qed. Hint Rewrite @find_Name_SmartFlatTypeMapInterp2_None using eassumption : ctx_db. Lemma find_Name_SmartFlatTypeMapInterp2_None' {var' n f T V N} : find_Name n N = None -> @find_Name n (SmartFlatTypeMap f (t:=T) V) (SmartFlatTypeMapInterp2 (var':=var') (fun _ _ (n' : Name) => n') V N) = None. - Proof. apply find_Name_SmartFlatTypeMapInterp2_None_iff. Qed. + Proof using Type. apply find_Name_SmartFlatTypeMapInterp2_None_iff. Qed. Lemma find_Name_SmartFlatTypeMapInterp2_None_Some_wrong {var' n f T V N v} : @find_Name n (SmartFlatTypeMap f (t:=T) V) (SmartFlatTypeMapInterp2 (var':=var') (fun _ _ (n' : Name) => n') V N) = None -> find_Name n N = Some v -> False. - Proof. + Proof using Type. intro; erewrite find_Name_SmartFlatTypeMapInterp2_None by eassumption; congruence. Qed. Local Hint Resolve @find_Name_SmartFlatTypeMapInterp2_None_Some_wrong. @@ -77,7 +77,7 @@ Section with_context. end | None => None end. - Proof. + Proof using Type. induction T; [ | | specialize (IHT1 (fst V) (fst N)); specialize (IHT2 (snd V) (snd N)) ]. @@ -110,7 +110,7 @@ Section with_context. -> @find_Name_and_val var''' t n T N (SmartFlatTypeMapUnInterp (f:=f) g X) None = Some v' -> g t b v = v'. - Proof. + Proof using Type. induction T; [ | | specialize (IHT1 (fst V) (fst N) (fst X)); specialize (IHT2 (snd V) (snd N) (snd X)) ]; @@ -134,7 +134,7 @@ Section with_context. -> @find_Name_and_val var''' t n T N (SmartFlatTypeMapUnInterp (f:=f) g X) None = Some v' -> g t b v = v'. - Proof. + Proof using Type. induction T; [ | | specialize (IHT1 (fst V) (fst N) (fst X)); specialize (IHT2 (snd V) (snd N) (snd X)) ]; @@ -154,7 +154,7 @@ Section with_context. (H1 : @find_Name_and_val var'' t n T N y None = Some v1) (HR : interp_flat_type_rel_pointwise R x y) : R _ v0 v1. - Proof. + Proof using Type. induction T; [ | | specialize (IHT1 (fst N) (fst x) (fst y)); specialize (IHT2 (snd N) (snd x) (snd y)) ]; @@ -182,7 +182,7 @@ Section with_context. :> { b : _ & var'' (f _ b)}) (N' := SmartFlatTypeMapInterp2 (var'':=fun _ => Name) (f:=f) (fun _ _ n => n) _ N) : b = h v /\ find_Name_and_val (f t (h v)) n N' V None = Some (i v). - Proof. + Proof using Type. induction T; [ | | specialize (IHT1 (fst N) (fst B) (fst V)); specialize (IHT2 (snd N) (snd B) (snd V)) ]; diff --git a/src/Reflection/Named/FMapContext.v b/src/Reflection/Named/FMapContext.v index b838c1b4f..e01186f2c 100644 --- a/src/Reflection/Named/FMapContext.v +++ b/src/Reflection/Named/FMapContext.v @@ -37,7 +37,7 @@ Module FMapContextFun (E : DecidableType) (W : WSfun E). := W.remove n ctx; empty := W.empty _ |}. Lemma FMapContextOk : @ContextOk base_type_code W.key var FMapContext. - Proof. + Proof using E_eq_l base_type_code_lb. split; repeat first [ reflexivity | progress simpl in * diff --git a/src/Reflection/Named/InterpretToPHOASInterp.v b/src/Reflection/Named/InterpretToPHOASInterp.v index 7dcdc198b..4f66e94d4 100644 --- a/src/Reflection/Named/InterpretToPHOASInterp.v +++ b/src/Reflection/Named/InterpretToPHOASInterp.v @@ -30,7 +30,7 @@ Section language. (Hwf : prop_of_option (Named.wff ctx e)) : Named.interpf (interp_op:=interp_op) (ctx:=ctx) e = Some (Syntax.interpf interp_op (interpf_to_phoas failb ctx e)). - Proof. + Proof using Type. revert dependent ctx; induction e; repeat first [ progress intros | progress subst @@ -58,7 +58,7 @@ Section language. v : Named.interp (interp_op:=interp_op) (ctx:=ctx) e v = Some (Syntax.interp interp_op (interp_to_phoas failb ctx e) v). - Proof. + Proof using Type. unfold interp, interp_to_phoas, Named.interp; apply interpf_interpf_to_phoas; auto. Qed. End with_context. @@ -75,7 +75,7 @@ Section language. v : Named.interp (interp_op:=interp_op) (ctx:=ctx _) e v = Some (Interp interp_op (InterpToPHOAS_gen failb ctx e) v). - Proof. apply interp_interp_to_phoas; auto. Qed. + Proof using Type. apply interp_interp_to_phoas; auto. Qed. Lemma Interp_InterpToPHOAS {t} (e : @Named.expr base_type_code op Name t) @@ -83,6 +83,6 @@ Section language. v : Named.interp (Context:=Context _) (interp_op:=interp_op) (ctx:=empty) e v = Some (Interp interp_op (InterpToPHOAS (Context:=Context) failb e) v). - Proof. apply interp_interp_to_phoas; auto. Qed. + Proof using Type. apply interp_interp_to_phoas; auto. Qed. End all. End language. diff --git a/src/Reflection/Named/InterpretToPHOASWf.v b/src/Reflection/Named/InterpretToPHOASWf.v index 86887cdee..daab24b62 100644 --- a/src/Reflection/Named/InterpretToPHOASWf.v +++ b/src/Reflection/Named/InterpretToPHOASWf.v @@ -73,7 +73,7 @@ Section language. (Hctx1_ctx2 : forall n t, lookupb ctx1 n t = None <-> lookupb ctx2 n t = None) : wff G (interpf_to_phoas failb1 ctx1 e) (interpf_to_phoas failb2 ctx2 e). - Proof. + Proof using Context1Ok Context2Ok Name_dec base_type_code_dec. revert dependent G; revert dependent ctx1; revert dependent ctx2; induction e; repeat first [ progress intros | progress destruct_head' and @@ -95,7 +95,7 @@ Section language. (Hctx1 : forall n t, lookupb ctx1 n t = None) (Hctx2 : forall n t, lookupb ctx2 n t = None) : wf (interp_to_phoas failb1 ctx1 e) (interp_to_phoas failb2 ctx2 e). - Proof. + Proof using Context1Ok Context2Ok Name_dec base_type_code_dec. constructor; intros. apply wff_interpf_to_phoas; t. Qed. @@ -105,7 +105,7 @@ Section language. (Hwf1 : Named.wf (Context:=Context1) empty e) (Hwf2 : Named.wf (Context:=Context2) empty e) : wf (interp_to_phoas (Context:=Context1) failb1 empty e) (interp_to_phoas (Context:=Context2) failb2 empty e). - Proof. + Proof using Context1Ok Context2Ok Name_dec base_type_code_dec. apply wf_interp_to_phoas_gen; auto using lookupb_empty. Qed. End with_var. @@ -121,7 +121,7 @@ Section language. (Hctx : forall var n t, lookupb (ctx var) n t = None) (Hwf : forall var, Named.wf (ctx var) e) : Wf (InterpToPHOAS_gen failb ctx e). - Proof. + Proof using ContextOk Name_dec base_type_code_dec. intros ??; apply wf_interp_to_phoas_gen; auto. Qed. @@ -129,7 +129,7 @@ Section language. {t} (e : @Named.expr base_type_code op Name t) (Hwf : Named.Wf Context e) : Wf (InterpToPHOAS (Context:=Context) failb e). - Proof. + Proof using ContextOk Name_dec base_type_code_dec. intros ??; apply wf_interp_to_phoas; auto. Qed. End all. diff --git a/src/Reflection/Named/MapCastInterp.v b/src/Reflection/Named/MapCastInterp.v index 1fe175879..b7afa1494 100644 --- a/src/Reflection/Named/MapCastInterp.v +++ b/src/Reflection/Named/MapCastInterp.v @@ -210,7 +210,7 @@ Section language. r' (Hr':interpf (interp_op:=interp_op) (ctx:=newValues) e' = Some r') , interpf (interp_op:=interp_op_bounds) (ctx:=varBounds) e = Some b /\ @inbounds _ b r /\ cast_back _ _ r' = r. - Proof. + Proof using Type*. induction e; simpl interpf; simpl mapf_cast; unfold option_map, cast_back in *; intros; repeat (break_match_hyps; inversion_option; inversion_sigma; simpl in *; unfold option_map in *; subst; try tauto). { destruct (Hctx _ _ _ Hr) as [b' [Hb'[Hb'v[v'[Hv' Hv'v]]]]]; clear Hctx Hr; subst. @@ -254,7 +254,7 @@ Section language. r' (Hr':interp (interp_op:=interp_op) (ctx:=newValues) e' v' = Some r') , interp (interp_op:=interp_op_bounds) (ctx:=varBounds) e input_bounds = Some b /\ @inbounds _ b r /\ cast_back _ _ r' = r. - Proof. + Proof using Type*. unfold map_cast, option_map, interp; simpl; intros. repeat first [ progress subst | progress inversion_option diff --git a/src/Reflection/Named/MapCastWf.v b/src/Reflection/Named/MapCastWf.v index a3196dbcc..f05df34c1 100644 --- a/src/Reflection/Named/MapCastWf.v +++ b/src/Reflection/Named/MapCastWf.v @@ -227,7 +227,7 @@ Section language. (Hb : find_Name_and_val base_type_dec Name_dec t n N B None = Some b) (N' := SmartFlatTypeMapInterp2 (var'':=fun _ => Name) (f:=pick_typeb) (fun _ _ n => n) _ N) : b = projT1 v /\ find_Name_and_val base_type_dec Name_dec (pick_typeb t (projT1 v)) n N' V None = Some (projT2 v). - Proof. + Proof using Type. eapply (find_Name_and_val_SmartFlatTypeMapUnInterp2_Some_Some base_type_dec Name_dec (h:=@projT1 _ _) (i:=@projT2 _ _) (f:=pick_typeb) (g:=fun _ => existT _)); auto. Qed. @@ -254,7 +254,7 @@ Section language. -> lookupb (t:=t) varBounds n = Some (projT1 v) /\ lookupb (t:=pick_typeb t (projT1 v)) newValues n = Some (projT2 v)), prop_of_option (Named.wff newValues e'). - Proof. induction e; t. Qed. + Proof using BoundsContextOk ContextOk FullContextOk Name_dec base_type_dec. induction e; t. Qed. Lemma wf_map_cast {t} (e:expr base_type_code op Name t) @@ -270,7 +270,7 @@ Section language. -> lookupb (t:=t) varBounds n = Some (projT1 v) /\ lookupb (t:=pick_typeb t (projT1 v)) newValues n = Some (projT2 v)), Named.wf newValues e'. - Proof. + Proof using BoundsContextOk ContextOk FullContextOk Name_dec base_type_dec. unfold Named.wf, map_cast, option_map, interp; simpl; intros. repeat first [ progress subst | progress inversion_option diff --git a/src/Reflection/Named/NameUtilProperties.v b/src/Reflection/Named/NameUtilProperties.v index 8dcf32ec5..9a52ff49d 100644 --- a/src/Reflection/Named/NameUtilProperties.v +++ b/src/Reflection/Named/NameUtilProperties.v @@ -27,7 +27,7 @@ Section language. : split_mnames force t ls = (fst (split_mnames force t (firstn (count_pairs t) ls)), skipn (count_pairs t) ls). - Proof. + Proof using Type. apply path_prod_uncurried; simpl. revert ls; induction t; split; split_prod; repeat first [ progress simpl in * @@ -56,17 +56,17 @@ Section language. Lemma snd_split_mnames_skipn (t : flat_type base_type_code) (ls : list MName) : snd (split_mnames force t ls) = skipn (count_pairs t) ls. - Proof. rewrite split_mnames_firstn_skipn; reflexivity. Qed. + Proof using Type. rewrite split_mnames_firstn_skipn; reflexivity. Qed. Lemma fst_split_mnames_firstn (t : flat_type base_type_code) (ls : list MName) : fst (split_mnames force t ls) = fst (split_mnames force t (firstn (count_pairs t) ls)). - Proof. rewrite split_mnames_firstn_skipn at 1; reflexivity. Qed. + Proof using Type. rewrite split_mnames_firstn_skipn at 1; reflexivity. Qed. Lemma mname_list_unique_firstn_skipn n ls : mname_list_unique force ls -> (mname_list_unique force (firstn n ls) /\ mname_list_unique force (skipn n ls)). - Proof. + Proof using Type. unfold mname_list_unique; intro H; split; intros k N; rewrite <- ?firstn_map, <- ?skipn_map, ?skipn_skipn, ?firstn_firstn_min, ?firstn_skipn_add; intros; eapply H; try eassumption. @@ -85,7 +85,7 @@ Section language. := fun H => proj2 (@mname_list_unique_firstn_skipn n ls H). Lemma mname_list_unique_nil : mname_list_unique force nil. - Proof. + Proof using Type. unfold mname_list_unique; simpl; intros ??. rewrite firstn_nil, skipn_nil; simpl; auto. Qed. @@ -96,29 +96,29 @@ Section language. : split_onames t ls = (fst (split_onames t (firstn (count_pairs t) ls)), skipn (count_pairs t) ls). - Proof. apply split_mnames_firstn_skipn. Qed. + Proof using Type. apply split_mnames_firstn_skipn. Qed. Lemma snd_split_onames_skipn (t : flat_type base_type_code) (ls : list (option Name)) : snd (split_onames t ls) = skipn (count_pairs t) ls. - Proof. apply snd_split_mnames_skipn. Qed. + Proof using Type. apply snd_split_mnames_skipn. Qed. Lemma fst_split_onames_firstn (t : flat_type base_type_code) (ls : list (option Name)) : fst (split_onames t ls) = fst (split_onames t (firstn (count_pairs t) ls)). - Proof. apply fst_split_mnames_firstn. Qed. + Proof using Type. apply fst_split_mnames_firstn. Qed. Lemma oname_list_unique_firstn n (ls : list (option Name)) : oname_list_unique ls -> oname_list_unique (firstn n ls). - Proof. apply mname_list_unique_firstn. Qed. + Proof using Type. apply mname_list_unique_firstn. Qed. Lemma oname_list_unique_skipn n (ls : list (option Name)) : oname_list_unique ls -> oname_list_unique (skipn n ls). - Proof. apply mname_list_unique_skipn. Qed. + Proof using Type. apply mname_list_unique_skipn. Qed. Lemma oname_list_unique_specialize (ls : list (option Name)) : oname_list_unique ls -> forall k n, List.In (Some n) (firstn k ls) -> List.In (Some n) (skipn k ls) -> False. - Proof. + Proof using Type. intros H k n; specialize (H k n). rewrite map_id in H; assumption. Qed. @@ -131,25 +131,25 @@ Section language. : split_names t ls = (fst (split_names t (firstn (count_pairs t) ls)), skipn (count_pairs t) ls). - Proof. apply split_mnames_firstn_skipn. Qed. + Proof using Type. apply split_mnames_firstn_skipn. Qed. Lemma snd_split_names_skipn (t : flat_type base_type_code) (ls : list Name) : snd (split_names t ls) = skipn (count_pairs t) ls. - Proof. apply snd_split_mnames_skipn. Qed. + Proof using Type. apply snd_split_mnames_skipn. Qed. Lemma fst_split_names_firstn (t : flat_type base_type_code) (ls : list Name) : fst (split_names t ls) = fst (split_names t (firstn (count_pairs t) ls)). - Proof. apply fst_split_mnames_firstn. Qed. + Proof using Type. apply fst_split_mnames_firstn. Qed. Lemma name_list_unique_firstn n (ls : list Name) : name_list_unique ls -> name_list_unique (firstn n ls). - Proof. + Proof using Type. unfold name_list_unique; intro H; apply oname_list_unique_firstn with (n:=n) in H. rewrite <- firstn_map; assumption. Qed. Lemma name_list_unique_skipn n (ls : list Name) : name_list_unique ls -> name_list_unique (skipn n ls). - Proof. + Proof using Type. unfold name_list_unique; intro H; apply oname_list_unique_skipn with (n:=n) in H. rewrite <- skipn_map; assumption. Qed. @@ -159,7 +159,7 @@ Section language. List.In n (firstn k ls) -> List.In n (skipn k ls) -> False. - Proof. + Proof using Type. intros H k n; specialize (H k n). rewrite !map_id, !firstn_map, !skipn_map in H. eauto using in_map. @@ -170,7 +170,7 @@ Section language. Lemma length_fst_split_names_Some_iff (t : flat_type base_type_code) (ls : list Name) : fst (split_names t ls) <> None <-> List.length ls >= count_pairs t. - Proof. + Proof using Type. revert ls; induction t; intros; try solve [ destruct ls; simpl; intuition (omega || congruence) ]. repeat first [ progress simpl in * @@ -195,7 +195,7 @@ Section language. Lemma length_fst_split_names_None_iff (t : flat_type base_type_code) (ls : list Name) : fst (split_names t ls) = None <-> List.length ls < count_pairs t. - Proof. + Proof using Type. destruct (length_fst_split_names_Some_iff t ls). destruct (le_lt_dec (count_pairs t) (List.length ls)); specialize_by omega; destruct (fst (split_names t ls)); split; try intuition (congruence || omega). @@ -204,7 +204,7 @@ Section language. Lemma split_onames_split_names (t : flat_type base_type_code) (ls : list Name) : split_onames t (List.map Some ls) = (fst (split_names t ls), List.map Some (snd (split_names t ls))). - Proof. + Proof using Type. revert ls; induction t; try solve [ destruct ls; reflexivity ]. repeat first [ progress simpl in * diff --git a/src/Reflection/Named/PositiveContext/DefaultsProperties.v b/src/Reflection/Named/PositiveContext/DefaultsProperties.v index 0fb1254ce..435a4c74c 100644 --- a/src/Reflection/Named/PositiveContext/DefaultsProperties.v +++ b/src/Reflection/Named/PositiveContext/DefaultsProperties.v @@ -16,7 +16,7 @@ Section language. Lemma name_list_unique_map_pos_of_succ_nat_seq a b : name_list_unique (map BinPos.Pos.of_succ_nat (seq a b)). - Proof. + Proof using Type. unfold name_list_unique, oname_list_unique, mname_list_unique. intros k n. rewrite !map_map, firstn_map, skipn_map, firstn_seq, skipn_seq. @@ -28,11 +28,11 @@ Section language. Lemma name_list_unique_default_names_forf {var dummy t e} : name_list_unique (@default_names_forf base_type_code op var dummy t e). - Proof. apply name_list_unique_map_pos_of_succ_nat_seq. Qed. + Proof using Type. apply name_list_unique_map_pos_of_succ_nat_seq. Qed. Lemma name_list_unique_default_names_for {var dummy t e} : name_list_unique (@default_names_for base_type_code op var dummy t e). - Proof. apply name_list_unique_map_pos_of_succ_nat_seq. Qed. + Proof using Type. apply name_list_unique_map_pos_of_succ_nat_seq. Qed. Lemma name_list_unique_DefaultNamesFor {t e} : name_list_unique (@DefaultNamesFor base_type_code op t e). - Proof. apply name_list_unique_map_pos_of_succ_nat_seq. Qed. + Proof using Type. apply name_list_unique_map_pos_of_succ_nat_seq. Qed. End language. diff --git a/src/Reflection/Named/WfInterp.v b/src/Reflection/Named/WfInterp.v index 17fc43ca5..c5fe2bb3a 100644 --- a/src/Reflection/Named/WfInterp.v +++ b/src/Reflection/Named/WfInterp.v @@ -15,7 +15,7 @@ Section language. Lemma wff_interpf_not_None {ctx : Context} {t} {e : @exprf base_type_code op Name t} (Hwf : prop_of_option (wff ctx e)) : @interpf base_type_code interp_base_type op Name Context interp_op ctx t e <> None. - Proof. + Proof using Type. revert dependent ctx; induction e; repeat first [ progress intros | progress simpl in * @@ -34,7 +34,7 @@ Section language. (Hwf : wf ctx e) v : @interp base_type_code interp_base_type op Name Context interp_op ctx t e v <> None. - Proof. + Proof using Type. destruct e; unfold interp, wf in *; apply wff_interpf_not_None; auto. Qed. End language. diff --git a/src/Reflection/Relations.v b/src/Reflection/Relations.v index 8ea1eaf18..9a927243d 100644 --- a/src/Reflection/Relations.v +++ b/src/Reflection/Relations.v @@ -88,7 +88,7 @@ Section language. Global Arguments interp_flat_type_rel_pointwise1 _ !_ _ / . Lemma interp_flat_type_rel_pointwise1_iff_relb {R} t x : interp_flat_type_relb_pointwise1 R t x <-> interp_flat_type_rel_pointwise1 R t x. - Proof. clear; induction t; rel_relb_t. Qed. + Proof using Type. clear; induction t; rel_relb_t. Qed. Definition interp_flat_type_rel_pointwise1_gen_Prop_iff_bool : forall {R} t x, interp_flat_type_rel_pointwise1_gen_Prop bool _ _ R t x @@ -102,7 +102,7 @@ Section language. Global Arguments interp_flat_type_rel_pointwise _ !_ _ _ / . Lemma interp_flat_type_rel_pointwise_iff_relb {R} t x y : interp_flat_type_relb_pointwise R t x y <-> interp_flat_type_rel_pointwise R t x y. - Proof. clear; induction t; rel_relb_t. Qed. + Proof using Type. clear; induction t; rel_relb_t. Qed. Definition interp_flat_type_rel_pointwise_gen_Prop_iff_bool : forall {R} t x y, interp_flat_type_rel_pointwise_gen_Prop bool _ _ R t x y @@ -116,7 +116,7 @@ Section language. Global Arguments interp_flat_type_rel_pointwise_hetero _ !_ !_ _ _ / . Lemma interp_flat_type_rel_pointwise_hetero_iff_relb {R} t1 t2 x y : interp_flat_type_relb_pointwise_hetero R t1 t2 x y <-> interp_flat_type_rel_pointwise_hetero R t1 t2 x y. - Proof. clear; revert dependent t2; induction t1, t2; rel_relb_t. Qed. + Proof using Type. clear; revert dependent t2; induction t1, t2; rel_relb_t. Qed. Definition interp_flat_type_rel_pointwise_hetero_gen_Prop_iff_bool : forall {R} t1 t2 x y, interp_flat_type_rel_pointwise_hetero_gen_Prop bool _ _ _ R t1 t2 x y @@ -126,18 +126,18 @@ Section language. Lemma interp_flat_type_rel_pointwise_hetero_iff {R t} x y : interp_flat_type_rel_pointwise (fun t => R t t) t x y <-> interp_flat_type_rel_pointwise_hetero R t t x y. - Proof. induction t; simpl; rewrite_hyp ?*; reflexivity. Qed. + Proof using Type. induction t; simpl; rewrite_hyp ?*; reflexivity. Qed. Lemma interp_flat_type_rel_pointwise_impl {R1 R2 : forall t, _ -> _ -> Prop} t x y : interp_flat_type_rel_pointwise (fun t x y => (R1 t x y -> R2 t x y)%type) t x y -> (interp_flat_type_rel_pointwise R1 t x y -> interp_flat_type_rel_pointwise R2 t x y). - Proof. induction t; simpl; intuition. Qed. + Proof using Type. induction t; simpl; intuition. Qed. Lemma interp_flat_type_rel_pointwise_always {R : forall t, _ -> _ -> Prop} : (forall t x y, R t x y) -> forall t x y, interp_flat_type_rel_pointwise R t x y. - Proof. induction t; simpl; intuition. Qed. + Proof using Type. induction t; simpl; intuition. Qed. End flat_type. Section flat_type_extra. Context {interp_base_type1 interp_base_type2 : base_type_code -> Type}. @@ -147,11 +147,11 @@ Section language. (fun t x y => (R1 t y x -> R2 t x y)%type) t x y -> (interp_flat_type_rel_pointwise R1 t y x -> interp_flat_type_rel_pointwise R2 t x y). - Proof. induction t; simpl; intuition. Qed. + Proof using Type. induction t; simpl; intuition. Qed. Global Instance interp_flat_type_rel_pointwise_Reflexive {R : forall t, _ -> _ -> Prop} {H : forall t, Reflexive (R t)} : forall t, Reflexive (@interp_flat_type_rel_pointwise interp_base_type1 interp_base_type1 R t). - Proof. + Proof using Type. induction t; intro; simpl; try apply conj; try reflexivity. Qed. @@ -161,7 +161,7 @@ Section language. t f g x y : @interp_flat_type_rel_pointwise interp_base_type1 interp_base_type2 R t (SmartVarfMap f x) (SmartVarfMap g y) <-> @interp_flat_type_rel_pointwise interp_base_type1' interp_base_type2' (fun t x y => R t (f _ x) (g _ y)) t x y. - Proof. + Proof using Type. induction t; simpl; try reflexivity. rewrite_hyp <- !*; reflexivity. Qed. @@ -246,16 +246,16 @@ Section language. (RProd' : forall A B x y, R (Prod A B) x y -> R A (fst x) (fst y) /\ R B (snd x) (snd y)). Lemma lift_interp_flat_type_rel_pointwise1 t (x : interp_flat_type1 t) (y : interp_flat_type2 t) : interp_flat_type_rel_pointwise R t x y -> R t x y. - Proof. clear RProd'; induction t; simpl; destruct_head_hnf' unit; intuition. Qed. + Proof using RProd RUnit. clear RProd'; induction t; simpl; destruct_head_hnf' unit; intuition. Qed. Lemma lift_interp_flat_type_rel_pointwise2 t (x : interp_flat_type1 t) (y : interp_flat_type2 t) : R t x y -> interp_flat_type_rel_pointwise R t x y. - Proof. clear RProd; induction t; simpl; destruct_head_hnf' unit; split_and; intuition. Qed. + Proof using RProd'. clear RProd; induction t; simpl; destruct_head_hnf' unit; split_and; intuition. Qed. End RProd. Section RProd_iff. Context (RProd : forall A B x y, R A (fst x) (fst y) /\ R B (snd x) (snd y) <-> R (Prod A B) x y). Lemma lift_interp_flat_type_rel_pointwise t (x : interp_flat_type1 t) (y : interp_flat_type2 t) : interp_flat_type_rel_pointwise R t x y <-> R t x y. - Proof. + Proof using RProd RUnit. split_iff; split; auto using lift_interp_flat_type_rel_pointwise1, lift_interp_flat_type_rel_pointwise2. Qed. End RProd_iff. @@ -266,7 +266,7 @@ Section language. (fun t x y => f t x = g t y) t x y <-> SmartVarfMap f x = SmartVarfMap g y. - Proof. + Proof using Type. induction t; unfold SmartVarfMap in *; simpl in *; destruct_head_hnf unit; try tauto. rewrite_hyp !*; intuition congruence. Qed. @@ -276,21 +276,21 @@ Section language. (fun t x y => x = f t y) t x y <-> x = SmartVarfMap f y. - Proof. rewrite lift_interp_flat_type_rel_pointwise_f_eq, SmartVarfMap_id; reflexivity. Qed. + Proof using Type. rewrite lift_interp_flat_type_rel_pointwise_f_eq, SmartVarfMap_id; reflexivity. Qed. Lemma lift_interp_flat_type_rel_pointwise_f_eq_id2 (f : forall t, _ -> _) t x y : @interp_flat_type_rel_pointwise interp_base_type1 interp_base_type2 (fun t x y => f t x = y) t x y <-> SmartVarfMap f x = y. - Proof. rewrite lift_interp_flat_type_rel_pointwise_f_eq, SmartVarfMap_id; reflexivity. Qed. + Proof using Type. rewrite lift_interp_flat_type_rel_pointwise_f_eq, SmartVarfMap_id; reflexivity. Qed. Lemma lift_interp_flat_type_rel_pointwise_f_eq2 {T} (f g : forall t, _ -> _ -> T t) t x y : @interp_flat_type_rel_pointwise interp_base_type1 interp_base_type2 (fun t x y => f t x y = g t x y) t x y <-> SmartVarfMap2 f x y = SmartVarfMap2 g x y. - Proof. + Proof using Type. induction t; unfold SmartVarfMap2 in *; simpl in *; destruct_head_hnf unit; try tauto. rewrite_hyp !*; intuition congruence. Qed. @@ -300,7 +300,7 @@ Section language. (fun t x y => f t x = g t y) t x y <-> (forall a b, SmartVarfMap f a = SmartVarfMap g b -> SmartVarfMap f (x a) = SmartVarfMap g (y b)). - Proof. + Proof using Type. destruct t; simpl; unfold interp_type_rel_pointwise, respectful_hetero. setoid_rewrite lift_interp_flat_type_rel_pointwise_f_eq; reflexivity. Qed. @@ -310,14 +310,14 @@ Section language. (fun t x y => x = f t y) t x y <-> (forall a, x (SmartVarfMap f a) = SmartVarfMap f (y a)). - Proof. rewrite lift_interp_type_rel_pointwise_f_eq; setoid_rewrite SmartVarfMap_id; firstorder (subst; eauto). Qed. + Proof using Type. rewrite lift_interp_type_rel_pointwise_f_eq; setoid_rewrite SmartVarfMap_id; firstorder (subst; eauto). Qed. Lemma lift_interp_type_rel_pointwise_f_eq_id2 (f : forall t, _ -> _) t x y : interp_type_rel_pointwise interp_base_type1 interp_base_type2 (fun t x y => f t x = y) t x y <-> (forall a, SmartVarfMap f (x a) = y (SmartVarfMap f a)). - Proof. rewrite lift_interp_type_rel_pointwise_f_eq; setoid_rewrite SmartVarfMap_id; firstorder (subst; eauto). Qed. + Proof using Type. rewrite lift_interp_type_rel_pointwise_f_eq; setoid_rewrite SmartVarfMap_id; firstorder (subst; eauto). Qed. End lifting. Local Ltac t := @@ -341,14 +341,14 @@ Section language. (H : List.In (existT _ t (v1, v2)%core) (flatten_binding_list e1 e2)) (HR : @interp_flat_type_rel_pointwise interp_base_type1 interp_base_type2 R' T e1 e2) : R' t v1 v2. - Proof. induction T; t. Qed. + Proof using Type. induction T; t. Qed. Lemma interp_flat_type_rel_pointwise_hetero_flatten_binding_list2 {interp_base_type1 interp_base_type2 t1 t2 T1 T2} R' e1 e2 v1 v2 (H : List.In (existT _ (t1, t2)%core (v1, v2)%core) (flatten_binding_list2 e1 e2)) (HR : @interp_flat_type_rel_pointwise_hetero interp_base_type1 interp_base_type2 R' T1 T2 e1 e2) : R' t1 t2 v1 v2. - Proof. + Proof using Type. revert dependent T2; induction T1, T2; t. Qed. End language. diff --git a/src/Reflection/RewriterInterp.v b/src/Reflection/RewriterInterp.v index 66315ec0d..4a18c0a47 100644 --- a/src/Reflection/RewriterInterp.v +++ b/src/Reflection/RewriterInterp.v @@ -24,13 +24,13 @@ Section language. Lemma interpf_rewrite_opf {t} (e : exprf t) : interpf interp_op (rewrite_opf rewrite_op_expr e) = interpf interp_op e. - Proof. + Proof using Type*. induction e; simpl; unfold LetIn.Let_In; rewrite_hyp ?*; reflexivity. Qed. Lemma interp_rewrite_op {t} (e : expr t) : forall x, interp interp_op (rewrite_op rewrite_op_expr e) x = interp interp_op e x. - Proof. + Proof using Type*. destruct e; intro x; apply interpf_rewrite_opf. Qed. End specialized. @@ -42,7 +42,7 @@ Section language. = interp_op _ _ opc (interpf interp_op args)) {t} (e : Expr t) : forall x, Interp interp_op (RewriteOp rewrite_op_expr e) x = Interp interp_op e x. - Proof. + Proof using Type. apply interp_rewrite_op; assumption. Qed. End language. diff --git a/src/Reflection/RewriterWf.v b/src/Reflection/RewriterWf.v index a9ad229a0..a7ac86851 100644 --- a/src/Reflection/RewriterWf.v +++ b/src/Reflection/RewriterWf.v @@ -31,14 +31,14 @@ Section language. Lemma wff_rewrite_opf {t} G (e1 : @exprf var1 t) (e2 : @exprf var2 t) (Hwf : wff G e1 e2) : wff G (rewrite_opf rewrite_op_expr1 e1) (rewrite_opf rewrite_op_expr2 e2). - Proof. + Proof using Type*. induction Hwf; simpl; try constructor; auto. Qed. Lemma wf_rewrite_opf {t} (e1 : @expr var1 t) (e2 : @expr var2 t) (Hwf : wf e1 e2) : wf (rewrite_op rewrite_op_expr1 e1) (rewrite_op rewrite_op_expr2 e2). - Proof. + Proof using Type*. destruct Hwf; simpl; constructor; intros; apply wff_rewrite_opf; auto. Qed. End with_var. @@ -53,7 +53,7 @@ Section language. {t} (e : Expr t) (Hwf : Wf e) : Wf (RewriteOp rewrite_op_expr e). - Proof. + Proof using Type. intros var1 var2; apply wf_rewrite_opf; auto. Qed. End language. diff --git a/src/Reflection/SmartBoundInterp.v b/src/Reflection/SmartBoundInterp.v index 7723d98c4..0262ef615 100644 --- a/src/Reflection/SmartBoundInterp.v +++ b/src/Reflection/SmartBoundInterp.v @@ -72,13 +72,13 @@ Section language. {t} e bounds : interpf interp_op (SmartPairf (interpf_smart_bound_exprf (t:=t) e bounds)) = interpf_smart_bound e bounds. - Proof. clear -interpf_cast; induction t; t. Qed. + Proof using interpf_cast. clear -interpf_cast; induction t; t. Qed. Lemma interpf_SmartPairf_interpf_smart_unbound_exprf {t} bounds e : interpf interp_op (SmartPairf (interpf_smart_unbound_exprf (t:=t) bounds e)) = interpf_smart_unbound bounds (SmartVarfMap (fun _ e => interpf interp_op e) e). - Proof. clear -interpf_cast; induction t; t. Qed. + Proof using interpf_cast. clear -interpf_cast; induction t; t. Qed. Lemma interp_smart_bound_and_rel {t} (e : expr t) (ebounds : expr t) @@ -91,7 +91,7 @@ Section language. -> is_bounded_by (interp interp_op e (interpf_smart_unbound input_bounds x)) output_bounds /\ interpf_smart_unbound _ (interp interp_op e' x) = interp interp_op e (interpf_smart_unbound input_bounds x). - Proof. + Proof using interpf_cast is_bounded_by_interp_op strip_cast_val. intros; subst e' output_bounds. match goal with |- ?A /\ ?B => cut (A /\ (A -> B)); [ tauto | ] end. split. @@ -121,7 +121,7 @@ Section language. -> is_bounded_by (Interp interp_op e (interpf_smart_unbound input_bounds x)) output_bounds /\ interpf_smart_unbound _ (Interp interp_op e' x) = Interp interp_op e (interpf_smart_unbound input_bounds x). - Proof. + Proof using interpf_cast is_bounded_by_interp_op strip_cast_val. apply interp_smart_bound_and_rel; auto. Qed. @@ -138,7 +138,7 @@ Section language. is_bounded_by (interpf_smart_unbound input_bounds x) input_bounds -> interpf_smart_unbound _ (Interp interp_op e' x) = Interp interp_op e (interpf_smart_unbound input_bounds x). - Proof. + Proof using interpf_cast is_bounded_by_interp_op strip_cast_val. intros; eapply InterpSmartBoundAndRel; auto. Qed. End language. diff --git a/src/Reflection/SmartBoundWf.v b/src/Reflection/SmartBoundWf.v index 6c2846337..72c5c1475 100644 --- a/src/Reflection/SmartBoundWf.v +++ b/src/Reflection/SmartBoundWf.v @@ -44,7 +44,7 @@ Section language. : wff G (@bound_op ovar1 src1 dst1 src2 dst2 opc1 opc2 e1 args2) (@bound_op ovar2 src1 dst1 src2 dst2 opc1 opc2 e2 args2). - Proof. + Proof using wff_Cast. unfold SmartBound.bound_op; repeat first [ progress break_innermost_match | assumption @@ -73,7 +73,7 @@ Section language. (t:=t) (interpf_smart_unbound_exprf input_bounds (SmartVarfMap (fun t => Var) x2))). - Proof. + Proof using wff_Cast. clear -wff_Cast. unfold SmartPairf, SmartVarfMap, interpf_smart_unbound_exprf; induction t; repeat match goal with @@ -98,7 +98,7 @@ Section language. (SmartPairf (var:=var2) (interpf_smart_bound_exprf x2 output_bounds)). - Proof. + Proof using wff_Cast. clear -wff_Cast. unfold SmartPairf, SmartVarfMap, interpf_smart_bound_exprf; induction t; repeat match goal with @@ -119,7 +119,7 @@ Section language. (Hwf : wf e1 e2) : wf (@smart_bound var1 t1 e1 e_bounds input_bounds) (@smart_bound var2 t1 e2 e_bounds input_bounds). - Proof. + Proof using wff_Cast. clear -wff_Cast Hwf. destruct Hwf; unfold SmartBound.smart_bound. repeat constructor; auto with wf; intros; @@ -130,7 +130,7 @@ Section language. Lemma Wf_SmartBound {t1} e input_bounds (Hwf : Wf e) : Wf (@SmartBound t1 e input_bounds). - Proof. + Proof using wff_Cast. intros var1 var2; specialize (Hwf var1 var2). unfold SmartBound.SmartBound. apply wf_smart_bound; assumption. diff --git a/src/Reflection/SmartCastInterp.v b/src/Reflection/SmartCastInterp.v index 410d108e3..92ca265e1 100644 --- a/src/Reflection/SmartCastInterp.v +++ b/src/Reflection/SmartCastInterp.v @@ -24,7 +24,7 @@ Section language. Lemma interpf_SmartCast_base {A A'} (x : exprf (Tbase A)) : interpf interp_op (SmartCast_base x) = interpf interp_op (Cast _ A A' x). - Proof. + Proof using interpf_Cast_id. clear dependent cast_val. unfold SmartCast_base. destruct (Sumbool.sumbool_of_bool (base_type_beq A A')) as [H|H]. diff --git a/src/Reflection/SmartCastWf.v b/src/Reflection/SmartCastWf.v index ef5d0170d..4c5601669 100644 --- a/src/Reflection/SmartCastWf.v +++ b/src/Reflection/SmartCastWf.v @@ -27,7 +27,7 @@ Section language. Lemma wff_SmartCast_base {var1 var2 A A'} G e1 e2 (Hwf : wff (var1:=var1) (var2:=var2) G (t:=Tbase A) e1 e2) : wff G (t:=Tbase A') (SmartCast_base e1) (SmartCast_base e2). - Proof. + Proof using wff_Cast. unfold SmartCast_base; destruct (Sumbool.sumbool_of_bool (base_type_beq A A')) as [H|H]. { destruct (base_type_bl_transparent A A' H); assumption. } { auto. } @@ -44,7 +44,7 @@ Section language. | None, None => True | Some _, None | None, Some _ => False end. - Proof. + Proof using wff_Cast. break_innermost_match; revert dependent B; induction A, B; repeat match goal with | _ => progress simpl in * @@ -67,7 +67,7 @@ Section language. : SmartCast A B = Some f1 -> SmartCast A B = Some f2 -> forall e1 e2, wff (var1:=var1) (var2:=var2) (flatten_binding_list e1 e2) (f1 e1) (f2 e2). - Proof. + Proof using wff_Cast. intros H1 H2; generalize (@wff_SmartCast_match var1 var2 A B). rewrite H1, H2; trivial. Qed. @@ -76,7 +76,7 @@ Section language. : SmartCast A B = Some f1 -> SmartCast A B = Some f2 -> forall e1 e2, wff (var1:=var1) (var2:=var2) (flatten_binding_list e1 e2 ++ G) (f1 e1) (f2 e2). - Proof. + Proof using wff_Cast. intros; eapply wff_in_impl_Proper; [ eapply wff_SmartCast; eassumption | auto ]. Qed. End language. diff --git a/src/Reflection/SmartMap.v b/src/Reflection/SmartMap.v index 3f66c01d6..934497f65 100644 --- a/src/Reflection/SmartMap.v +++ b/src/Reflection/SmartMap.v @@ -95,7 +95,7 @@ Section homogenous_type. := @smart_interp_flat_map exprfb exprf (fun t x => x) TT (fun A B x y => Pair x y) t. Lemma SmartPairf_Pair {A B} (e1 : interp_flat_type _ A) (e2 : interp_flat_type _ B) : SmartPairf (t:=Prod A B) (e1, e2)%core = Pair (SmartPairf e1) (SmartPairf e2). - Proof. reflexivity. Qed. + Proof using Type. reflexivity. Qed. Definition SmartVarf {t} : interp_flat_type var t -> exprf t := @smart_interp_flat_map var exprf (fun t => Var) TT (fun A B x y => Pair x y) t. Definition SmartVarf_Pair {A B v} @@ -107,12 +107,12 @@ Section homogenous_type. Lemma SmartVarfMap_compose {var' var'' var''' t} f g x : @SmartVarfMap var'' var''' g t (@SmartVarfMap var' var'' f t x) = @SmartVarfMap _ _ (fun t v => g t (f t v)) t x. - Proof. + Proof using Type. unfold SmartVarfMap; clear; induction t; simpl; destruct_head_hnf unit; destruct_head_hnf prod; rewrite_hyp ?*; congruence. Qed. Lemma SmartVarfMap_id {var' t} x : @SmartVarfMap var' var' (fun _ x => x) t x = x. - Proof. + Proof using Type. unfold SmartVarfMap; clear; induction t; simpl; destruct_head_hnf unit; destruct_head_hnf prod; rewrite_hyp ?*; congruence. Qed. @@ -122,7 +122,7 @@ Section homogenous_type. ==> (forall_relation (fun A => forall_relation (fun B => pointwise_relation _ (pointwise_relation _ eq)))) ==> forall_relation (fun t => eq ==> eq)) (@smart_interp_flat_map f g). - Proof. + Proof using Type. unfold forall_relation, pointwise_relation, respectful. intros F G HFG x y ? Q R HQR t a b ?; subst y b. induction t; simpl in *; auto. @@ -131,7 +131,7 @@ Section homogenous_type. Global Instance SmartVarfMap_Proper {var' var''} : Proper (forall_relation (fun t => pointwise_relation _ eq) ==> forall_relation (fun t => eq ==> eq)) (@SmartVarfMap var' var''). - Proof. + Proof using Type. repeat intro; eapply smart_interp_flat_map_Proper; trivial; repeat intro; reflexivity. Qed. Definition SmartVarfMap2 {var var' var''} (f : forall t, var t -> var' t -> var'' t) {t} @@ -141,7 +141,7 @@ Section homogenous_type. (x : interp_flat_type var' t) (y : interp_flat_type var'' t) : SmartVarfMap2 (fun _ a b => a) x y = x. - Proof. + Proof using Type. unfold SmartVarfMap2; clear; induction t; simpl; destruct_head_hnf unit; destruct_head_hnf prod; rewrite_hyp ?*; congruence. Qed. @@ -149,7 +149,7 @@ Section homogenous_type. (x : interp_flat_type var' t) (y : interp_flat_type var'' t) : SmartVarfMap2 (fun _ a b => b) x y = y. - Proof. + Proof using Type. unfold SmartVarfMap2; clear; induction t; simpl; destruct_head_hnf unit; destruct_head_hnf prod; rewrite_hyp ?*; congruence. Qed. @@ -215,7 +215,7 @@ Section homogenous_type. | Arrow src dst => fun F x => SmartVarfMap f (F (SmartVarfMap f' x)) end. Lemma SmartVarMap_id {var' t} x v : @SmartVarMap var' var' (fun _ x => x) (fun _ x => x) t x v = x v. - Proof. destruct t; simpl; rewrite !SmartVarfMap_id; reflexivity. Qed. + Proof using Type. destruct t; simpl; rewrite !SmartVarfMap_id; reflexivity. Qed. Definition SmartVarVarf {t} : interp_flat_type var t -> interp_flat_type exprfb t := SmartVarfMap (fun t => Var). End homogenous_type. @@ -300,7 +300,7 @@ Section hetero_type. (@SmartFlatTypeMap2Interp2 _ _ _ f gv t v e) = SmartVarfMap2 (fun t v e => fv t v (gv t v e)) v e. - Proof. + Proof using Type. induction t; simpl in *; destruct_head' unit; rewrite_hyp ?*; reflexivity. Qed. diff --git a/src/Reflection/Tuple.v b/src/Reflection/Tuple.v index 6071f13c2..519325b82 100644 --- a/src/Reflection/Tuple.v +++ b/src/Reflection/Tuple.v @@ -34,16 +34,16 @@ Section language. end. Lemma flat_interp_untuple'_tuple' {T n v} : @flat_interp_untuple' T n (flat_interp_tuple' v) = v. - Proof. induction n; [ reflexivity | simpl; rewrite IHn; destruct v; reflexivity ]. Qed. + Proof using Type. induction n; [ reflexivity | simpl; rewrite IHn; destruct v; reflexivity ]. Qed. Lemma flat_interp_untuple_tuple {T n v} : flat_interp_untuple (@flat_interp_tuple T n v) = v. - Proof. destruct n; [ reflexivity | apply flat_interp_untuple'_tuple' ]. Qed. + Proof using Type. destruct n; [ reflexivity | apply flat_interp_untuple'_tuple' ]. Qed. Lemma flat_interp_tuple'_untuple' {T n v} : @flat_interp_tuple' T n (flat_interp_untuple' v) = v. - Proof. induction n; [ reflexivity | simpl; rewrite IHn; destruct v; reflexivity ]. Qed. + Proof using Type. induction n; [ reflexivity | simpl; rewrite IHn; destruct v; reflexivity ]. Qed. Lemma flat_interp_tuple_untuple {T n v} : @flat_interp_tuple T n (flat_interp_untuple v) = v. - Proof. destruct n; [ reflexivity | apply flat_interp_tuple'_untuple' ]. Qed. + Proof using Type. destruct n; [ reflexivity | apply flat_interp_tuple'_untuple' ]. Qed. Definition tuple_map {A B n} (f : interp_flat_type A -> interp_flat_type B) (v : interp_flat_type (tuple A n)) : interp_flat_type (tuple B n) diff --git a/src/Reflection/WfInversion.v b/src/Reflection/WfInversion.v index b8cb16c6a..d76fd90f4 100644 --- a/src/Reflection/WfInversion.v +++ b/src/Reflection/WfInversion.v @@ -103,12 +103,12 @@ Section language. Defined. Definition wff_endecode {G t e1 e2} v : @wff_decode G t e1 e2 (@wff_encode G t e1 e2 v) = v. - Proof. + Proof using Type. destruct v; reflexivity. Qed. Definition wff_deencode {G t e1 e2} v : @wff_encode G t e1 e2 (@wff_decode G t e1 e2 v) = v. - Proof. + Proof using Type. destruct e1; simpl in *; move e2 at top; lazymatch type of e2 with @@ -154,12 +154,12 @@ Section language. Defined. Definition wf_endecode {t e1 e2} v : @wf_decode t e1 e2 (@wf_encode t e1 e2 v) = v. - Proof. + Proof using Type. destruct v; reflexivity. Qed. Definition wf_deencode {t e1 e2} v : @wf_encode t e1 e2 (@wf_decode t e1 e2 v) = v. - Proof. + Proof using Type. destruct e1 as [src dst f1]. revert dependent f1. refine match e2 with diff --git a/src/Reflection/WfProofs.v b/src/Reflection/WfProofs.v index dcf3d8347..ca1f50478 100644 --- a/src/Reflection/WfProofs.v +++ b/src/Reflection/WfProofs.v @@ -27,7 +27,7 @@ Section language. Lemma wff_app' {g G0 G1 t e1 e2} (wf : @wff var1 var2 (G0 ++ G1) t e1 e2) : wff (G0 ++ g ++ G1) e1 e2. - Proof. + Proof using Type. rewrite !List.app_assoc. revert wf; remember (G0 ++ G1)%list as G eqn:?; intro wf. revert dependent G0. revert dependent G1. @@ -40,14 +40,14 @@ Section language. Lemma wff_app_pre {g G t e1 e2} (wf : @wff var1 var2 G t e1 e2) : wff (g ++ G) e1 e2. - Proof. + Proof using Type. apply (@wff_app' _ nil); assumption. Qed. Lemma wff_app_post {g G t e1 e2} (wf : @wff var1 var2 G t e1 e2) : wff (G ++ g) e1 e2. - Proof. + Proof using Type. pose proof (@wff_app' g G nil t e1 e2) as H. rewrite !List.app_nil_r in *; auto. Qed. @@ -56,7 +56,7 @@ Section language. : @wff var1 var2 G0 t e1 e2 -> (forall x, List.In x G0 -> List.In x G1) -> @wff var1 var2 G1 t e1 e2. - Proof. + Proof using Type. intro wf; revert G1; induction wf; repeat match goal with | _ => setoid_rewrite List.in_app_iff @@ -74,7 +74,7 @@ Section language. Lemma wff_SmartVarf {t} x1 x2 : @wff var1 var2 (flatten_binding_list x1 x2) t (SmartVarf x1) (SmartVarf x2). - Proof. + Proof using Type. unfold SmartVarf. induction t; simpl; constructor; eauto. Qed. @@ -85,7 +85,7 @@ Section language. (Hin : List.In (existT (fun t : base_type_code => (exprf (Tbase t) * exprf (Tbase t))%type) t (x1, x2)) (flatten_binding_list (SmartVarVarf v1) (SmartVarVarf v2))) : @wff var1 var2 (flatten_binding_list (t:=t') v1 v2 ++ G) (Tbase t) x1 x2. - Proof. + Proof using Type. revert dependent G; induction t'; intros; simpl in *; try tauto. { intuition (inversion_sigma; inversion_prod; subst; simpl; eauto). constructor; eauto. } @@ -99,7 +99,7 @@ Section language. (Hin : List.In (existT (fun t : base_type_code => (exprf (Tbase t) * exprf (Tbase t))%type) t (x1, x2)) (flatten_binding_list (SmartVarVarf v1) (SmartVarVarf v2))) : @wff var1 var2 (flatten_binding_list (t:=t') v1 v2) (Tbase t) x1 x2. - Proof. + Proof using Type. apply wff_SmartVarVarf with (G:=nil) in Hin. rewrite List.app_nil_r in Hin; assumption. Qed. @@ -108,7 +108,7 @@ Section language. (Hwf : @wff var1 var2 G t (SmartVarf v1) (SmartVarf v2)) (Hin : List.In e (flatten_binding_list v1 v2)) : List.In e G. - Proof. + Proof using Type. induction t; repeat match goal with | _ => assumption @@ -136,7 +136,7 @@ Section language. {var1 var2 t1} x1 x2 : duplicate_types (@flatten_binding_list base_type_code var1 var2 t1 x1 x2) = @flatten_binding_list2 base_type_code var1 var2 t1 t1 x1 x2. - Proof. + Proof using Type. induction t1; simpl; try reflexivity. rewrite_hyp <- !*. unfold duplicate_types; rewrite List.map_app; reflexivity. @@ -157,7 +157,7 @@ Section language. : flatten_binding_list2 (var1:=var1') (var2:=var2') (base_type_code:=base_type_code) (SmartVarfMap f x1) (SmartVarfMap g x2) = List.map (fun txy => existT _ (projT1 txy) (f _ (fst (projT2 txy)), g _ (snd (projT2 txy)))%core) (flatten_binding_list2 x1 x2). - Proof. + Proof using Type. revert dependent t2; induction t1, t2; flatten_t. Qed. @@ -166,7 +166,7 @@ Section language. : flatten_binding_list2 (var1:=var1') (var2:=var2') (base_type_code:=base_type_code) (SmartVarfMap f x1) x2 = List.map (fun txy => existT _ (projT1 txy) (f _ (fst (projT2 txy)), snd (projT2 txy))%core) (flatten_binding_list2 x1 x2). - Proof. + Proof using Type. revert dependent t2; induction t1, t2; flatten_t. Qed. @@ -175,7 +175,7 @@ Section language. : flatten_binding_list2 (var1:=var1') (var2:=var2') (base_type_code:=base_type_code) x1 (SmartVarfMap g x2) = List.map (fun txy => existT _ (projT1 txy) (fst (projT2 txy), g _ (snd (projT2 txy)))%core) (flatten_binding_list2 x1 x2). - Proof. + Proof using Type. revert dependent t2; induction t1, t2; flatten_t. Qed. @@ -184,14 +184,14 @@ Section language. : flatten_binding_list (var1:=var1') (var2:=var2') (base_type_code:=base_type_code) (SmartVarfMap f x1) (SmartVarfMap g x2) = List.map (fun txy => existT _ (projT1 txy) (f _ (fst (projT2 txy)), g _ (snd (projT2 txy)))%core) (flatten_binding_list x1 x2). - Proof. induction t; flatten_t. Qed. + Proof using Type. induction t; flatten_t. Qed. Lemma flatten_binding_list2_SmartValf {T1 T2} f g t1 t2 : flatten_binding_list2 (base_type_code:=base_type_code) (SmartValf T1 f t1) (SmartValf T2 g t2) = List.map (fun txy => existT _ (projT1 txy) (f _, g _)%core) (flatten_binding_list2 (SmartFlatTypeUnMap t1) (SmartFlatTypeUnMap t2)). - Proof. + Proof using Type. revert dependent t2; induction t1, t2; flatten_t. Qed. @@ -200,13 +200,13 @@ Section language. : flatten_binding_list (base_type_code:=base_type_code) (SmartValf T1 f t) (SmartValf T2 g t) = List.map (fun txy => existT _ (projT1 txy) (f _, g _)%core) (flatten_binding_list (SmartFlatTypeUnMap t) (SmartFlatTypeUnMap t)). - Proof. induction t; flatten_t. Qed. + Proof using Type. induction t; flatten_t. Qed. Lemma flatten_binding_list_In_eq_iff {var} T x y : (forall t a b, List.In (existT _ t (a, b)) (@flatten_binding_list base_type_code var var T x y) -> a = b) <-> x = y. - Proof. + Proof using Type. induction T; repeat first [ exfalso; assumption | progress subst @@ -231,7 +231,7 @@ Section language. Lemma flatten_binding_list_same_in_eq {var} {T x t a b} : List.In (existT _ t (a, b)) (@flatten_binding_list base_type_code var var T x x) -> a = b. - Proof. intro; eapply flatten_binding_list_In_eq_iff; eauto. Qed. + Proof using Type. intro; eapply flatten_binding_list_In_eq_iff; eauto. Qed. End language. Hint Resolve wff_SmartVarf wff_SmartVarVarf wff_SmartVarVarf_nil : wf. diff --git a/src/Reflection/WfReflective.v b/src/Reflection/WfReflective.v index d55b543cd..c54537fa2 100644 --- a/src/Reflection/WfReflective.v +++ b/src/Reflection/WfReflective.v @@ -156,7 +156,7 @@ Section language. -> @wff base_type_code op var1 var2 G t2 (eq_rect _ exprf (unnatize_exprf (List.length G) e1) _ p) (unnatize_exprf (List.length G) e2) | None => True end. - Proof. + Proof using base_type_eq_semidec_is_dec op_beq_bl. cbv zeta. destruct e1 as [ | | ? ? ? args | tx ex tC eC | ? ex ? ey ], e2 as [ | | ? ? ? args' | tx' ex' tC' eC' | ? ex' ? ey' ]; simpl; @@ -192,7 +192,7 @@ Section language. -> @wf base_type_code op var1 var2 t2 (eq_rect _ expr (unnatize_expr 0 e1) _ p) (unnatize_expr 0 e2) | None => True end. - Proof. + Proof using base_type_eq_semidec_is_dec op_beq_bl. destruct e1 as [ tx tR f ], e2 as [ tx' tR' f' ]; simpl; try solve [ exact I ]. pose proof (fun x x' @@ -223,7 +223,7 @@ Section Wf. : (forall var1 var2, to_prop (@reflect_wfT base_type_code base_type_eq_semidec_transparent op op_beq var1 var2 nil t t (e _) (e _))) -> Wf (fun var => unnatize_expr 0 (e (fun t => (nat * var t)%type))). - Proof. + Proof using base_type_eq_semidec_is_dec op_beq_bl. intros H var1 var2; specialize (H var1 var2). pose proof (@reflect_wf base_type_code base_type_eq_semidec_transparent base_type_eq_semidec_is_dec op op_beq op_beq_bl var1 var2 t t (e _) (e _)) as H'. rewrite type_eq_semidec_transparent_refl in H' by assumption; simpl in *. @@ -237,7 +237,7 @@ Section Wf. unnatize_expr 0 (e (fun t => (nat * var1 t)%type)) = e _ /\ to_prop (@reflect_wfT base_type_code base_type_eq_semidec_transparent op op_beq var1 var2 nil t t (e _) (e _))) -> Wf e. - Proof. + Proof using base_type_eq_semidec_is_dec op_beq_bl. intros H var1 var2. rewrite <- (proj1 (H var1 var2)), <- (proj1 (H var2 var2)). apply reflect_Wf_unnatize, H. diff --git a/src/Reflection/WfReflectiveGen.v b/src/Reflection/WfReflectiveGen.v index 0e484998b..23cdd8691 100644 --- a/src/Reflection/WfReflectiveGen.v +++ b/src/Reflection/WfReflectiveGen.v @@ -119,21 +119,21 @@ Section language. end end. Lemma base_type_eq_semidec_transparent_refl t : base_type_eq_semidec_transparent t t = Some eq_refl. - Proof. + Proof using base_type_eq_semidec_is_dec. clear -base_type_eq_semidec_is_dec. pose proof (base_type_eq_semidec_is_dec t t). destruct (base_type_eq_semidec_transparent t t); intros; try intuition congruence. inversion_base_type_code; reflexivity. Qed. Lemma flat_type_eq_semidec_transparent_refl t : flat_type_eq_semidec_transparent t t = Some eq_refl. - Proof. + Proof using base_type_eq_semidec_is_dec. clear -base_type_eq_semidec_is_dec. induction t as [t | | A B IHt]; simpl; try reflexivity. { rewrite base_type_eq_semidec_transparent_refl; reflexivity. } { rewrite_hyp !*; reflexivity. } Qed. Lemma type_eq_semidec_transparent_refl t : type_eq_semidec_transparent t t = Some eq_refl. - Proof. + Proof using base_type_eq_semidec_is_dec. clear -base_type_eq_semidec_is_dec. destruct t; simpl; rewrite !flat_type_eq_semidec_transparent_refl; reflexivity. Qed. @@ -189,13 +189,13 @@ Section language. Lemma duplicate_type_app ls ls' : (duplicate_type (ls ++ ls') = duplicate_type ls ++ duplicate_type ls')%list. - Proof. apply List.map_app. Qed. + Proof using Type. apply List.map_app. Qed. Lemma duplicate_type_length ls : List.length (duplicate_type ls) = List.length ls. - Proof. apply List.map_length. Qed. + Proof using Type. apply List.map_length. Qed. Lemma duplicate_type_in t v ls : List.In (existT _ (t, t) v) (duplicate_type ls) -> List.In (existT _ t v) ls. - Proof. + Proof using base_type_eq_semidec_is_dec. unfold duplicate_type; rewrite List.in_map_iff. intros [ [? ?] [? ?] ]. inversion_sigma; inversion_prod; inversion_base_type_code; subst; simpl. @@ -203,7 +203,7 @@ Section language. Qed. Lemma duplicate_type_not_in G t t0 v (H : base_type_eq_semidec_transparent t t0 = None) : ~List.In (existT _ (t, t0) v) (duplicate_type G). - Proof. + Proof using base_type_eq_semidec_is_dec. apply base_type_eq_semidec_is_dec in H. clear -H; intro H'. induction G as [|? ? IHG]; simpl in *; destruct H'; @@ -237,14 +237,14 @@ Section language. Arguments natize_interp_flat_type {var t} _ _. Lemma length_natize_interp_flat_type1 {t} (base : nat) (v1 : interp_flat_type var1 t) (v2 : interp_flat_type var2 t) : fst (natize_interp_flat_type base v1) = length (flatten_binding_list v1 v2) + base. - Proof. + Proof using Type. revert base; induction t; simpl; [ reflexivity | reflexivity | ]. intros; rewrite List.app_length, <- plus_assoc. rewrite_hyp <- ?*; reflexivity. Qed. Lemma length_natize_interp_flat_type2 {t} (base : nat) (v1 : interp_flat_type var1 t) (v2 : interp_flat_type var2 t) : fst (natize_interp_flat_type base v2) = length (flatten_binding_list v1 v2) + base. - Proof. + Proof using Type. revert base; induction t; simpl; [ reflexivity | reflexivity | ]. intros; rewrite List.app_length, <- plus_assoc. rewrite_hyp <- ?*; reflexivity. diff --git a/src/Reflection/Z/MapCastByDeBruijnInterp.v b/src/Reflection/Z/MapCastByDeBruijnInterp.v index 072563680..6e57136ab 100644 --- a/src/Reflection/Z/MapCastByDeBruijnInterp.v +++ b/src/Reflection/Z/MapCastByDeBruijnInterp.v @@ -44,7 +44,7 @@ Section language. Interp interp_op_bounds e input_bounds = b /\ @inbounds _ b (Interp interp_op e v) /\ cast_back _ _ (Interp interp_op e' v') = (Interp interp_op e v). - Proof. + Proof using Type*. apply MapCastCorrect; auto using internal_base_type_dec_lb. Qed. End language. diff --git a/src/SaturatedBaseSystem.v b/src/SaturatedBaseSystem.v index eb6262f96..cddb9797d 100644 --- a/src/SaturatedBaseSystem.v +++ b/src/SaturatedBaseSystem.v @@ -36,11 +36,11 @@ Module Columns. B.Positional.eval (fun i => weight (i+offset)) (Tuple.map sum x). Lemma eval_from_0 {n} x : @eval_from n 0 x = eval x. - Proof. cbv [eval_from eval]. auto using B.Positional.eval_wt_equiv. Qed. + Proof using Type. cbv [eval_from eval]. auto using B.Positional.eval_wt_equiv. Qed. Lemma eval_from_S {n}: forall i (inp : (list Z)^(S n)), eval_from i inp = eval_from (S i) (tl inp) + weight i * sum (hd inp). - Proof. + Proof using Type. intros; cbv [eval_from]. replace inp with (append (hd inp) (tl inp)) by (simpl in *; destruct n; destruct inp; reflexivity). @@ -66,7 +66,7 @@ Module Columns. Definition compact_digit n digit := compact_digit_cps n digit id. Lemma compact_digit_id n digit: forall {T} f, @compact_digit_cps n digit T f = f (compact_digit n digit). - Proof. + Proof using Type. induction digit; intros; cbv [compact_digit]; [reflexivity|]; simpl compact_digit_cps; break_match; [reflexivity|]. rewrite !IHdigit; reflexivity. @@ -81,7 +81,7 @@ Module Columns. Definition compact_step i c d := compact_step_cps i c d id. Lemma compact_step_id i c d T f : @compact_step_cps i c d T f = f (compact_step i c d). - Proof. cbv [compact_step_cps compact_step]; autorewrite with uncps; reflexivity. Qed. + Proof using Type. cbv [compact_step_cps compact_step]; autorewrite with uncps; reflexivity. Qed. Hint Opaque compact_step : uncps. Hint Rewrite compact_step_id : uncps. @@ -90,11 +90,11 @@ Module Columns. Definition compact {n} xs := @compact_cps n xs _ id. Lemma compact_id {n} xs {T} f : @compact_cps n xs T f = f (compact xs). - Proof. cbv [compact_cps compact]; autorewrite with uncps; reflexivity. Qed. + Proof using Type. cbv [compact_cps compact]; autorewrite with uncps; reflexivity. Qed. Lemma compact_digit_correct i (xs : list Z) : snd (compact_digit i xs) = sum xs - (weight (S i) / weight i) * (fst (compact_digit i xs)). - Proof. + Proof using add_get_carry_correct weight_0. induction xs; cbv [compact_digit]; simpl compact_digit_cps; cbv [Let_In]; repeat match goal with @@ -116,7 +116,7 @@ Module Columns. Lemma compact_invariant_holds n i starter rem inp out : compact_invariant n (S i) (fst (compact_step_cps i starter (hd inp) id)) rem (tl inp) out -> compact_invariant (S n) i starter rem inp (append (snd (compact_step_cps i starter (hd inp) id)) out). - Proof. + Proof using Type*. cbv [compact_invariant B.Positional.eval_from]; intros. repeat match goal with | _ => rewrite B.Positional.eval_step @@ -138,11 +138,11 @@ Module Columns. Qed. Lemma compact_invariant_base i rem : compact_invariant 0 i rem rem tt tt. - Proof. cbv [compact_invariant]. simpl. repeat (f_equal; try omega). Qed. + Proof using Type. cbv [compact_invariant]. simpl. repeat (f_equal; try omega). Qed. Lemma compact_invariant_end {n} start (input : (list Z)^n): compact_invariant n 0%nat start (fst (mapi_with_cps compact_step_cps start input id)) input (snd (mapi_with_cps compact_step_cps start input id)). - Proof. + Proof using Type*. autorewrite with uncps push_id. apply (mapi_with_invariant _ compact_invariant compact_invariant_holds compact_invariant_base). @@ -150,7 +150,7 @@ Module Columns. Lemma eval_compact {n} (xs : tuple (list Z) n) : B.Positional.eval weight (snd (compact xs)) + (weight n * fst (compact xs)) = eval xs. - Proof. + Proof using Type*. pose proof (compact_invariant_end 0 xs) as Hinv. cbv [compact_invariant] in Hinv. simpl in Hinv. autorewrite with zsimplify natsimplify in Hinv. @@ -164,7 +164,7 @@ Module Columns. Definition cons_to_nth {n} i x t := @cons_to_nth_cps n i x t _ id. Lemma cons_to_nth_id {n} i x t T f : @cons_to_nth_cps n i x t T f = f (cons_to_nth i x t). - Proof. + Proof using Type. cbv [cons_to_nth_cps cons_to_nth]. assert (forall xs : list (list Z), length xs = n -> length (update_nth_cps i (cons x) xs id) = n) as Hlen. @@ -178,13 +178,13 @@ Module Columns. Lemma map_sum_update_nth l : forall i x, List.map sum (update_nth i (cons x) l) = update_nth i (Z.add x) (List.map sum l). - Proof. + Proof using Type. induction l; intros; destruct i; simpl; rewrite ?IHl; reflexivity. Qed. Lemma cons_to_nth_add_to_nth n i x t : map sum (@cons_to_nth n i x t) = B.Positional.add_to_nth i x (map sum t). - Proof. + Proof using weight. cbv [B.Positional.add_to_nth B.Positional.add_to_nth_cps cons_to_nth cons_to_nth_cps on_tuple_cps]. induction n; [simpl; rewrite !update_nth_cps_correct; reflexivity|]. specialize (IHn (tl t)). autorewrite with uncps push_id in *. @@ -198,7 +198,7 @@ Module Columns. Lemma eval_cons_to_nth n i x t : (i < n)%nat -> eval (@cons_to_nth n i x t) = weight i * x + eval t. - Proof. + Proof using Type. cbv [eval]; intros. rewrite cons_to_nth_add_to_nth. auto using B.Positional.eval_add_to_nth. Qed. @@ -207,14 +207,14 @@ Module Columns. Definition nils n : (list Z)^n := Tuple.repeat nil n. Lemma map_sum_nils n : map sum (nils n) = B.Positional.zeros n. - Proof. + Proof using Type. cbv [nils B.Positional.zeros]; induction n; [reflexivity|]. change (repeat nil (S n)) with (@nil Z :: repeat nil n). rewrite map_repeat, sum_nil. reflexivity. Qed. Lemma eval_nils n : eval (nils n) = 0. - Proof. cbv [eval]. rewrite map_sum_nils, B.Positional.eval_zeros. reflexivity. Qed. Hint Rewrite eval_nils : push_basesystem_eval. + Proof using Type. cbv [eval]. rewrite map_sum_nils, B.Positional.eval_zeros. reflexivity. Qed. Hint Rewrite eval_nils : push_basesystem_eval. Definition from_associational_cps n (p:list B.limb) {T} (f:(list Z)^n -> T) := @@ -227,7 +227,7 @@ Module Columns. Definition from_associational n p := from_associational_cps n p id. Lemma from_associational_id n p T f : @from_associational_cps n p T f = f (from_associational n p). - Proof. + Proof using Type. cbv [from_associational_cps from_associational]. autorewrite with uncps push_id; reflexivity. Qed. @@ -236,7 +236,7 @@ Module Columns. Lemma eval_from_associational n p (n_nonzero:n<>0%nat): eval (from_associational n p) = B.Associational.eval p. - Proof. + Proof using weight_0 weight_nonzero. cbv [from_associational_cps from_associational]; induction p; autorewrite with uncps push_id push_basesystem_eval; [reflexivity|]. pose proof (B.Positional.weight_place_cps weight weight_0 weight_nonzero a (pred n)). diff --git a/src/Spec/Ed25519.v b/src/Spec/Ed25519.v index 4fc3afce4..2a2847a31 100644 --- a/src/Spec/Ed25519.v +++ b/src/Spec/Ed25519.v @@ -65,10 +65,16 @@ Section Ed25519. { Crypto.Util.Decidable.vm_decide. } { Crypto.Util.Decidable.vm_decide. } Admitted. - Lemma nonzero_a : a <> 0%F. Crypto.Util.Decidable.vm_decide. Qed. + Lemma nonzero_a : a <> 0%F. + Proof using Type. + Crypto.Util.Decidable.vm_decide. Qed. Lemma square_a : exists sqrt_a : Fq, (sqrt_a * sqrt_a)%F = a. + Proof using Type. + pose (@PrimeFieldTheorems.F.Decidable_square q _ ltac:(Crypto.Util.Decidable.vm_decide) a); Crypto.Util.Decidable.vm_decide. Qed. Lemma nonsquare_d : forall x : Fq, (x * x)%F <> d. + Proof using Type. + pose (@PrimeFieldTheorems.F.Decidable_square q _ ltac:(Crypto.Util.Decidable.vm_decide) d); Crypto.Util.Decidable.vm_decide. Qed. Let add := E.add(nonzero_a:=nonzero_a)(square_a:=square_a)(nonsquare_d:=nonsquare_d). @@ -81,7 +87,7 @@ Section Ed25519. (Eeq:=E.eq) (* TODO: move defn *) (l:=l) (b:=b) (n:=n) (c:=c) (Eenc:=Eenc) (Senc:=Senc) (H:=SHA512). - Proof. + Proof using Type. split; match goal with | |- ?P => match goal with [H:P|-_] => exact H end (* COQBUG: https://coq.inria.fr/bugs/show_bug.cgi?id=5366 *) diff --git a/src/Specific/FancyMachine256/Barrett.v b/src/Specific/FancyMachine256/Barrett.v index a43becf68..b87a9a0bc 100644 --- a/src/Specific/FancyMachine256/Barrett.v +++ b/src/Specific/FancyMachine256/Barrett.v @@ -91,12 +91,12 @@ Section reflected. Let assembled_result (v : Tuple.tuple fancy_machine.W 2) : fancy_machine.W := Core.Interp compiled_syntax (m, μ, fst v, snd v). Theorem sanity : result = expression ops m μ. - Proof. + Proof using Type. reflexivity. Qed. Theorem assembled_sanity : assembled_result = expression ops m μ. - Proof. + Proof using Type. reflexivity. Qed. @@ -113,12 +113,12 @@ Section reflected. (v : Tuple.tuple fancy_machine.W 2) (H6 : 0 <= decode v < b^(2 * k)). Theorem correctness : fancy_machine.decode (result v) = decode v mod m. - Proof. + Proof using H0 H1 H2 H3 H4 H5 H6 props. rewrite sanity; destruct v. apply expression_eq; assumption. Qed. Theorem assembled_correctness : fancy_machine.decode (assembled_result v) = decode v mod m. - Proof. + Proof using H0 H1 H2 H3 H4 H5 H6 props. rewrite assembled_sanity; destruct v. apply expression_eq; assumption. Qed. diff --git a/src/Specific/FancyMachine256/Montgomery.v b/src/Specific/FancyMachine256/Montgomery.v index fd0d9a57f..f052cd548 100644 --- a/src/Specific/FancyMachine256/Montgomery.v +++ b/src/Specific/FancyMachine256/Montgomery.v @@ -85,12 +85,12 @@ Section reflected. Let assembled_result (v : Tuple.tuple fancy_machine.W 2) : fancy_machine.W := Core.Interp compiled_syntax (modulus, m', fst v, snd v). Theorem sanity : result = expression ops modulus m'. - Proof. + Proof using Type. reflexivity. Qed. Theorem assembled_sanity : assembled_result = expression ops modulus m'. - Proof. + Proof using Type. reflexivity. Qed. @@ -108,7 +108,7 @@ Section reflected. (H5 : 0 <= decode v <= 2^256 * modulus). Theorem correctness : fancy_machine.decode (result v) = (decode v * R') mod modulus. - Proof. + Proof using H0 H1 H2 H3 H4 H5 props. replace m' with (fancy_machine.decode (fancy_machine.ldi m')) in H4 by (apply decode_load_immediate; trivial; exact _). @@ -116,7 +116,7 @@ Section reflected. Qed. Theorem assembled_correctness : fancy_machine.decode (assembled_result v) = (decode v * R') mod modulus. - Proof. + Proof using H0 H1 H2 H3 H4 H5 props. replace m' with (fancy_machine.decode (fancy_machine.ldi m')) in H4 by (apply decode_load_immediate; trivial; exact _). diff --git a/src/Testbit.v b/src/Testbit.v index 57362d10b..1da2c33e0 100644 --- a/src/Testbit.v +++ b/src/Testbit.v @@ -36,7 +36,7 @@ Section Testbit. Lemma testbit_spec' : forall a b us, (0 <= b < width) -> bounded limb_widths us -> (length us = length limb_widths)%nat -> Z.testbit (nth_default 0 us a) b = Z.testbit (decode base us) (Z.of_nat a * width + b). - Proof. + Proof using limb_width_pos limb_widths_uniform. repeat match goal with | |- _ => progress intros | |- _ => progress autorewrite with push_nth_default Ztestbit zsimplify in * @@ -67,7 +67,7 @@ Section Testbit. Lemma testbit_spec : forall n us, (length us = length limb_widths)%nat -> bounded limb_widths us -> testbit us n = Z.testbit (BaseSystem.decode base us) (Z.of_nat n). - Proof. + Proof using limb_width_pos limb_widths_uniform. cbv [testbit]; intros. pose proof limb_width_pos as limb_width_pos_nat. rewrite Z2Nat.inj_lt in limb_width_pos_nat by omega. diff --git a/src/Util/AdditionChainExponentiation.v b/src/Util/AdditionChainExponentiation.v index 97c3e02a3..fc082a54a 100644 --- a/src/Util/AdditionChainExponentiation.v +++ b/src/Util/AdditionChainExponentiation.v @@ -38,7 +38,7 @@ Section AddChainExp. (H:forall i, nth_default id acc i = (nth_default 0 ref i) * x) (Hl:Logic.eq (length acc) (length ref)), fold_chain id op is acc = (fold_chain 0 N.add is ref) * x. - Proof. + Proof using Type*. induction is; intros; simpl @fold_chain. { repeat break_match; specialize (H 0%nat); rewrite ?nth_default_cons, ?nth_default_cons_S in H; solve [ simpl length in *; discriminate | apply H | rewrite scalarmult_0_l; reflexivity ]. } @@ -51,7 +51,7 @@ Section AddChainExp. Qed. Lemma fold_chain_exp x is: fold_chain id op is [x] = (fold_chain 0 N.add is [1]) * x. - Proof. + Proof using Type*. eapply fold_chain_exp'; intros; trivial. destruct i; try destruct i; rewrite ?nth_default_cons_S, ?nth_default_cons, ?nth_default_nil; rewrite ?scalarmult_1_l, ?scalarmult_0_l; reflexivity. diff --git a/src/Util/IterAssocOp.v b/src/Util/IterAssocOp.v index 15b74134d..2fd7f8adc 100644 --- a/src/Util/IterAssocOp.v +++ b/src/Util/IterAssocOp.v @@ -16,7 +16,7 @@ Section IterAssocOp. Lemma nat_iter_op_plus m n a : op (nat_iter_op m a) (nat_iter_op n a) === nat_iter_op (m + n) a. - Proof. symmetry; eapply ScalarMult.scalarmult_add_l. Qed. + Proof using Type*. symmetry; eapply ScalarMult.scalarmult_add_l. Qed. Definition N_iter_op n a := match n with @@ -25,17 +25,17 @@ Section IterAssocOp. end. Lemma Pos_iter_op_succ : forall p a, Pos.iter_op op (Pos.succ p) a === op a (Pos.iter_op op p a). - Proof. + Proof using Type*. induction p; intros; simpl; rewrite ?associative, ?IHp; reflexivity. Qed. Lemma N_iter_op_succ : forall n a, N_iter_op (N.succ n) a === op a (N_iter_op n a). - Proof. + Proof using Type*. destruct n; simpl; intros; rewrite ?Pos_iter_op_succ, ?right_identity; reflexivity. Qed. Lemma N_iter_op_is_nat_iter_op : forall n a, N_iter_op n a === nat_iter_op (N.to_nat n) a. - Proof. + Proof using Type*. induction n using N.peano_ind; intros; rewrite ?N2Nat.inj_succ, ?N_iter_op_succ, ?IHn; reflexivity. Qed. @@ -68,7 +68,7 @@ Section IterAssocOp. Lemma test_and_op_inv_step : forall a s, test_and_op_inv a s -> test_and_op_inv a (test_and_op a s). - Proof. + Proof using Type*. destruct s as [i acc]. unfold test_and_op_inv, test_and_op; simpl; intro Hpre. destruct i; [ apply Hpre | ]. @@ -83,13 +83,13 @@ Section IterAssocOp. Lemma test_and_op_inv_holds : forall a i s, test_and_op_inv a s -> test_and_op_inv a (funexp (test_and_op a) s i). - Proof. + Proof using Type*. induction i; intros; auto; simpl; apply test_and_op_inv_step; auto. Qed. Lemma funexp_test_and_op_index : forall a x acc y, fst (funexp (test_and_op a) (x, acc) y) = x - y. - Proof. + Proof using Type. induction y; simpl; rewrite <- ?Minus.minus_n_O; try reflexivity. match goal with |- context[funexp ?a ?b ?c] => destruct (funexp a b c) as [i acc'] end. simpl in IHy. @@ -102,7 +102,7 @@ Section IterAssocOp. test_and_op_inv a (funexp (test_and_op a) (bound, id) bound) -> iter_op bound a === nat_iter_op (N.to_nat x) a. - Proof. + Proof using moinoid. unfold test_and_op_inv, iter_op; simpl; intros ? ? ? Hinv. rewrite Hinv, funexp_test_and_op_index, Minus.minus_diag. reflexivity. @@ -110,7 +110,7 @@ Section IterAssocOp. Lemma iter_op_correct : forall a bound, N.size_nat x <= bound -> iter_op bound a === nat_iter_op (N.to_nat x) a. - Proof. + Proof using Type*. intros. apply iter_op_termination; auto. apply test_and_op_inv_holds. diff --git a/src/Util/ListUtil.v b/src/Util/ListUtil.v index 3904b1c2e..32c6dbdf7 100644 --- a/src/Util/ListUtil.v +++ b/src/Util/ListUtil.v @@ -56,7 +56,7 @@ Module Export List. (** Results about [nth_error] *) Lemma nth_error_In l n (x : A) : nth_error l n = Some x -> In x l. - Proof. + Proof using Type. revert n. induction l as [|a l IH]; intros [|n]; simpl; try easy. - injection 1; auto. - eauto. @@ -68,7 +68,7 @@ Module Export List. Variable f : A -> B. Lemma map_cons (x:A)(l:list A) : map f (x::l) = (f x) :: (map f l). - Proof. + Proof using Type. reflexivity. Qed. End Map. @@ -90,7 +90,7 @@ Module Export List. Theorem length_zero_iff_nil (l : list A): length l = 0 <-> l=[]. - Proof. + Proof using Type. split; [now destruct l | now intros ->]. Qed. End Facts. @@ -106,13 +106,13 @@ Module Export List. Theorem repeat_length x n: length (repeat x n) = n. - Proof. + Proof using Type. induction n as [| k Hrec]; simpl; rewrite ?Hrec; reflexivity. Qed. Theorem repeat_spec n x y: In y (repeat x n) -> y=x. - Proof. + Proof using Type. induction n as [|k Hrec]; simpl; destruct 1; auto. Qed. @@ -125,16 +125,16 @@ Module Export List. Local Notation firstn := (@firstn A). Lemma firstn_nil n: firstn n [] = []. - Proof. induction n; now simpl. Qed. + Proof using Type. induction n; now simpl. Qed. Lemma firstn_cons n a l: firstn (S n) (a::l) = a :: (firstn n l). - Proof. now simpl. Qed. + Proof using Type. now simpl. Qed. Lemma firstn_all l: firstn (length l) l = l. Proof. induction l as [| ? ? H]; simpl; [reflexivity | now rewrite H]. Qed. Lemma firstn_all2 n: forall (l:list A), (length l) <= n -> firstn n l = l. - Proof. induction n as [|k iHk]. + Proof using Type. induction n as [|k iHk]. - intro. inversion 1 as [H1|?]. rewrite (length_zero_iff_nil l) in H1. subst. now simpl. - destruct l as [|x xs]; simpl. @@ -143,10 +143,10 @@ Module Export List. Qed. Lemma firstn_O l: firstn 0 l = []. - Proof. now simpl. Qed. + Proof using Type. now simpl. Qed. Lemma firstn_le_length n: forall l:list A, length (firstn n l) <= n. - Proof. + Proof using Type. induction n as [|k iHk]; simpl; [auto | destruct l as [|x xs]; simpl]. - auto with arith. - apply le_n_S, iHk. @@ -154,7 +154,7 @@ Module Export List. Lemma firstn_length_le: forall l:list A, forall n:nat, n <= length l -> length (firstn n l) = n. - Proof. induction l as [|x xs Hrec]. + Proof using Type. induction l as [|x xs Hrec]. - simpl. intros n H. apply le_n_0_eq in H. rewrite <- H. now simpl. - destruct n. * now simpl. @@ -164,7 +164,7 @@ Module Export List. Lemma firstn_app n: forall l1 l2, firstn n (l1 ++ l2) = (firstn n l1) ++ (firstn (n - length l1) l2). - Proof. induction n as [|k iHk]; intros l1 l2. + Proof using Type. induction n as [|k iHk]; intros l1 l2. - now simpl. - destruct l1 as [|x xs]. * unfold List.firstn at 2, length. now rewrite 2!app_nil_l, <- minus_n_O. @@ -174,7 +174,7 @@ Module Export List. Lemma firstn_app_2 n: forall l1 l2, firstn ((length l1) + n) (l1 ++ l2) = l1 ++ firstn n l2. - Proof. induction n as [| k iHk];intros l1 l2. + Proof using Type. induction n as [| k iHk];intros l1 l2. - unfold List.firstn at 2. rewrite <- plus_n_O, app_nil_r. rewrite firstn_app. rewrite <- minus_diag_reverse. unfold List.firstn at 2. rewrite app_nil_r. apply firstn_all. diff --git a/src/Util/NUtil.v b/src/Util/NUtil.v index 6f50642c3..1faa1da95 100644 --- a/src/Util/NUtil.v +++ b/src/Util/NUtil.v @@ -126,7 +126,7 @@ Module N. (0 <= z2 < 2 ^ (Z.of_nat sz2))%Z -> Word.combine (ZNWord sz1 z1) (ZNWord sz2 z2) = ZNWord (sz1 + sz2) (Z.lor z1 (Z.shiftl z2 (Z.of_nat sz1))). - Proof. + Proof using Type. cbv [ZNWord]; intros. rewrite !Word.NToWord_nat. match goal with |- ?a = _ => rewrite <- (Word.natToWord_wordToNat a) end. diff --git a/src/Util/NumTheoryUtil.v b/src/Util/NumTheoryUtil.v index f89eb6996..05ce4a0de 100644 --- a/src/Util/NumTheoryUtil.v +++ b/src/Util/NumTheoryUtil.v @@ -47,12 +47,12 @@ Hypothesis prime_p : prime p. Hypothesis neq_p_2 : p <> 2. (* Euler's Criterion is also provable with p = 2, but we do not need it and are lazy.*) Hypothesis x_id : x * 2 + 1 = p. -Lemma lt_1_p : 1 < p. Proof. prime_bound. Qed. -Lemma x_pos: 0 < x. Proof. prime_bound. Qed. -Lemma x_nonneg: 0 <= x. Proof. prime_bound. Qed. +Lemma lt_1_p : 1 < p. Proof using prime_p. prime_bound. Qed. +Lemma x_pos: 0 < x. Proof using prime_p x_id. prime_bound. Qed. +Lemma x_nonneg: 0 <= x. Proof using prime_p x_id. prime_bound. Qed. Lemma x_id_inv : x = (p - 1) / 2. -Proof. +Proof using x_id. intros; apply Zeq_plus_swap in x_id. replace (p - 1) with (2 * ((p - 1) / 2)) in x_id by (symmetry; apply Z_div_exact_2; [omega | rewrite <- x_id; apply Z_mod_mult]). @@ -60,19 +60,19 @@ Proof. Qed. Lemma mod_p_order : FGroup.g_order (ZPGroup p lt_1_p) = p - 1. -Proof. +Proof using Type. intros; rewrite <- phi_is_order. apply Euler.prime_phi_n_minus_1; auto. Qed. Lemma p_odd : Z.odd p = true. -Proof. +Proof using neq_p_2 prime_p. pose proof (Z.prime_odd_or_2 p prime_p). destruct H; auto. Qed. Lemma prime_pred_even : Z.even (p - 1) = true. -Proof. +Proof using neq_p_2 prime_p. intros. rewrite <- Z.odd_succ. replace (Z.succ (p - 1)) with p by ring. @@ -81,7 +81,7 @@ Qed. Lemma fermat_little: forall a (a_nonzero : a mod p <> 0), a ^ (p - 1) mod p = 1. -Proof. +Proof using prime_p. intros. assert (rel_prime a p). { apply rel_prime_mod_rev; try prime_bound. @@ -96,7 +96,7 @@ Proof. Qed. Lemma fermat_inv : forall a, a mod p <> 0 -> ((a^(p-2) mod p) * a) mod p = 1. -Proof. +Proof using prime_p. intros. pose proof (prime_ge_2 _ prime_p). rewrite Zmult_mod_idemp_l. @@ -108,7 +108,7 @@ Qed. Lemma squared_fermat_little: forall a (a_nonzero : a mod p <> 0), (a * a) ^ x mod p = 1. -Proof. +Proof using prime_p x_id. intros. rewrite <- Z.pow_2_r. rewrite <- Z.pow_mul_r by (apply x_nonneg || omega). @@ -119,7 +119,7 @@ Qed. Lemma euler_criterion_square_reverse : forall a (a_nonzero : a mod p <> 0), (exists b, b * b mod p = a) -> (a ^ x mod p = 1). -Proof. +Proof using Type*. intros ? ? a_square. destruct a_square as [b a_square]. assert (b mod p <> 0) as b_nonzero. { @@ -139,7 +139,7 @@ Lemma exists_primitive_root_power : (exists y, List.In y (FGroup.s (ZPGroup p lt_1_p)) /\ EGroup.e_order Z.eq_dec y (ZPGroup p lt_1_p) = FGroup.g_order (ZPGroup p lt_1_p) /\ (forall a (a_range : 1 <= a <= p - 1), exists j, 0 <= j <= p - 1 /\ y ^ j mod p = a)). -Proof. +Proof using Type. intros. destruct (Zp_cyclic p lt_1_p prime_p) as [y [y_in_ZPGroup y_order]]. exists y; repeat split; auto. @@ -169,7 +169,7 @@ Ltac ereplace x := match type of x with ?t => Lemma euler_criterion_square : forall a (a_range : 1 <= a <= p - 1) (pow_a_x : a ^ x mod p = 1), exists b, b * b mod p = a. -Proof. +Proof using Type*. intros. destruct (exists_primitive_root_power) as [y [in_ZPGroup_y [y_order gpow_y]]]; auto. destruct (gpow_y a a_range) as [j [j_range pow_y_j]]; clear gpow_y. @@ -206,7 +206,7 @@ Qed. Lemma euler_criterion : forall a (a_range : 1 <= a <= p - 1), (a ^ x mod p = 1) <-> exists b, b * b mod p = a. -Proof. +Proof using Type*. intros; split. { exact (euler_criterion_square _ a_range). } { @@ -218,7 +218,7 @@ Qed. Lemma euler_criterion_nonsquare : forall a (a_range : 1 <= a <= p - 1), (a ^ x mod p <> 1) <-> ~ (exists b, b * b mod p = a). -Proof. +Proof using Type*. split; intros A B; apply (euler_criterion a a_range) in B; congruence. Qed. diff --git a/src/Util/Tuple.v b/src/Util/Tuple.v index 03cb4492b..615410f2a 100644 --- a/src/Util/Tuple.v +++ b/src/Util/Tuple.v @@ -486,22 +486,22 @@ Local Ltac Equivalence_fieldwise'_t := Section Equivalence. Context {A} {R:relation A}. Global Instance Reflexive_fieldwise' {R_Reflexive:Reflexive R} {n:nat} : Reflexive (fieldwise' n R) | 5. - Proof. Equivalence_fieldwise'_t. Qed. + Proof using Type. Equivalence_fieldwise'_t. Qed. Global Instance Symmetric_fieldwise' {R_Symmetric:Symmetric R} {n:nat} : Symmetric (fieldwise' n R) | 5. - Proof. Equivalence_fieldwise'_t. Qed. + Proof using Type. Equivalence_fieldwise'_t. Qed. Global Instance Transitive_fieldwise' {R_Transitive:Transitive R} {n:nat} : Transitive (fieldwise' n R) | 5. - Proof. Equivalence_fieldwise'_t. Qed. + Proof using Type. Equivalence_fieldwise'_t. Qed. Global Instance Equivalence_fieldwise' {R_equiv:Equivalence R} {n:nat} : Equivalence (fieldwise' n R). - Proof. constructor; exact _. Qed. + Proof using Type. constructor; exact _. Qed. Global Instance Reflexive_fieldwise {R_Reflexive:Reflexive R} {n:nat} : Reflexive (fieldwise n R) | 5. - Proof. destruct n; (repeat constructor || exact _). Qed. + Proof using Type. destruct n; (repeat constructor || exact _). Qed. Global Instance Symmetric_fieldwise {R_Symmetric:Symmetric R} {n:nat} : Symmetric (fieldwise n R) | 5. - Proof. destruct n; (repeat constructor || exact _). Qed. + Proof using Type. destruct n; (repeat constructor || exact _). Qed. Global Instance Transitive_fieldwise {R_Transitive:Transitive R} {n:nat} : Transitive (fieldwise n R) | 5. - Proof. destruct n; (repeat constructor || exact _). Qed. + Proof using Type. destruct n; (repeat constructor || exact _). Qed. Global Instance Equivalence_fieldwise {R_equiv:Equivalence R} {n:nat} : Equivalence (fieldwise n R). - Proof. constructor; exact _. Qed. + Proof using Type. constructor; exact _. Qed. End Equivalence. Arguments fieldwise' {A B n} _ _ _. diff --git a/src/Util/ZUtil.v b/src/Util/ZUtil.v index b7c22c997..5e59daab9 100644 --- a/src/Util/ZUtil.v +++ b/src/Util/ZUtil.v @@ -3210,7 +3210,7 @@ for name in names: Proof. split; reflexivity. Qed. Lemma div_to_inv_modulo a x x' : x > 0 -> x * x' mod N = 1 mod N -> (a / x) == ((a - a mod x) * x'). - Proof. + Proof using Type. intros H xinv. replace (a / x) with ((a / x) * 1) by lia. change (x * x' == 1) in xinv. diff --git a/src/WeierstrassCurve/Pre.v b/src/WeierstrassCurve/Pre.v index 906a7d1d6..3b12bcfe1 100644 --- a/src/WeierstrassCurve/Pre.v +++ b/src/WeierstrassCurve/Pre.v @@ -55,7 +55,7 @@ Section Pre. Lemma add_onCurve P1 P2 (_:onCurve P1) (_:onCurve P2) : onCurve (add P1 P2). - Proof. + Proof using a b char_ge_3 eq_dec field. destruct_head' sum; destruct_head' prod; cbv [onCurve add] in *; break_match; trivial; [|]; fsatz. Qed. diff --git a/src/WeierstrassCurve/Projective.v b/src/WeierstrassCurve/Projective.v index cba28dfff..f07be0f36 100644 --- a/src/WeierstrassCurve/Projective.v +++ b/src/WeierstrassCurve/Projective.v @@ -139,7 +139,7 @@ Module Projective. W.eq (to_affine (add P Q H)) (WeierstrassCurve.W.add (to_affine P) (to_affine Q)). - Proof. + Proof using Type. destruct P as [p ?]; destruct p as [p Z1]; destruct p as [X1 Y1]. destruct Q as [q ?]; destruct q as [q Z2]; destruct q as [X2 Y2]. cbv [add opp to_affine] in *; t. |