author | Xingyuan Zhang <xingyuanzhang@126.com> |
Sat, 13 Sep 2014 10:07:14 +0800 | |
changeset 25 | a5f5b9336007 |
parent 0 | 1378b654acde |
permissions | -rw-r--r-- |
0
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
1 |
(* Authors: Gerwin Klein and Rafal Kolanski, 2012 |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
2 |
Maintainers: Gerwin Klein <kleing at cse.unsw.edu.au> |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
3 |
Rafal Kolanski <rafal.kolanski at nicta.com.au> |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
4 |
*) |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
5 |
|
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
6 |
header "Separation Logic Tactics" |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
7 |
|
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
8 |
theory Sep_Tactics |
25 | 9 |
imports Separation_Algebra |
10 |
uses "sep_tactics.ML" |
|
0
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
11 |
begin |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
12 |
|
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
13 |
|
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
14 |
text {* A number of proof methods to assist with reasoning about separation logic. *} |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
15 |
|
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
16 |
|
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
17 |
section {* Selection (move-to-front) tactics *} |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
18 |
|
25 | 19 |
ML {* |
20 |
fun sep_select_method n ctxt = |
|
21 |
Method.SIMPLE_METHOD' (sep_select_tac ctxt n); |
|
22 |
fun sep_select_asm_method n ctxt = |
|
23 |
Method.SIMPLE_METHOD' (sep_select_asm_tac ctxt n); |
|
24 |
*} |
|
25 |
||
0
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
26 |
method_setup sep_select = {* |
25 | 27 |
Scan.lift Parse.int >> sep_select_method |
0
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
28 |
*} "Select nth separation conjunct in conclusion" |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
29 |
|
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
30 |
method_setup sep_select_asm = {* |
25 | 31 |
Scan.lift Parse.int >> sep_select_asm_method |
0
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
32 |
*} "Select nth separation conjunct in assumptions" |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
33 |
|
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
34 |
|
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
35 |
section {* Substitution *} |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
36 |
|
25 | 37 |
ML {* |
38 |
fun sep_subst_method ctxt occs thms = |
|
39 |
SIMPLE_METHOD' (sep_subst_tac ctxt occs thms); |
|
40 |
fun sep_subst_asm_method ctxt occs thms = |
|
41 |
SIMPLE_METHOD' (sep_subst_asm_tac ctxt occs thms); |
|
42 |
||
43 |
val sep_subst_parser = |
|
44 |
Args.mode "asm" |
|
45 |
-- Scan.lift (Scan.optional (Args.parens (Scan.repeat Parse.nat)) [0]) |
|
46 |
-- Attrib.thms; |
|
47 |
*} |
|
48 |
||
0
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
49 |
method_setup "sep_subst" = {* |
25 | 50 |
sep_subst_parser >> |
51 |
(fn ((asm, occs), thms) => fn ctxt => |
|
52 |
(if asm then sep_subst_asm_method else sep_subst_method) ctxt occs thms) |
|
0
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
53 |
*} |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
54 |
"single-step substitution after solving one separation logic assumption" |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
55 |
|
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
56 |
|
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
57 |
section {* Forward Reasoning *} |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
58 |
|
25 | 59 |
ML {* |
60 |
fun sep_drule_method thms ctxt = SIMPLE_METHOD' (sep_dtac ctxt thms); |
|
61 |
fun sep_frule_method thms ctxt = SIMPLE_METHOD' (sep_ftac ctxt thms); |
|
62 |
*} |
|
63 |
||
0
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
64 |
method_setup "sep_drule" = {* |
25 | 65 |
Attrib.thms >> sep_drule_method |
0
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
66 |
*} "drule after separating conjunction reordering" |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
67 |
|
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
68 |
method_setup "sep_frule" = {* |
25 | 69 |
Attrib.thms >> sep_frule_method |
0
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
70 |
*} "frule after separating conjunction reordering" |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
71 |
|
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
72 |
|
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
73 |
section {* Backward Reasoning *} |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
74 |
|
25 | 75 |
ML {* |
76 |
fun sep_rule_method thms ctxt = SIMPLE_METHOD' (sep_rtac ctxt thms) |
|
77 |
*} |
|
78 |
||
0
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
79 |
method_setup "sep_rule" = {* |
25 | 80 |
Attrib.thms >> sep_rule_method |
0
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
81 |
*} "applies rule after separating conjunction reordering" |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
82 |
|
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
83 |
|
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
84 |
section {* Cancellation of Common Conjuncts via Elimination Rules *} |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
85 |
|
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
86 |
ML {* |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
87 |
structure SepCancel_Rules = Named_Thms ( |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
88 |
val name = @{binding "sep_cancel"}; |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
89 |
val description = "sep_cancel rules"; |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
90 |
); |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
91 |
*} |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
92 |
setup SepCancel_Rules.setup |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
93 |
|
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
94 |
text {* |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
95 |
The basic @{text sep_cancel_tac} is minimal. It only eliminates |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
96 |
erule-derivable conjuncts between an assumption and the conclusion. |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
97 |
|
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
98 |
To have a more useful tactic, we augment it with more logic, to proceed as |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
99 |
follows: |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
100 |
\begin{itemize} |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
101 |
\item try discharge the goal first using @{text tac} |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
102 |
\item if that fails, invoke @{text sep_cancel_tac} |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
103 |
\item if @{text sep_cancel_tac} succeeds |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
104 |
\begin{itemize} |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
105 |
\item try to finish off with tac (but ok if that fails) |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
106 |
\item try to finish off with @{term sep_true} (but ok if that fails) |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
107 |
\end{itemize} |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
108 |
\end{itemize} |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
109 |
*} |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
110 |
|
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
111 |
ML {* |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
112 |
fun sep_cancel_smart_tac ctxt tac = |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
113 |
let fun TRY' tac = tac ORELSE' (K all_tac) |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
114 |
in |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
115 |
tac |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
116 |
ORELSE' (sep_cancel_tac ctxt tac |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
117 |
THEN' TRY' tac |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
118 |
THEN' TRY' (rtac @{thm TrueI})) |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
119 |
ORELSE' (etac @{thm sep_conj_sep_emptyE} |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
120 |
THEN' sep_cancel_tac ctxt tac |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
121 |
THEN' TRY' tac |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
122 |
THEN' TRY' (rtac @{thm TrueI})) |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
123 |
end; |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
124 |
|
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
125 |
fun sep_cancel_smart_tac_rules ctxt etacs = |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
126 |
sep_cancel_smart_tac ctxt (FIRST' ([atac] @ etacs)); |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
127 |
|
25 | 128 |
fun sep_cancel_method ctxt = |
0
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
129 |
let |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
130 |
val etacs = map etac (SepCancel_Rules.get ctxt); |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
131 |
in |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
132 |
SIMPLE_METHOD' (sep_cancel_smart_tac_rules ctxt etacs) |
25 | 133 |
end; |
134 |
||
135 |
val sep_cancel_syntax = Method.sections [ |
|
136 |
Args.add -- Args.colon >> K (I, SepCancel_Rules.add)]; |
|
137 |
*} |
|
138 |
||
139 |
method_setup sep_cancel = {* |
|
140 |
sep_cancel_syntax >> K sep_cancel_method |
|
0
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
141 |
*} "Separating conjunction conjunct cancellation" |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
142 |
|
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
143 |
text {* |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
144 |
As above, but use blast with a depth limit to figure out where cancellation |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
145 |
can be done. *} |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
146 |
|
25 | 147 |
ML {* |
148 |
fun sep_cancel_blast_method ctxt = |
|
0
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
149 |
let |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
150 |
val rules = SepCancel_Rules.get ctxt; |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
151 |
val tac = Blast.depth_tac (ctxt addIs rules) 10; |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
152 |
in |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
153 |
SIMPLE_METHOD' (sep_cancel_smart_tac ctxt tac) |
25 | 154 |
end; |
155 |
*} |
|
156 |
||
157 |
method_setup sep_cancel_blast = {* |
|
158 |
sep_cancel_syntax >> K sep_cancel_blast_method |
|
0
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
159 |
*} "Separating conjunction conjunct cancellation using blast" |
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
160 |
|
1378b654acde
initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
161 |
end |