--- 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