108 lines
3.0 KiB
Plaintext
108 lines
3.0 KiB
Plaintext
(*
|
|
* Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
|
|
*
|
|
* SPDX-License-Identifier: BSD-2-Clause
|
|
*)
|
|
|
|
theory SimpStrategy
|
|
imports Main
|
|
begin
|
|
|
|
text \<open>
|
|
Support for defining alternative simplifier strategies for some parts of terms
|
|
or some premises of rewrite rules. The "name" parameter to the simp_strategy
|
|
constant is used to identify which simplification strategy should be used on
|
|
this term. Note that, although names have type nat, it is safe for them to all
|
|
be defined as 0. The important thing is that the simplifier doesn't know they're
|
|
equal.
|
|
\<close>
|
|
|
|
definition
|
|
simp_strategy :: "nat \<Rightarrow> ('a :: {}) \<Rightarrow> 'a"
|
|
where
|
|
"simp_strategy name x \<equiv> x"
|
|
|
|
text \<open>
|
|
This congruence rule forbids the simplifier from simplifying the arguments of
|
|
simp_strategy normally.
|
|
\<close>
|
|
|
|
lemma simp_strategy_cong[cong]:
|
|
"simp_strategy name x = simp_strategy name x"
|
|
by simp
|
|
|
|
text \<open>
|
|
This strategy, or rather lack thereof, can be used to forbid simplification.
|
|
\<close>
|
|
|
|
definition
|
|
NoSimp :: nat
|
|
where "NoSimp = 0"
|
|
|
|
text \<open>
|
|
This strategy indicates that a boolean subterm should be simplified only by
|
|
using explicit assumptions of the simpset.
|
|
\<close>
|
|
|
|
definition
|
|
ByAssum :: nat
|
|
where "ByAssum = 0"
|
|
|
|
lemma Eq_TrueI_ByAssum:
|
|
"P \<Longrightarrow> simp_strategy ByAssum P \<equiv> True"
|
|
by (simp add: simp_strategy_def)
|
|
|
|
simproc_setup simp_strategy_ByAssum ("simp_strategy ByAssum b") =
|
|
\<open>K (fn ss => fn ct => let
|
|
val b = Thm.dest_arg ct
|
|
val t = Thm.instantiate (TVars.empty, Vars.make [((("P",0),@{typ bool}), b)])
|
|
@{thm Eq_TrueI_ByAssum}
|
|
val prems = Raw_Simplifier.prems_of ss
|
|
in get_first (try (fn p => p RS t)) prems end)\<close>
|
|
|
|
lemma ByAssum:
|
|
"simp_strategy ByAssum P \<Longrightarrow> P"
|
|
by (simp add: simp_strategy_def)
|
|
|
|
lemma simp_ByAssum_test:
|
|
"P \<Longrightarrow> simp_strategy ByAssum P"
|
|
by simp
|
|
|
|
text \<open>
|
|
Generic framework for instantiating a simproc which simplifies within a
|
|
simp_strategy with a given simpset.
|
|
|
|
The boolean determines whether simp_strategy Name True should be rewritten
|
|
to True.
|
|
\<close>
|
|
|
|
lemma simp_strategy_Eq_True:
|
|
"simp_strategy name True \<equiv> True"
|
|
by (simp add: simp_strategy_def)
|
|
|
|
ML \<open>
|
|
fun simp_strategy_True_conv ct = case Thm.term_of ct of
|
|
(Const (@{const_name simp_strategy}, _) $ _ $ @{term True})
|
|
=> Thm.instantiate (TVars.empty, Vars.make [((("name",0), @{typ nat}), Thm.dest_arg1 ct)])
|
|
@{thm simp_strategy_Eq_True}
|
|
| _ => Conv.all_conv ct
|
|
|
|
fun new_simp_strategy thy (name : term) ss rewr_True =
|
|
let
|
|
val ctxt = Proof_Context.init_global thy;
|
|
val ss = Simplifier.make_simproc ctxt ("simp_strategy_" ^ fst (dest_Const name))
|
|
{lhss = [@{term simp_strategy} $ name $ @{term x}],
|
|
proc = (fn _ => fn ctxt' => fn ct =>
|
|
ct
|
|
|> (Conv.arg_conv (Simplifier.rewrite (put_simpset ss ctxt'))
|
|
then_conv (if rewr_True then simp_strategy_True_conv
|
|
else Conv.all_conv))
|
|
|> (fn c => if Thm.is_reflexive c then NONE else SOME c))
|
|
}
|
|
in
|
|
ss
|
|
end
|
|
\<close>
|
|
|
|
end
|