tuned signature;
authorwenzelm
Sat, 27 May 2023 13:29:13 +0200
changeset 78115 f360ee6ce670
parent 78114 43154a48da69
child 78116 cc17e2f0f1fc
tuned signature;
src/HOL/Tools/record.ML
src/Pure/simplifier.ML
--- a/src/HOL/Tools/record.ML	Fri May 26 13:19:49 2023 +0200
+++ b/src/HOL/Tools/record.ML	Sat May 27 13:29:13 2023 +0200
@@ -1116,9 +1116,8 @@
         | _ => NONE)
       end}));
 
-val simproc_name =
-  Simplifier.check_simproc (Context.the_local_context ()) ("select_update", Position.none);
-val simproc = Simplifier.the_simproc (Context.the_local_context ()) simproc_name;
+val simproc =
+  #2 (Simplifier.check_simproc (Context.the_local_context ()) ("select_update", Position.none));
 
 fun get_upd_acc_cong_thm upd acc thy ss =
   let
@@ -1284,9 +1283,8 @@
         else NONE
       end}));
 
-val upd_simproc_name =
-  Simplifier.check_simproc (Context.the_local_context ()) ("update", Position.none);
-val upd_simproc = Simplifier.the_simproc (Context.the_local_context ()) upd_simproc_name;
+val upd_simproc =
+  #2 (Simplifier.check_simproc (Context.the_local_context ()) ("update", Position.none));
 
 end;
 
@@ -1319,8 +1317,9 @@
               | SOME thm => SOME (thm RS @{thm Eq_TrueI})))
       | _ => NONE)}));
 
-val eq_simproc_name = Simplifier.check_simproc (Context.the_local_context ()) ("eq", Position.none);
-val eq_simproc = Simplifier.the_simproc (Context.the_local_context ()) eq_simproc_name;
+val eq_simproc =
+  #2 (Simplifier.check_simproc (Context.the_local_context ()) ("eq", Position.none));
+
 
 (* split_simproc *)
 
@@ -1398,9 +1397,9 @@
         | _ => NONE)
       end}));
 
-val ex_sel_eq_simproc_name =
-  Simplifier.check_simproc (Context.the_local_context ()) ("ex_sel_eq", Position.none);
-val ex_sel_eq_simproc = Simplifier.the_simproc (Context.the_local_context ()) ex_sel_eq_simproc_name;
+val ex_sel_eq_simproc =
+  #2 (Simplifier.check_simproc (Context.the_local_context ()) ("ex_sel_eq", Position.none));
+
 val _ = Theory.setup (map_theory_simpset (fn ctxt => ctxt delsimprocs [ex_sel_eq_simproc]));
 
 
--- a/src/Pure/simplifier.ML	Fri May 26 13:19:49 2023 +0200
+++ b/src/Pure/simplifier.ML	Sat May 27 13:29:13 2023 +0200
@@ -35,7 +35,7 @@
   val simp_flip: attribute
   val cong_add: attribute
   val cong_del: attribute
-  val check_simproc: Proof.context -> xstring * Position.T -> string
+  val check_simproc: Proof.context -> xstring * Position.T -> string * simproc
   val the_simproc: Proof.context -> string -> simproc
   type 'a simproc_spec = {lhss: 'a list, proc: morphism -> Proof.context -> cterm -> thm option}
   val make_simproc: Proof.context -> string -> term simproc_spec -> simproc
@@ -109,14 +109,13 @@
 
 val get_simprocs = Simprocs.get o Context.Proof;
 
-fun check_simproc ctxt = Name_Space.check (Context.Proof ctxt) (get_simprocs ctxt) #> #1;
 val the_simproc = Name_Space.get o get_simprocs;
+fun check_simproc ctxt = Name_Space.check (Context.Proof ctxt) (get_simprocs ctxt);
 
 val _ = Theory.setup
   (ML_Antiquotation.value_embedded \<^binding>\<open>simproc\<close>
-    (Args.context -- Scan.lift Parse.embedded_position
-      >> (fn (ctxt, name) =>
-        "Simplifier.the_simproc ML_context " ^ ML_Syntax.print_string (check_simproc ctxt name))));
+    (Args.context -- Scan.lift Parse.embedded_position >> (fn (ctxt, name) =>
+      "Simplifier.the_simproc ML_context " ^ ML_Syntax.print_string (#1 (check_simproc ctxt name)))));
 
 
 (* define simprocs *)
@@ -319,7 +318,7 @@
 
 val simproc_att =
   (Args.context -- Scan.lift add_del) :|-- (fn (ctxt, decl) =>
-    Scan.repeat1 (Scan.lift (Args.named_attribute (decl o the_simproc ctxt o check_simproc ctxt))))
+    Scan.repeat1 (Scan.lift (Args.named_attribute (decl o #2 o check_simproc ctxt))))
   >> (fn atts => Thm.declaration_attribute (fn th =>
         fold (fn att => Thm.attribute_declaration (Morphism.form att) th) atts));