aboutsummaryrefslogtreecommitdiff
path: root/plugins/nsatz
diff options
context:
space:
mode:
authorEmilio Jesus Gallego Arias2020-02-05 17:46:07 +0100
committerEmilio Jesus Gallego Arias2020-02-13 21:12:03 +0100
commit9193769161e1f06b371eed99dfe9e90fec9a14a6 (patch)
treee16e5f60ce6a88656ccd802d232cde6171be927d /plugins/nsatz
parenteb83c142eb33de18e3bfdd7c32ecfb797a640c38 (diff)
[build] Consolidate stdlib's .v files under a single directory.
Currently, `.v` under the `Coq.` prefix are found in both `theories` and `plugins`. Usually these two directories are merged by special loadpath code that allows double-binding of the prefix. This adds some complexity to the build and loadpath system; and in particular, it prevents from handling the `Coq.*` prefix in the simple, `-R theories Coq` standard way. We thus move all `.v` files to theories, leaving `plugins` as an OCaml-only directory, and modify accordingly the loadpath / build infrastructure. Note that in general `plugins/foo/Foo.v` was not self-contained, in the sense that it depended on files in `theories` and files in `theories` depended on it; moreover, Coq saw all these files as belonging to the same namespace so it didn't really care where they lived. This could also imply a performance gain as we now effectively traverse less directories when locating a library. See also discussion in #10003
Diffstat (limited to 'plugins/nsatz')
-rw-r--r--plugins/nsatz/Nsatz.v525
1 files changed, 0 insertions, 525 deletions
diff --git a/plugins/nsatz/Nsatz.v b/plugins/nsatz/Nsatz.v
deleted file mode 100644
index 896ee303cc..0000000000
--- a/plugins/nsatz/Nsatz.v
+++ /dev/null
@@ -1,525 +0,0 @@
-(************************************************************************)
-(* * The Coq Proof Assistant / The Coq Development Team *)
-(* v * INRIA, CNRS and contributors - Copyright 1999-2019 *)
-(* <O___,, * (see CREDITS file for the list of authors) *)
-(* \VV/ **************************************************************)
-(* // * This file is distributed under the terms of the *)
-(* * GNU Lesser General Public License Version 2.1 *)
-(* * (see LICENSE file for the text of the license) *)
-(************************************************************************)
-
-(*
- Tactic nsatz: proofs of polynomials equalities in an integral domain
-(commutative ring without zero divisor).
-
-Examples: see test-suite/success/Nsatz.v
-
-Reification is done using type classes, defined in Ncring_tac.v
-
-*)
-
-Require Import List.
-Require Import Setoid.
-Require Import BinPos.
-Require Import BinList.
-Require Import Znumtheory.
-Require Export Morphisms Setoid Bool.
-Require Export Algebra_syntax.
-Require Export Ncring.
-Require Export Ncring_initial.
-Require Export Ncring_tac.
-Require Export Integral_domain.
-Require Import DiscrR.
-Require Import ZArith.
-Require Import Lia.
-
-Declare ML Module "nsatz_plugin".
-
-Section nsatz1.
-
-Context {R:Type}`{Rid:Integral_domain R}.
-
-Lemma psos_r1b: forall x y:R, x - y == 0 -> x == y.
-intros x y H; setoid_replace x with ((x - y) + y); simpl;
- [setoid_rewrite H | idtac]; simpl. cring. cring.
-Qed.
-
-Lemma psos_r1: forall x y, x == y -> x - y == 0.
-intros x y H; simpl; setoid_rewrite H; simpl; cring.
-Qed.
-
-Lemma nsatzR_diff: forall x y:R, not (x == y) -> not (x - y == 0).
-intros.
-intro; apply H.
-simpl; setoid_replace x with ((x - y) + y). simpl.
-setoid_rewrite H0.
-simpl; cring.
-simpl. simpl; cring.
-Qed.
-
-(* adpatation du code de Benjamin aux setoides *)
-Export Ring_polynom.
-Export InitialRing.
-
-Definition PolZ := Pol Z.
-Definition PEZ := PExpr Z.
-
-Definition P0Z : PolZ := P0 (C:=Z) 0%Z.
-
-Definition PolZadd : PolZ -> PolZ -> PolZ :=
- @Padd Z 0%Z Z.add Zeq_bool.
-
-Definition PolZmul : PolZ -> PolZ -> PolZ :=
- @Pmul Z 0%Z 1%Z Z.add Z.mul Zeq_bool.
-
-Definition PolZeq := @Peq Z Zeq_bool.
-
-Definition norm :=
- @norm_aux Z 0%Z 1%Z Z.add Z.mul Z.sub Z.opp Zeq_bool.
-
-Fixpoint mult_l (la : list PEZ) (lp: list PolZ) : PolZ :=
- match la, lp with
- | a::la, p::lp => PolZadd (PolZmul (norm a) p) (mult_l la lp)
- | _, _ => P0Z
- end.
-
-Fixpoint compute_list (lla: list (list PEZ)) (lp:list PolZ) :=
- match lla with
- | List.nil => lp
- | la::lla => compute_list lla ((mult_l la lp)::lp)
- end.
-
-Definition check (lpe:list PEZ) (qe:PEZ) (certif: list (list PEZ) * list PEZ) :=
- let (lla, lq) := certif in
- let lp := List.map norm lpe in
- PolZeq (norm qe) (mult_l lq (compute_list lla lp)).
-
-
-(* Correction *)
-Definition PhiR : list R -> PolZ -> R :=
- (Pphi ring0 add mul
- (InitialRing.gen_phiZ ring0 ring1 add mul opp)).
-
-Definition PEevalR : list R -> PEZ -> R :=
- PEeval ring0 ring1 add mul sub opp
- (gen_phiZ ring0 ring1 add mul opp)
- N.to_nat pow.
-
-Lemma P0Z_correct : forall l, PhiR l P0Z = 0.
-Proof. trivial. Qed.
-
-Lemma Rext: ring_eq_ext add mul opp _==_.
-Proof.
-constructor; solve_proper.
-Qed.
-
-Lemma Rset : Setoid_Theory R _==_.
-apply ring_setoid.
-Qed.
-
-Definition Rtheory:ring_theory ring0 ring1 add mul sub opp _==_.
-apply mk_rt.
-apply ring_add_0_l.
-apply ring_add_comm.
-apply ring_add_assoc.
-apply ring_mul_1_l.
-apply cring_mul_comm.
-apply ring_mul_assoc.
-apply ring_distr_l.
-apply ring_sub_def.
-apply ring_opp_def.
-Defined.
-
-Lemma PolZadd_correct : forall P' P l,
- PhiR l (PolZadd P P') == ((PhiR l P) + (PhiR l P')).
-Proof.
-unfold PolZadd, PhiR. intros. simpl.
- refine (Padd_ok Rset Rext (Rth_ARth Rset Rext Rtheory)
- (gen_phiZ_morph Rset Rext Rtheory) _ _ _).
-Qed.
-
-Lemma PolZmul_correct : forall P P' l,
- PhiR l (PolZmul P P') == ((PhiR l P) * (PhiR l P')).
-Proof.
-unfold PolZmul, PhiR. intros.
- refine (Pmul_ok Rset Rext (Rth_ARth Rset Rext Rtheory)
- (gen_phiZ_morph Rset Rext Rtheory) _ _ _).
-Qed.
-
-Lemma R_power_theory
- : Ring_theory.power_theory ring1 mul _==_ N.to_nat pow.
-apply Ring_theory.mkpow_th. unfold pow. intros. rewrite Nnat.N2Nat.id.
-reflexivity. Qed.
-
-Lemma norm_correct :
- forall (l : list R) (pe : PEZ), PEevalR l pe == PhiR l (norm pe).
-Proof.
- intros;apply (norm_aux_spec Rset Rext (Rth_ARth Rset Rext Rtheory)
- (gen_phiZ_morph Rset Rext Rtheory) R_power_theory).
-Qed.
-
-Lemma PolZeq_correct : forall P P' l,
- PolZeq P P' = true ->
- PhiR l P == PhiR l P'.
-Proof.
- intros;apply
- (Peq_ok Rset Rext (gen_phiZ_morph Rset Rext Rtheory));trivial.
-Qed.
-
-Fixpoint Cond0 (A:Type) (Interp:A->R) (l:list A) : Prop :=
- match l with
- | List.nil => True
- | a::l => Interp a == 0 /\ Cond0 A Interp l
- end.
-
-Lemma mult_l_correct : forall l la lp,
- Cond0 PolZ (PhiR l) lp ->
- PhiR l (mult_l la lp) == 0.
-Proof.
- induction la;simpl;intros. cring.
- destruct lp;trivial. simpl. cring.
- simpl in H;destruct H.
- rewrite PolZadd_correct.
- simpl. rewrite PolZmul_correct. simpl. rewrite H.
- rewrite IHla. cring. trivial.
-Qed.
-
-Lemma compute_list_correct : forall l lla lp,
- Cond0 PolZ (PhiR l) lp ->
- Cond0 PolZ (PhiR l) (compute_list lla lp).
-Proof.
- induction lla;simpl;intros;trivial.
- apply IHlla;simpl;split;trivial.
- apply mult_l_correct;trivial.
-Qed.
-
-Lemma check_correct :
- forall l lpe qe certif,
- check lpe qe certif = true ->
- Cond0 PEZ (PEevalR l) lpe ->
- PEevalR l qe == 0.
-Proof.
- unfold check;intros l lpe qe (lla, lq) H2 H1.
- apply PolZeq_correct with (l:=l) in H2.
- rewrite norm_correct, H2.
- apply mult_l_correct.
- apply compute_list_correct.
- clear H2 lq lla qe;induction lpe;simpl;trivial.
- simpl in H1;destruct H1.
- rewrite <- norm_correct;auto.
-Qed.
-
-(* fin *)
-
-Definition R2:= 1 + 1.
-
-Fixpoint IPR p {struct p}: R :=
- match p with
- xH => ring1
- | xO xH => 1+1
- | xO p1 => R2*(IPR p1)
- | xI xH => 1+(1+1)
- | xI p1 => 1+(R2*(IPR p1))
- end.
-
-Definition IZR1 z :=
- match z with Z0 => 0
- | Zpos p => IPR p
- | Zneg p => -(IPR p)
- end.
-
-Fixpoint interpret3 t fv {struct t}: R :=
- match t with
- | (PEadd t1 t2) =>
- let v1 := interpret3 t1 fv in
- let v2 := interpret3 t2 fv in (v1 + v2)
- | (PEmul t1 t2) =>
- let v1 := interpret3 t1 fv in
- let v2 := interpret3 t2 fv in (v1 * v2)
- | (PEsub t1 t2) =>
- let v1 := interpret3 t1 fv in
- let v2 := interpret3 t2 fv in (v1 - v2)
- | (PEopp t1) =>
- let v1 := interpret3 t1 fv in (-v1)
- | (PEpow t1 t2) =>
- let v1 := interpret3 t1 fv in pow v1 (N.to_nat t2)
- | (PEc t1) => (IZR1 t1)
- | PEO => 0
- | PEI => 1
- | (PEX _ n) => List.nth (pred (Pos.to_nat n)) fv 0
- end.
-
-
-End nsatz1.
-
-Ltac equality_to_goal H x y:=
- (* eliminate trivial hypotheses, but it takes time!:
- let h := fresh "nH" in
- (assert (h:equality x y);
- [solve [cring] | clear H; clear h])
- || *) try (generalize (@psos_r1 _ _ _ _ _ _ _ _ _ _ _ x y H); clear H)
-.
-
-Ltac equalities_to_goal :=
- lazymatch goal with
- | H: (_ ?x ?y) |- _ => equality_to_goal H x y
- | H: (_ _ ?x ?y) |- _ => equality_to_goal H x y
- | H: (_ _ _ ?x ?y) |- _ => equality_to_goal H x y
- | H: (_ _ _ _ ?x ?y) |- _ => equality_to_goal H x y
-(* extension possible :-) *)
- | H: (?x == ?y) |- _ => equality_to_goal H x y
- end.
-
-(* lp est incluse dans fv. La met en tete. *)
-
-Ltac parametres_en_tete fv lp :=
- match fv with
- | (@nil _) => lp
- | (@cons _ ?x ?fv1) =>
- let res := AddFvTail x lp in
- parametres_en_tete fv1 res
- end.
-
-Ltac append1 a l :=
- match l with
- | (@nil _) => constr:(cons a l)
- | (cons ?x ?l) => let l' := append1 a l in constr:(cons x l')
- end.
-
-Ltac rev l :=
- match l with
- |(@nil _) => l
- | (cons ?x ?l) => let l' := rev l in append1 x l'
- end.
-
-Ltac nsatz_call_n info nparam p rr lp kont :=
-(* idtac "Trying power: " rr;*)
- let ll := constr:(PEc info :: PEc nparam :: PEpow p rr :: lp) in
-(* idtac "calcul...";*)
- nsatz_compute ll;
-(* idtac "done";*)
- match goal with
- | |- (?c::PEpow _ ?r::?lq0)::?lci0 = _ -> _ =>
- intros _;
- let lci := fresh "lci" in
- set (lci:=lci0);
- let lq := fresh "lq" in
- set (lq:=lq0);
- kont c rr lq lci
- end.
-
-Ltac nsatz_call radicalmax info nparam p lp kont :=
- let rec try_n n :=
- lazymatch n with
- | 0%N => fail
- | _ =>
- (let r := eval compute in (N.sub radicalmax (N.pred n)) in
- nsatz_call_n info nparam p r lp kont) ||
- let n' := eval compute in (N.pred n) in try_n n'
- end in
- try_n radicalmax.
-
-
-Ltac lterm_goal g :=
- match g with
- ?b1 == ?b2 => constr:(b1::b2::nil)
- | ?b1 == ?b2 -> ?g => let l := lterm_goal g in constr:(b1::b2::l)
- end.
-
-Ltac reify_goal l le lb:=
- match le with
- nil => idtac
- | ?e::?le1 =>
- match lb with
- ?b::?lb1 => (* idtac "b="; idtac b;*)
- let x := fresh "B" in
- set (x:= b) at 1;
- change x with (interpret3 e l);
- clear x;
- reify_goal l le1 lb1
- end
- end.
-
-Ltac get_lpol g :=
- match g with
- (interpret3 ?p _) == _ => constr:(p::nil)
- | (interpret3 ?p _) == _ -> ?g =>
- let l := get_lpol g in constr:(p::l)
- end.
-
-Ltac nsatz_generic radicalmax info lparam lvar :=
- let nparam := eval compute in (Z.of_nat (List.length lparam)) in
- match goal with
- |- ?g => let lb := lterm_goal g in
- match (match lvar with
- |(@nil _) =>
- match lparam with
- |(@nil _) =>
- let r := eval red in (list_reifyl (lterm:=lb)) in r
- |_ =>
- match eval red in (list_reifyl (lterm:=lb)) with
- |(?fv, ?le) =>
- let fv := parametres_en_tete fv lparam in
- (* we reify a second time, with the good order
- for variables *)
- let r := eval red in
- (list_reifyl (lterm:=lb) (lvar:=fv)) in r
- end
- end
- |_ =>
- let fv := parametres_en_tete lvar lparam in
- let r := eval red in (list_reifyl (lterm:=lb) (lvar:=fv)) in r
- end) with
- |(?fv, ?le) =>
- reify_goal fv le lb ;
- match goal with
- |- ?g =>
- let lp := get_lpol g in
- let lpol := eval compute in (List.rev lp) in
- intros;
-
- let SplitPolyList kont :=
- match lpol with
- | ?p2::?lp2 => kont p2 lp2
- | _ => idtac "polynomial not in the ideal"
- end in
-
- SplitPolyList ltac:(fun p lp =>
- let p21 := fresh "p21" in
- let lp21 := fresh "lp21" in
- set (p21:=p) ;
- set (lp21:=lp);
-(* idtac "nparam:"; idtac nparam; idtac "p:"; idtac p; idtac "lp:"; idtac lp; *)
- nsatz_call radicalmax info nparam p lp ltac:(fun c r lq lci =>
- let q := fresh "q" in
- set (q := PEmul c (PEpow p21 r));
- let Hg := fresh "Hg" in
- assert (Hg:check lp21 q (lci,lq) = true);
- [ (vm_compute;reflexivity) || idtac "invalid nsatz certificate"
- | let Hg2 := fresh "Hg" in
- assert (Hg2: (interpret3 q fv) == 0);
- [ (*simpl*) idtac;
- generalize (@check_correct _ _ _ _ _ _ _ _ _ _ _ fv lp21 q (lci,lq) Hg);
- let cc := fresh "H" in
- (*simpl*) idtac; intro cc; apply cc; clear cc;
- (*simpl*) idtac;
- repeat (split;[assumption|idtac]); exact I
- | (*simpl in Hg2;*) (*simpl*) idtac;
- apply Rintegral_domain_pow with (interpret3 c fv) (N.to_nat r);
- (*simpl*) idtac;
- try apply integral_domain_one_zero;
- try apply integral_domain_minus_one_zero;
- try trivial;
- try exact integral_domain_one_zero;
- try exact integral_domain_minus_one_zero
- || (solve [simpl; unfold R2, equality, eq_notation, addition, add_notation,
- one, one_notation, multiplication, mul_notation, zero, zero_notation;
- discrR || lia ])
- || ((*simpl*) idtac) || idtac "could not prove discrimination result"
- ]
- ]
-)
-)
-end end end .
-
-Ltac nsatz_default:=
- intros;
- try apply (@psos_r1b _ _ _ _ _ _ _ _ _ _ _);
- match goal with |- (@equality ?r _ _ _) =>
- repeat equalities_to_goal;
- nsatz_generic 6%N 1%Z (@nil r) (@nil r)
- end.
-
-Tactic Notation "nsatz" := nsatz_default.
-
-Tactic Notation "nsatz" "with"
- "radicalmax" ":=" constr(radicalmax)
- "strategy" ":=" constr(info)
- "parameters" ":=" constr(lparam)
- "variables" ":=" constr(lvar):=
- intros;
- try apply (@psos_r1b _ _ _ _ _ _ _ _ _ _ _);
- match goal with |- (@equality ?r _ _ _) =>
- repeat equalities_to_goal;
- nsatz_generic radicalmax info lparam lvar
- end.
-
-(* Real numbers *)
-Require Import Reals.
-Require Import RealField.
-
-Lemma Rsth : Setoid_Theory R (@eq R).
-constructor;red;intros;subst;trivial.
-Qed.
-
-Instance Rops: (@Ring_ops R 0%R 1%R Rplus Rmult Rminus Ropp (@eq R)).
-Defined.
-
-Instance Rri : (Ring (Ro:=Rops)).
-constructor;
-try (try apply Rsth;
- try (unfold respectful, Proper; unfold equality; unfold eq_notation in *;
- intros; try rewrite H; try rewrite H0; reflexivity)).
- exact Rplus_0_l. exact Rplus_comm. symmetry. apply Rplus_assoc.
- exact Rmult_1_l. exact Rmult_1_r. symmetry. apply Rmult_assoc.
- exact Rmult_plus_distr_r. intros; apply Rmult_plus_distr_l.
-exact Rplus_opp_r.
-Defined.
-
-Class can_compute_Z (z : Z) := dummy_can_compute_Z : True.
-Hint Extern 0 (can_compute_Z ?v) =>
- match isZcst v with true => exact I end : typeclass_instances.
-Instance reify_IZR z lvar {_ : can_compute_Z z} : reify (PEc z) lvar (IZR z).
-Defined.
-
-Lemma R_one_zero: 1%R <> 0%R.
-discrR.
-Qed.
-
-Instance Rcri: (Cring (Rr:=Rri)).
-red. exact Rmult_comm. Defined.
-
-Instance Rdi : (Integral_domain (Rcr:=Rcri)).
-constructor.
-exact Rmult_integral. exact R_one_zero. Defined.
-
-(* Rational numbers *)
-Require Import QArith.
-
-Instance Qops: (@Ring_ops Q 0%Q 1%Q Qplus Qmult Qminus Qopp Qeq).
-Defined.
-
-Instance Qri : (Ring (Ro:=Qops)).
-constructor.
-try apply Q_Setoid.
-apply Qplus_comp.
-apply Qmult_comp.
-apply Qminus_comp.
-apply Qopp_comp.
- exact Qplus_0_l. exact Qplus_comm. apply Qplus_assoc.
- exact Qmult_1_l. exact Qmult_1_r. apply Qmult_assoc.
- apply Qmult_plus_distr_l. intros. apply Qmult_plus_distr_r.
-reflexivity. exact Qplus_opp_r.
-Defined.
-
-Lemma Q_one_zero: not (Qeq 1%Q 0%Q).
-Proof. unfold Qeq. simpl. lia. Qed.
-
-Instance Qcri: (Cring (Rr:=Qri)).
-red. exact Qmult_comm. Defined.
-
-Instance Qdi : (Integral_domain (Rcr:=Qcri)).
-constructor.
-exact Qmult_integral. exact Q_one_zero. Defined.
-
-(* Integers *)
-Lemma Z_one_zero: 1%Z <> 0%Z.
-Proof. lia. Qed.
-
-Instance Zcri: (Cring (Rr:=Zr)).
-red. exact Z.mul_comm. Defined.
-
-Instance Zdi : (Integral_domain (Rcr:=Zcri)).
-constructor.
-exact Zmult_integral. exact Z_one_zero. Defined.
-