clarified signature;
authorwenzelm
Wed, 18 Oct 2023 22:09:25 +0200
changeset 78797 fc598652fb8a
parent 78796 f34926a91fea
child 78798 200daaab2578
clarified signature; clarified modules;
src/Pure/Isar/isar_cmd.ML
src/Pure/Pure.thy
src/Pure/simplifier.ML
--- a/src/Pure/Isar/isar_cmd.ML	Wed Oct 18 16:29:24 2023 +0200
+++ b/src/Pure/Isar/isar_cmd.ML	Wed Oct 18 22:09:25 2023 +0200
@@ -17,7 +17,6 @@
   val no_translations: (xstring * string) Syntax.trrule list -> theory -> theory
   val oracle: bstring * Position.range -> Input.source -> theory -> theory
   val declaration: {syntax: bool, pervasive: bool} -> Input.source -> local_theory -> local_theory
-  val simproc_setup: Input.source Simplifier.simproc_setup -> local_theory -> local_theory
   val qed: Method.text_range option -> Toplevel.transition -> Toplevel.transition
   val terminal_proof: Method.text_range * Method.text_range option ->
     Toplevel.transition -> Toplevel.transition
@@ -134,14 +133,6 @@
   |> Context.proof_map;
 
 
-(* simprocs *)
-
-fun simproc_setup arg =
-  Context.proof_map
-    (ML_Context.expression (Input.pos_of (#proc arg))
-      (ML_Lex.read "Simplifier.simproc_setup_local " @ Simplifier.simproc_setup_ml arg));
-
-
 (* local endings *)
 
 fun local_qed m = Toplevel.proof (Proof.local_qed (m, true));
--- a/src/Pure/Pure.thy	Wed Oct 18 16:29:24 2023 +0200
+++ b/src/Pure/Pure.thy	Wed Oct 18 22:09:25 2023 +0200
@@ -333,12 +333,10 @@
 
 val _ =
   Outer_Syntax.local_theory \<^command_keyword>\<open>simproc_setup\<close> "define simproc in ML"
-    (Parse.binding --
-      (\<^keyword>\<open>(\<close> |-- Parse.enum1 "|" Parse.term --| \<^keyword>\<open>)\<close>) --
-      (\<^keyword>\<open>=\<close> |-- Parse.ML_source) --
-      Parse.opt_keyword "passive"
-    >> (fn (((name, lhss), proc), passive) =>
-        Isar_Cmd.simproc_setup {name = name, lhss = lhss, passive = passive, proc = proc}));
+    (Simplifier.simproc_setup_parser >> (fn arg =>
+      Context.proof_map
+        (ML_Context.expression (Input.pos_of (#proc arg))
+          (ML_Lex.read "Simplifier.simproc_setup_local " @ Simplifier.simproc_setup_ml arg))));
 
 in end\<close>
 
--- a/src/Pure/simplifier.ML	Wed Oct 18 16:29:24 2023 +0200
+++ b/src/Pure/simplifier.ML	Wed Oct 18 22:09:25 2023 +0200
@@ -44,11 +44,12 @@
   val define_simproc: binding -> term simproc_spec -> local_theory -> simproc * local_theory
   val define_simproc_cmd: binding -> string simproc_spec -> local_theory -> simproc * local_theory
   type 'a simproc_setup = {name: binding, lhss: string list, passive: bool, proc: 'a}
-  val simproc_setup_local:
-    (morphism -> Proof.context -> cterm -> thm option) simproc_setup -> simproc
-  val simproc_setup_global:
-    (morphism -> Proof.context -> cterm -> thm option) simproc_setup -> simproc
+  type simproc_setup_input = Input.source simproc_setup
+  type simproc_setup_internal = (morphism -> Proof.context -> cterm -> thm option) simproc_setup
+  val simproc_setup_parser: Input.source simproc_setup parser
   val simproc_setup_ml: Input.source simproc_setup -> ML_Lex.token Antiquote.antiquote list
+  val simproc_setup_local: simproc_setup_internal -> simproc
+  val simproc_setup_global: simproc_setup_internal -> simproc
   val pretty_simpset: bool -> Proof.context -> Pretty.T
   val default_mk_sym: Proof.context -> thm -> thm option
   val prems_of: Proof.context -> thm list
@@ -173,22 +174,30 @@
 (* implicit simproc_setup *)
 
 type 'a simproc_setup = {name: binding, lhss: string list, passive: bool, proc: 'a};
-
-fun simproc_setup_local {name, lhss, passive, proc} =
-  Theory.local_setup_result
-    (define_simproc_cmd name {lhss = lhss, passive = passive, proc = proc});
+type simproc_setup_input = Input.source simproc_setup;
+type simproc_setup_internal = (morphism -> Proof.context -> cterm -> thm option) simproc_setup;
 
-fun simproc_setup_global {name, lhss, passive, proc} =
-  Named_Target.global_setup_result Raw_Simplifier.transform_simproc
-    (define_simproc_cmd name {lhss = lhss, passive = passive, proc = proc});
+val simproc_setup_parser : simproc_setup_input parser =
+  Parse.binding -- (Parse.$$$ "(" |-- Parse.enum1 "|" Parse.term --| Parse.$$$ ")") --
+    (Parse.$$$ "=" |-- Parse.ML_source) -- Parse.opt_keyword "passive"
+  >> (fn (((name, lhss), proc), passive) =>
+        {name = name, lhss = lhss, passive = passive, proc = proc});
 
-fun simproc_setup_ml {name, lhss, passive, proc} =
+fun simproc_setup_ml ({name, lhss, passive, proc}: simproc_setup_input) =
   ML_Lex.read
     ("{name = " ^ ML_Syntax.make_binding (Binding.name_of name, Binding.pos_of name) ^
      ", lhss = " ^ ML_Syntax.print_strings lhss ^
      ", passive = " ^ Bool.toString passive ^
      ", proc = (") @ ML_Lex.read_source proc @ ML_Lex.read ")}";
 
+fun simproc_setup_local ({name, lhss, passive, proc}: simproc_setup_internal) =
+  Theory.local_setup_result
+    (define_simproc_cmd name {lhss = lhss, passive = passive, proc = proc});
+
+fun simproc_setup_global ({name, lhss, passive, proc}: simproc_setup_internal) =
+  Named_Target.global_setup_result Raw_Simplifier.transform_simproc
+    (define_simproc_cmd name {lhss = lhss, passive = passive, proc = proc});
+
 
 
 (** congruence rule to protect foundational terms of local definitions **)