aboutsummaryrefslogtreecommitdiff
path: root/plugins/fourier
diff options
context:
space:
mode:
Diffstat (limited to 'plugins/fourier')
-rw-r--r--plugins/fourier/Fourier.v2
-rw-r--r--plugins/fourier/fourierR.ml59
-rw-r--r--plugins/fourier/g_fourier.ml41
3 files changed, 39 insertions, 23 deletions
diff --git a/plugins/fourier/Fourier.v b/plugins/fourier/Fourier.v
index 1d7ee93ea3..a962547131 100644
--- a/plugins/fourier/Fourier.v
+++ b/plugins/fourier/Fourier.v
@@ -13,6 +13,6 @@ Require Export DiscrR.
Require Export Fourier_util.
Declare ML Module "fourier_plugin".
-Ltac fourier := abstract (fourierz; field; discrR).
+Ltac fourier := abstract (compute [IZR IPR IPR_2] in *; fourierz; field; discrR).
Ltac fourier_eq := apply Rge_antisym; fourier.
diff --git a/plugins/fourier/fourierR.ml b/plugins/fourier/fourierR.ml
index 51bd3009ae..2af79aec9b 100644
--- a/plugins/fourier/fourierR.ml
+++ b/plugins/fourier/fourierR.ml
@@ -12,6 +12,7 @@
des inéquations et équations sont entiers. En attendant la tactique Field.
*)
+open API
open Term
open Tactics
open Names
@@ -190,6 +191,8 @@ type hineq={hname:constr; (* le nom de l'hypothèse *)
exception NoIneq
let ineq1_of_constr (h,t) =
+ let h = EConstr.Unsafe.to_constr h in
+ let t = EConstr.Unsafe.to_constr t in
match (kind_of_term t) with
| App (f,args) ->
(match kind_of_term f with
@@ -281,14 +284,17 @@ let fourier_lineq lineq1 =
(* Defined constants *)
let get = Lazy.force
-let constant = Coqlib.gen_constant "Fourier"
+let cget = get
+let eget c = EConstr.of_constr (Lazy.force c)
+let constant path s = Universes.constr_of_global @@
+ Coqlib.coq_reference "Fourier" path s
(* Standard library *)
open Coqlib
let coq_sym_eqT = lazy (build_coq_eq_sym ())
-let coq_False = lazy (build_coq_False ())
-let coq_not = lazy (build_coq_not ())
-let coq_eq = lazy (build_coq_eq ())
+let coq_False = lazy (Universes.constr_of_global @@ build_coq_False ())
+let coq_not = lazy (Universes.constr_of_global @@ build_coq_not ())
+let coq_eq = lazy (Universes.constr_of_global @@ build_coq_eq ())
(* Rdefinitions *)
let constant_real = constant ["Reals";"Rdefinitions"]
@@ -373,6 +379,7 @@ let rational_to_real x =
(* preuve que 0<n*1/d
*)
let tac_zero_inf_pos gl (n,d) =
+ let get = eget in
let tacn=ref (apply (get coq_Rlt_zero_1)) in
let tacd=ref (apply (get coq_Rlt_zero_1)) in
for _i = 1 to n - 1 do
@@ -385,6 +392,7 @@ let tac_zero_inf_pos gl (n,d) =
(* preuve que 0<=n*1/d
*)
let tac_zero_infeq_pos gl (n,d)=
+ let get = eget in
let tacn=ref (if n=0
then (apply (get coq_Rle_zero_zero))
else (apply (get coq_Rle_zero_1))) in
@@ -399,7 +407,8 @@ let tac_zero_infeq_pos gl (n,d)=
(* preuve que 0<(-n)*(1/d) => False
*)
let tac_zero_inf_false gl (n,d) =
- if n=0 then (apply (get coq_Rnot_lt0))
+ let get = eget in
+if n=0 then (apply (get coq_Rnot_lt0))
else
(Tacticals.New.tclTHEN (apply (get coq_Rle_not_lt))
(tac_zero_infeq_pos gl (-n,d)))
@@ -408,6 +417,7 @@ let tac_zero_inf_false gl (n,d) =
(* preuve que 0<=(-n)*(1/d) => False
*)
let tac_zero_infeq_false gl (n,d) =
+ let get = eget in
(Tacticals.New.tclTHEN (apply (get coq_Rlt_not_le_frac_opp))
(tac_zero_inf_pos gl (-n,d)))
;;
@@ -415,7 +425,8 @@ let tac_zero_infeq_false gl (n,d) =
let exact = exact_check;;
let tac_use h =
- let tac = exact h.hname in
+ let get = eget in
+ let tac = exact (EConstr.of_constr h.hname) in
match h.htype with
"Rlt" -> tac
|"Rle" -> tac
@@ -459,16 +470,19 @@ exception GoalDone
(* Résolution d'inéquations linéaires dans R *)
let rec fourier () =
- Proofview.Goal.nf_enter { enter = begin fun gl ->
+ Proofview.Goal.nf_enter begin fun gl ->
let concl = Proofview.Goal.concl gl in
+ let sigma = Tacmach.New.project gl in
Coqlib.check_required_library ["Coq";"fourier";"Fourier"];
- let goal = strip_outer_cast concl in
+ let goal = Termops.strip_outer_cast sigma concl in
+ let goal = EConstr.Unsafe.to_constr goal in
let fhyp=Id.of_string "new_hyp_for_fourier" in
(* si le but est une inéquation, on introduit son contraire,
et le but à prouver devient False *)
try
match (kind_of_term goal) with
App (f,args) ->
+ let get = eget in
(match (string_of_R_constr f) with
"Rlt" ->
(Tacticals.New.tclTHEN
@@ -494,18 +508,18 @@ let rec fourier () =
|_-> raise GoalDone
with GoalDone ->
(* les hypothèses *)
- let hyps = List.map (fun (h,t)-> (mkVar h,t))
+ let hyps = List.map (fun (h,t)-> (EConstr.mkVar h,t))
(list_of_sign (Proofview.Goal.hyps gl)) in
let lineq =ref [] in
List.iter (fun h -> try (lineq:=(ineq1_of_constr h)@(!lineq))
with NoIneq -> ())
hyps;
(* lineq = les inéquations découlant des hypothèses *)
- if !lineq=[] then CErrors.error "No inequalities";
+ if !lineq=[] then CErrors.user_err Pp.(str "No inequalities");
let res=fourier_lineq (!lineq) in
let tac=ref (Proofview.tclUNIT ()) in
if res=[]
- then CErrors.error "fourier failed"
+ then CErrors.user_err Pp.(str "fourier failed")
(* l'algorithme de Fourier a réussi: on va en tirer une preuve Coq *)
else (match res with
[(cres,sres,lc)]->
@@ -547,6 +561,7 @@ let rec fourier () =
!t2 |] in
let tc=rational_to_real cres in
(* puis sa preuve *)
+ let get = eget in
let tac1=ref (if h1.hstrict
then (Tacticals.New.tclTHENS (apply (get coq_Rfourier_lt))
[tac_use h1;
@@ -583,30 +598,30 @@ let rec fourier () =
then tac_zero_inf_false gl (rational_to_fraction cres)
else tac_zero_infeq_false gl (rational_to_fraction cres)
in
- tac:=(Tacticals.New.tclTHENS (cut ineq)
+ tac:=(Tacticals.New.tclTHENS (cut (EConstr.of_constr ineq))
[Tacticals.New.tclTHEN (change_concl
- (mkAppL [| get coq_not; ineq|]
- ))
+ (EConstr.of_constr (mkAppL [| cget coq_not; ineq|]
+ )))
(Tacticals.New.tclTHEN (apply (if sres then get coq_Rnot_lt_lt
else get coq_Rnot_le_le))
(Tacticals.New.tclTHENS (Equality.replace
- (mkAppL [|get coq_Rminus;!t2;!t1|]
- )
- tc)
+ (EConstr.of_constr (mkAppL [|cget coq_Rminus;!t2;!t1|]
+ ))
+ (EConstr.of_constr tc))
[tac2;
(Tacticals.New.tclTHENS
(Equality.replace
- (mkApp (get coq_Rinv,
- [|get coq_R1|]))
+ (EConstr.of_constr (mkApp (cget coq_Rinv,
+ [|cget coq_R1|])))
(get coq_R1))
(* en attendant Field, ça peut aider Ring de remplacer 1/1 par 1 ... *)
[Tacticals.New.tclORELSE
(* TODO : Ring.polynom []*) (Proofview.tclUNIT ())
(Proofview.tclUNIT ());
- Tacticals.New.pf_constr_of_global (get coq_sym_eqT) (fun symeq ->
+ Tacticals.New.pf_constr_of_global (cget coq_sym_eqT) >>= fun symeq ->
(Tacticals.New.tclTHEN (apply symeq)
- (apply (get coq_Rinv_1))))]
+ (apply (get coq_Rinv_1)))]
)
]));
@@ -619,7 +634,7 @@ let rec fourier () =
(* ((tclTHEN !tac (tclFAIL 1 (* 1 au hasard... *))) gl) *)
!tac
(* ((tclABSTRACT None !tac) gl) *)
- end }
+ end
;;
(*
diff --git a/plugins/fourier/g_fourier.ml4 b/plugins/fourier/g_fourier.ml4
index 7c665ae7b5..1960fa8355 100644
--- a/plugins/fourier/g_fourier.ml4
+++ b/plugins/fourier/g_fourier.ml4
@@ -8,6 +8,7 @@
(*i camlp4deps: "grammar/grammar.cma" i*)
+open Ltac_plugin
open FourierR
DECLARE PLUGIN "fourier_plugin"
generated by cgit v1.2.3 (git 2.25.1) at 2026-05-03 00:17:01 +0000