clarified signature;
authorwenzelm
Wed, 14 Aug 2024 15:30:29 +0200
changeset 80706 29734511c661
parent 80705 552cdee5cd43
child 80707 897c993293c5
clarified signature;
src/HOL/Tools/Sledgehammer/sledgehammer_fact.ML
src/Pure/Isar/element.ML
src/Pure/raw_simplifier.ML
src/Pure/simplifier.ML
--- a/src/HOL/Tools/Sledgehammer/sledgehammer_fact.ML	Wed Aug 14 13:51:36 2024 +0200
+++ b/src/HOL/Tools/Sledgehammer/sledgehammer_fact.ML	Wed Aug 14 15:30:29 2024 +0200
@@ -300,7 +300,7 @@
 
 (* TODO: rewrite to use nets and/or to reuse existing data structures *)
 fun clasimpset_rule_table_of ctxt =
-  let val simps = ctxt |> simpset_of |> dest_ss |> #simps in
+  let val simps = ctxt |> simpset_of |> Simplifier.dest_simps in
     if length simps >= max_simps_for_clasimpset then
       Termtab.empty
     else
--- a/src/Pure/Isar/element.ML	Wed Aug 14 13:51:36 2024 +0200
+++ b/src/Pure/Isar/element.ML	Wed Aug 14 15:30:29 2024 +0200
@@ -430,7 +430,8 @@
   | eq_morphism ctxt0 thms =
       let
         val simpset = Raw_Simplifier.simpset_of (Raw_Simplifier.init_simpset thms ctxt0);
-        val simps = map (decomp_simp ctxt0 o Thm.full_prop_of) (Raw_Simplifier.dest_simps simpset);
+        val simps =
+          map (decomp_simp ctxt0 o Thm.full_prop_of o #2) (Raw_Simplifier.dest_simps simpset);
 
         fun rewrite_term thy = Pattern.rewrite_term thy simps [];
         val rewrite =
--- a/src/Pure/raw_simplifier.ML	Wed Aug 14 13:51:36 2024 +0200
+++ b/src/Pure/raw_simplifier.ML	Wed Aug 14 15:30:29 2024 +0200
@@ -25,15 +25,6 @@
   type simpset
   val empty_ss: simpset
   val merge_ss: simpset * simpset -> simpset
-  val dest_ss: simpset ->
-   {simps: (Thm_Name.T * thm) list,
-    simprocs: (string * term list) list,
-    congs: (cong_name * thm) list,
-    weak_congs: cong_name list,
-    loopers: string list,
-    unsafe_solvers: string list,
-    safe_solvers: string list}
-  val dest_simps: simpset -> thm list
   type simproc
   val cert_simproc: theory ->
     {name: string, lhss: term list, proc: proc Morphism.entity, identifier: thm list} -> simproc
@@ -72,6 +63,16 @@
 sig
   include BASIC_RAW_SIMPLIFIER
   exception SIMPLIFIER of string * thm list
+  val dest_simps: simpset -> (Thm_Name.T * thm) list
+  val dest_congs: simpset -> (cong_name * thm) list
+  val dest_ss: simpset ->
+   {simps: (Thm_Name.T * thm) list,
+    simprocs: (string * term list) list,
+    congs: (cong_name * thm) list,
+    weak_congs: cong_name list,
+    loopers: string list,
+    unsafe_solvers: string list,
+    safe_solvers: string list}
   val add_proc: simproc -> Proof.context -> Proof.context
   val del_proc: simproc -> Proof.context -> Proof.context
   type trace_ops
@@ -288,23 +289,26 @@
 
 fun make_simpset (args1, args2) = Simpset (make_ss1 args1, make_ss2 args2);
 
+fun dest_simps (Simpset ({rules, ...}, _)) =
+  Net.entries rules
+  |> map (fn {name, thm, ...} => (name, thm));
+
+fun dest_congs (Simpset (_, {congs, ...})) = Congtab.dest (#1 congs);
+
 fun dest_procs procs =
   Net.entries procs
   |> partition_eq eq_procedure_id
   |> map (fn ps as Procedure {name, ...} :: _ => (name, map (fn Procedure {lhs, ...} => lhs) ps));
 
-fun dest_ss (Simpset ({rules, ...}, {congs, procs = simprocs, loop_tacs, solvers, ...})) =
- {simps = Net.entries rules
-    |> map (fn {name, thm, ...} => (name, thm)),
+fun dest_ss (ss as Simpset (_, {congs, procs = simprocs, loop_tacs, solvers, ...})) =
+ {simps = dest_simps ss,
   simprocs = dest_procs simprocs,
-  congs = congs |> fst |> Congtab.dest,
-  weak_congs = congs |> snd,
+  congs = dest_congs ss,
+  weak_congs = #2 congs,
   loopers = map fst loop_tacs,
   unsafe_solvers = map solver_name (#1 solvers),
   safe_solvers = map solver_name (#2 solvers)};
 
-fun dest_simps (Simpset ({rules, ...}, _)) = map #thm (Net.entries rules);
-
 
 (* empty *)
 
--- a/src/Pure/simplifier.ML	Wed Aug 14 13:51:36 2024 +0200
+++ b/src/Pure/simplifier.ML	Wed Aug 14 15:30:29 2024 +0200
@@ -28,6 +28,8 @@
 signature SIMPLIFIER =
 sig
   include BASIC_SIMPLIFIER
+  val dest_simps: simpset -> (Thm_Name.T * thm) list
+  val dest_congs: simpset -> (cong_name * thm) list
   val map_ss: (Proof.context -> Proof.context) -> Context.generic -> Context.generic
   val attrib: (thm -> Proof.context -> Proof.context) -> attribute
   val simp_add: attribute