120 lines
4.3 KiB
Plaintext
120 lines
4.3 KiB
Plaintext
(*
|
|
* Copyright 2014, NICTA
|
|
*
|
|
* This software may be distributed and modified according to the terms of
|
|
* the BSD 2-Clause license. Note that NO WARRANTY is provided.
|
|
* See "LICENSE_BSD2.txt" for details.
|
|
*
|
|
* @TAG(NICTA_BSD)
|
|
*)
|
|
|
|
theory Sep_Provers
|
|
imports Sep_Rotate
|
|
begin
|
|
|
|
(* Constrained lens for sep_erule tactic *)
|
|
lemma sep_asm_eq_erule:
|
|
"(P \<and>* R) s \<Longrightarrow> (\<And>s. T s = (P \<and>* R) s) \<Longrightarrow> (T s \<Longrightarrow> (P' \<and>* R') s) \<Longrightarrow> (P' \<and>* R') s"
|
|
by (clarsimp)
|
|
|
|
lemma sep_rule:
|
|
"(\<And>s. T s \<Longrightarrow> P s) \<Longrightarrow> (T \<and>* R) s \<Longrightarrow> (P \<and>* R) s"
|
|
by (rule sep_conj_impl1)
|
|
|
|
lemma sep_erule:
|
|
"(T \<and>* R') s \<Longrightarrow> (\<And>s. T s \<Longrightarrow> P s) \<Longrightarrow> (\<And>s. R' s \<Longrightarrow> R s) \<Longrightarrow> (P \<and>* R) s"
|
|
by (rule sep_conj_impl)
|
|
|
|
(* Construct analogues to rule/drule etc, for separation logic *)
|
|
|
|
ML {*
|
|
fun sep_select ctxt = resolve_tac ctxt [@{thm sep_eq}]
|
|
fun sep_asm_select ctxt = dresolve_tac ctxt [@{thm sep_asm_eq}]
|
|
fun sep_asm_erule_select ctxt = eresolve_tac ctxt [@{thm sep_asm_eq_erule}]
|
|
|
|
fun sep_rule_tactic ctxt thms =
|
|
let val sep_rule = resolve_tac ctxt [@{thm sep_rule}]
|
|
in sep_apply_tactic ctxt sep_rule thms end
|
|
|
|
fun sep_drule_tactic ctxt thms =
|
|
let val sep_drule = dresolve_tac ctxt [rotate_prems ~1 @{thm sep_rule}]
|
|
in sep_apply_tactic ctxt sep_drule thms end
|
|
|
|
fun sep_frule_tactic ctxt thms =
|
|
let val sep_frule = forward_tac ctxt [rotate_prems ~1 @{thm sep_rule}]
|
|
in sep_apply_tactic ctxt sep_frule thms end
|
|
|
|
fun sep_erule_tactic ctxt thms =
|
|
let val sep_erule = (eresolve_tac ctxt [@{thm sep_erule}])
|
|
in sep_apply_tactic ctxt sep_erule thms end
|
|
|
|
fun sep_rule_tac tac ctxt = rotator (sep_select ctxt) tac ctxt
|
|
fun sep_drule_tac tac ctxt = rotator (sep_asm_select ctxt) tac ctxt
|
|
fun sep_erule_tac tac ctxt = rotator (sep_asm_select ctxt) tac ctxt
|
|
fun sep_erule_concl_tac tac ctxt = rotator (sep_select ctxt) tac ctxt
|
|
|
|
fun sep_erule_full_tac tac ctxt =
|
|
let val r = rotator' ctxt
|
|
in
|
|
tac |> r (sep_asm_erule_select ctxt) |> r (sep_select ctxt)
|
|
end
|
|
|
|
fun sep_erule_full_tac' tac ctxt =
|
|
let val r = rotator' ctxt
|
|
in
|
|
tac |> r (sep_select ctxt) |> r (sep_asm_erule_select ctxt)
|
|
end
|
|
|
|
fun sep_rule_comb_tac true thms ctxt = sep_rule_tac (resolve_tac ctxt thms) ctxt
|
|
| sep_rule_comb_tac false thms ctxt = sep_rule_tac (sep_rule_tactic ctxt thms) ctxt
|
|
|
|
fun sep_rule_method bool thms ctxt = SIMPLE_METHOD' (sep_rule_comb_tac bool thms ctxt)
|
|
|
|
fun sep_drule_comb_tac true thms ctxt = sep_drule_tac (dresolve_tac ctxt thms) ctxt
|
|
| sep_drule_comb_tac false thms ctxt = sep_drule_tac (sep_drule_tactic ctxt thms) ctxt
|
|
|
|
fun sep_drule_method bool thms ctxt = SIMPLE_METHOD' (sep_drule_comb_tac bool thms ctxt)
|
|
|
|
fun sep_frule_method true thms ctxt = SIMPLE_METHOD' (sep_drule_tac (forward_tac ctxt thms) ctxt)
|
|
| sep_frule_method false thms ctxt = SIMPLE_METHOD' (sep_drule_tac (sep_frule_tactic ctxt thms) ctxt)
|
|
|
|
fun sep_erule_method true thms ctxt = SIMPLE_METHOD' (sep_erule_tac (eresolve_tac ctxt thms) ctxt)
|
|
| sep_erule_method false thms ctxt = SIMPLE_METHOD' (sep_erule_tac (sep_erule_tactic ctxt thms) ctxt)
|
|
|
|
fun sep_erule_concl_method true thms ctxt =
|
|
SIMPLE_METHOD' (sep_erule_concl_tac (eresolve_tac ctxt thms) ctxt)
|
|
| sep_erule_concl_method false thms ctxt =
|
|
SIMPLE_METHOD' (sep_erule_concl_tac (sep_erule_tactic ctxt thms) ctxt)
|
|
|
|
fun sep_erule_full_method true thms ctxt =
|
|
SIMPLE_METHOD' (sep_erule_full_tac (eresolve_tac ctxt thms) ctxt)
|
|
| sep_erule_full_method false thms ctxt =
|
|
SIMPLE_METHOD' (sep_erule_full_tac (sep_erule_tactic ctxt thms) ctxt)
|
|
*}
|
|
|
|
method_setup sep_rule = {*
|
|
Scan.lift (Args.mode "direct") -- Attrib.thms >> uncurry sep_rule_method
|
|
*}
|
|
|
|
method_setup sep_drule = {*
|
|
Scan.lift (Args.mode "direct") -- Attrib.thms >> uncurry sep_drule_method
|
|
*}
|
|
|
|
method_setup sep_frule = {*
|
|
Scan.lift (Args.mode "direct") -- Attrib.thms >> uncurry sep_frule_method
|
|
*}
|
|
|
|
method_setup sep_erule = {*
|
|
Scan.lift (Args.mode "direct") -- Attrib.thms >> uncurry sep_erule_method
|
|
*}
|
|
|
|
method_setup sep_erule_concl = {*
|
|
Scan.lift (Args.mode "direct") -- Attrib.thms >> uncurry sep_erule_concl_method
|
|
*}
|
|
|
|
method_setup sep_erule_full = {*
|
|
Scan.lift (Args.mode "direct") -- Attrib.thms>> uncurry sep_erule_full_method
|
|
*}
|
|
|
|
end
|