aboutsummaryrefslogtreecommitdiff
path: root/plugins/setoid_ring
diff options
context:
space:
mode:
Diffstat (limited to 'plugins/setoid_ring')
-rw-r--r--plugins/setoid_ring/Ring_tac.v2
-rw-r--r--plugins/setoid_ring/g_newring.ml49
-rw-r--r--plugins/setoid_ring/newring.ml55
-rw-r--r--plugins/setoid_ring/newring.mli4
-rw-r--r--plugins/setoid_ring/newring_plugin.mllib3
-rw-r--r--plugins/setoid_ring/newring_plugin.mlpack2
6 files changed, 15 insertions, 60 deletions
diff --git a/plugins/setoid_ring/Ring_tac.v b/plugins/setoid_ring/Ring_tac.v
index 77863edc1e..fc02cef100 100644
--- a/plugins/setoid_ring/Ring_tac.v
+++ b/plugins/setoid_ring/Ring_tac.v
@@ -422,8 +422,6 @@ Tactic Notation (at level 0)
let G := Get_goal in
ring_lookup (PackRing Ring_simplify) [lH] rl G.
-(* MON DIEU QUE C'EST MOCHE !!!!!!!!!!!!! *)
-
Tactic Notation "ring_simplify" constr_list(rl) "in" hyp(H):=
let G := Get_goal in
let t := type of H in
diff --git a/plugins/setoid_ring/g_newring.ml4 b/plugins/setoid_ring/g_newring.ml4
index 1ebb6e6b77..f64226e334 100644
--- a/plugins/setoid_ring/g_newring.ml4
+++ b/plugins/setoid_ring/g_newring.ml4
@@ -16,7 +16,6 @@ open Newring_ast
open Newring
open Stdarg
open Constrarg
-open Pcoq.Prim
open Pcoq.Constr
open Pcoq.Tactic
@@ -61,9 +60,9 @@ VERNAC COMMAND EXTEND AddSetoidRing CLASSIFIED AS SIDEFF
let (k,set,cst,pre,post,power,sign, div) = process_ring_mods l in
add_theory id (ic t) set k cst (pre,post) power sign div]
| [ "Print" "Rings" ] => [Vernac_classifier.classify_as_query] -> [
- msg_notice (strbrk "The following ring structures have been declared:");
+ Feedback.msg_notice (strbrk "The following ring structures have been declared:");
Spmap.iter (fun fn fi ->
- msg_notice (hov 2
+ Feedback.msg_notice (hov 2
(Ppconstr.pr_id (Libnames.basename fn)++spc()++
str"with carrier "++ pr_constr fi.ring_carrier++spc()++
str"and equivalence relation "++ pr_constr fi.ring_req))
@@ -90,9 +89,9 @@ VERNAC COMMAND EXTEND AddSetoidField CLASSIFIED AS SIDEFF
let (k,set,inj,cst_tac,pre,post,power,sign,div) = process_field_mods l in
add_field_theory id (ic t) set k cst_tac inj (pre,post) power sign div]
| [ "Print" "Fields" ] => [Vernac_classifier.classify_as_query] -> [
- msg_notice (strbrk "The following field structures have been declared:");
+ Feedback.msg_notice (strbrk "The following field structures have been declared:");
Spmap.iter (fun fn fi ->
- msg_notice (hov 2
+ Feedback.msg_notice (hov 2
(Ppconstr.pr_id (Libnames.basename fn)++spc()++
str"with carrier "++ pr_constr fi.field_carrier++spc()++
str"and equivalence relation "++ pr_constr fi.field_req))
diff --git a/plugins/setoid_ring/newring.ml b/plugins/setoid_ring/newring.ml
index 7ef89b7a0e..57ef920325 100644
--- a/plugins/setoid_ring/newring.ml
+++ b/plugins/setoid_ring/newring.ml
@@ -34,15 +34,6 @@ open Proofview.Notations
(****************************************************************************)
(* controlled reduction *)
-(** ppedrot: something dubious here, we're obviously using evars the wrong
- way. FIXME! *)
-
-let mark_arg i c = mkEvar(Evar.unsafe_of_int i,[|c|])
-let unmark_arg f c =
- match destEvar c with
- | (i,[|c|]) -> f (Evar.repr i) c
- | _ -> assert false
-
type protect_flag = Eval|Prot|Rec
let tag_arg tag_rec map subs i c =
@@ -75,12 +66,10 @@ and mk_clos_app_but f_map subs f args n =
let fargs, args' = Array.chop n args in
let f' = mkApp(f,fargs) in
match f_map (global_of_constr_nofail f') with
- Some map ->
- mk_clos_deep
- (fun s' -> unmark_arg (tag_arg (mk_clos_but f_map s') map s'))
- subs
- (mkApp (mark_arg (-1) f', Array.mapi mark_arg args'))
- | None -> mk_clos_app_but f_map subs f args (n+1)
+ | Some map ->
+ let f i t = tag_arg (mk_clos_but f_map subs) map subs i t in
+ mk_red (FApp (f (-1) f', Array.mapi f args'))
+ | None -> mk_atom (mkApp (f, args))
let interp_map l t =
try Some(List.assoc_f eq_gr t l) with Not_found -> None
@@ -106,6 +95,7 @@ let protect_tac_in map id =
(****************************************************************************)
let closed_term t l =
+ let open Quote_plugin in
let l = List.map Universes.constr_of_global l in
let cs = List.fold_right Quote.ConstrSet.add l Quote.ConstrSet.empty in
if Quote.closed_under cs t then tclIDTAC else tclFAIL 0 (mt())
@@ -153,11 +143,6 @@ let ic_unsafe c = (*FIXME remove *)
let sigma = Evd.from_env env in
fst (Constrintern.interp_constr env sigma c)
-let ty c =
- let env = Global.env() in
- let sigma = Evd.from_env env in
- Typing.unsafe_type_of env sigma c
-
let decl_constant na ctx c =
let vars = Universes.universes_of_constr c in
let ctx = Universes.restrict_universe_context (Univ.ContextSet.of_context ctx) vars in
@@ -185,9 +170,6 @@ let ltac_apply (f : Value.t) (args: Tacinterp.Value.t list) =
let ist = { (Tacinterp.default_ist ()) with Tacinterp.lfun = lfun; } in
Tacinterp.eval_tactic_ist ist (ltac_lcall "F" args)
-let ltac_record flds =
- TacFun([Some(Id.of_string"proj")], ltac_lcall "proj" flds)
-
let dummy_goal env sigma =
let (gl,_,sigma) =
Goal.V82.mk_goal sigma (named_context_val env) mkProp Evd.Store.empty in
@@ -290,8 +272,6 @@ let my_reference c =
let new_ring_path =
DirPath.make (List.map Id.of_string ["Ring_tac";plugin_dir;"Coq"])
-let ltac s =
- lazy(make_kn (MPfile new_ring_path) DirPath.empty (Label.make s))
let znew_ring_path =
DirPath.make (List.map Id.of_string ["InitialRing";plugin_dir;"Coq"])
let zltac s =
@@ -318,21 +298,12 @@ let coq_mk_reqe = my_constant "mk_reqe"
let coq_semi_ring_theory = my_constant "semi_ring_theory"
let coq_mk_seqe = my_constant "mk_seqe"
-let ltac_inv_morph_gen = zltac"inv_gen_phi"
-let ltac_inv_morphZ = zltac"inv_gen_phiZ"
-let ltac_inv_morphN = zltac"inv_gen_phiN"
-let ltac_inv_morphNword = zltac"inv_gen_phiNword"
let coq_abstract = my_constant"Abstract"
let coq_comp = my_constant"Computational"
let coq_morph = my_constant"Morphism"
-(* morphism *)
-let coq_ring_morph = my_constant "ring_morph"
-let coq_semi_morph = my_constant "semi_morph"
-
(* power function *)
let ltac_inv_morph_nothing = zltac"inv_morph_nothing"
-let coq_pow_N_pow_N = my_constant "pow_N_pow_N"
(* hypothesis *)
let coq_mkhypo = my_reference "mkhypo"
@@ -546,7 +517,7 @@ let ring_equality env evd (r,add,mul,opp,req) =
let op_morph =
op_morph r add mul opp req add_m_lem mul_m_lem opp_m_lem in
Flags.if_verbose
- msg_info
+ Feedback.msg_info
(str"Using setoid \""++pr_constr req++str"\""++spc()++
str"and morphisms \""++pr_constr add_m_lem ++
str"\","++spc()++ str"\""++pr_constr mul_m_lem++
@@ -555,7 +526,7 @@ let ring_equality env evd (r,add,mul,opp,req) =
op_morph)
| None ->
(Flags.if_verbose
- msg_info
+ Feedback.msg_info
(str"Using setoid \""++pr_constr req ++str"\"" ++ spc() ++
str"and morphisms \""++pr_constr add_m_lem ++
str"\""++spc()++str"and \""++
@@ -583,18 +554,6 @@ let dest_ring env sigma th_spec =
| _ -> error "bad ring structure"
-let dest_morph env sigma m_spec =
- let m_typ = Retyping.get_type_of env sigma m_spec in
- match kind_of_term m_typ with
- App(f,[|r;zero;one;add;mul;sub;opp;req;
- c;czero;cone;cadd;cmul;csub;copp;ceqb;phi|])
- when eq_constr_nounivs f (Lazy.force coq_ring_morph) ->
- (c,czero,cone,cadd,cmul,Some csub,Some copp,ceqb,phi)
- | App(f,[|r;zero;one;add;mul;req;c;czero;cone;cadd;cmul;ceqb;phi|])
- when eq_constr_nounivs f (Lazy.force coq_semi_morph) ->
- (c,czero,cone,cadd,cmul,None,None,ceqb,phi)
- | _ -> error "bad morphism structure"
-
let reflect_coeff rkind =
(* We build an ill-typed terms on purpose... *)
match rkind with
diff --git a/plugins/setoid_ring/newring.mli b/plugins/setoid_ring/newring.mli
index 07a1ae833b..ca6aba9a0f 100644
--- a/plugins/setoid_ring/newring.mli
+++ b/plugins/setoid_ring/newring.mli
@@ -45,7 +45,7 @@ val ic : constr_expr -> Evd.evar_map * constr
val from_name : ring_info Spmap.t ref
val ring_lookup :
- Genarg.Val.t ->
+ Geninterp.Val.t ->
constr list ->
constr list -> constr -> unit Proofview.tactic
@@ -73,6 +73,6 @@ val add_field_theory :
val field_from_name : field_info Spmap.t ref
val field_lookup :
- Genarg.Val.t ->
+ Geninterp.Val.t ->
constr list ->
constr list -> constr -> unit Proofview.tactic
diff --git a/plugins/setoid_ring/newring_plugin.mllib b/plugins/setoid_ring/newring_plugin.mllib
deleted file mode 100644
index 7d6c495889..0000000000
--- a/plugins/setoid_ring/newring_plugin.mllib
+++ /dev/null
@@ -1,3 +0,0 @@
-Newring
-Newring_plugin_mod
-G_newring
diff --git a/plugins/setoid_ring/newring_plugin.mlpack b/plugins/setoid_ring/newring_plugin.mlpack
new file mode 100644
index 0000000000..23663b4090
--- /dev/null
+++ b/plugins/setoid_ring/newring_plugin.mlpack
@@ -0,0 +1,2 @@
+Newring
+G_newring
generated by cgit v1.2.3 (git 2.25.1) at 2026-04-28 17:48:49 +0000