# HG changeset patch # User wenzelm # Date 1685186953 -7200 # Node ID f360ee6ce670d836f80621d4d983ac4b110d9cc9 # Parent 43154a48da69858be64a2b443da35d212c0b73d7 tuned signature; diff -r 43154a48da69 -r f360ee6ce670 src/HOL/Tools/record.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])); diff -r 43154a48da69 -r f360ee6ce670 src/Pure/simplifier.ML --- 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>\simproc\ - (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));