author | blanchet |
Fri, 31 Jan 2014 18:43:16 +0100 | |
changeset 55217 | 70035950e19b |
parent 55216 | 77953325d5f1 |
child 55218 | ed495a5088c6 |
permissions | -rw-r--r-- |
55202
824c48a539c9
renamed many Sledgehammer ML files to clarify structure
blanchet
parents:
55194
diff
changeset
|
1 |
(* Title: HOL/Tools/Sledgehammer/sledgehammer_isar_proof.ML |
50263 | 2 |
Author: Jasmin Blanchette, TU Muenchen |
3 |
Author: Steffen Juilf Smolka, TU Muenchen |
|
4 |
||
5 |
Basic data structures for representing and basic methods |
|
6 |
for dealing with Isar proof texts. |
|
7 |
*) |
|
8 |
||
55202
824c48a539c9
renamed many Sledgehammer ML files to clarify structure
blanchet
parents:
55194
diff
changeset
|
9 |
signature SLEDGEHAMMER_ISAR_PROOF = |
50259 | 10 |
sig |
51239 | 11 |
type label = string * int |
54816
10d48c2a3e32
made timeouts in Sledgehammer not be 'option's -- simplified lots of code
blanchet
parents:
54767
diff
changeset
|
12 |
type facts = label list * string list (* local and global facts *) |
50268 | 13 |
|
51178 | 14 |
datatype isar_qualifier = Show | Then |
50268 | 15 |
|
52454 | 16 |
datatype isar_proof = |
54700 | 17 |
Proof of (string * typ) list * (label * term) list * isar_step list |
51179
0d5f8812856f
split isar_step into isar_step, fix, assms; made isar_proof explicit; register fixed variables in ctxt and auto_fix terms to avoid superfluous annotations
smolkas
parents:
51178
diff
changeset
|
18 |
and isar_step = |
50268 | 19 |
Let of term * term | |
54700 | 20 |
Prove of isar_qualifier list * (string * typ) list * label * term * isar_proof list * |
54767
81290fe85890
generalize method list further to list of list (clustering preferred methods together)
blanchet
parents:
54766
diff
changeset
|
21 |
(facts * proof_method list list) |
52592
8a25b17e3d79
optimize isar-proofs by trying different proof methods
smolkas
parents:
52590
diff
changeset
|
22 |
and proof_method = |
55194 | 23 |
Metis_Method | Simp_Method | Simp_Size_Method | Auto_Method | Fastforce_Method | Force_Method | |
24 |
Arith_Method | Blast_Method | Meson_Method |
|
52592
8a25b17e3d79
optimize isar-proofs by trying different proof methods
smolkas
parents:
52590
diff
changeset
|
25 |
|
51179
0d5f8812856f
split isar_step into isar_step, fix, assms; made isar_proof explicit; register fixed variables in ctxt and auto_fix terms to avoid superfluous annotations
smolkas
parents:
51178
diff
changeset
|
26 |
val no_label : label |
0d5f8812856f
split isar_step into isar_step, fix, assms; made isar_proof explicit; register fixed variables in ctxt and auto_fix terms to avoid superfluous annotations
smolkas
parents:
51178
diff
changeset
|
27 |
val no_facts : facts |
50268 | 28 |
|
52592
8a25b17e3d79
optimize isar-proofs by trying different proof methods
smolkas
parents:
52590
diff
changeset
|
29 |
val label_ord : label * label -> order |
51998
f732a674db1b
renamed Sledgehammer functions with 'for' in their names to 'of'
blanchet
parents:
51239
diff
changeset
|
30 |
val string_of_label : label -> string |
52592
8a25b17e3d79
optimize isar-proofs by trying different proof methods
smolkas
parents:
52590
diff
changeset
|
31 |
|
51179
0d5f8812856f
split isar_step into isar_step, fix, assms; made isar_proof explicit; register fixed variables in ctxt and auto_fix terms to avoid superfluous annotations
smolkas
parents:
51178
diff
changeset
|
32 |
val steps_of_proof : isar_proof -> isar_step list |
0d5f8812856f
split isar_step into isar_step, fix, assms; made isar_proof explicit; register fixed variables in ctxt and auto_fix terms to avoid superfluous annotations
smolkas
parents:
51178
diff
changeset
|
33 |
|
0d5f8812856f
split isar_step into isar_step, fix, assms; made isar_proof explicit; register fixed variables in ctxt and auto_fix terms to avoid superfluous annotations
smolkas
parents:
51178
diff
changeset
|
34 |
val label_of_step : isar_step -> label option |
54767
81290fe85890
generalize method list further to list of list (clustering preferred methods together)
blanchet
parents:
54766
diff
changeset
|
35 |
val byline_of_step : isar_step -> (facts * proof_method list list) option |
51179
0d5f8812856f
split isar_step into isar_step, fix, assms; made isar_proof explicit; register fixed variables in ctxt and auto_fix terms to avoid superfluous annotations
smolkas
parents:
51178
diff
changeset
|
36 |
|
54765 | 37 |
val fold_isar_steps : (isar_step -> 'a -> 'a) -> isar_step list -> 'a -> 'a |
55212 | 38 |
val map_isar_steps : (isar_step -> isar_step) -> isar_proof -> isar_proof |
39 |
val add_isar_steps : isar_step list -> int -> int |
|
52454 | 40 |
|
55212 | 41 |
structure Canonical_Label_Tab : TABLE |
52556
c8357085217c
completely rewrote SH compress; added two parameters for experimentation/fine grained control
smolkas
parents:
52454
diff
changeset
|
42 |
|
c8357085217c
completely rewrote SH compress; added two parameters for experimentation/fine grained control
smolkas
parents:
52454
diff
changeset
|
43 |
val canonical_label_ord : (label * label) -> order |
55213 | 44 |
val relabel_isar_proof_canonically : isar_proof -> isar_proof |
52556
c8357085217c
completely rewrote SH compress; added two parameters for experimentation/fine grained control
smolkas
parents:
52454
diff
changeset
|
45 |
|
55213 | 46 |
val string_of_isar_proof : Proof.context -> string -> string -> int -> int -> isar_proof -> string |
54504 | 47 |
end; |
50259 | 48 |
|
55202
824c48a539c9
renamed many Sledgehammer ML files to clarify structure
blanchet
parents:
55194
diff
changeset
|
49 |
structure Sledgehammer_Isar_Proof : SLEDGEHAMMER_ISAR_PROOF = |
50259 | 50 |
struct |
51 |
||
55211 | 52 |
open ATP_Util |
53 |
open ATP_Proof |
|
54 |
open ATP_Problem_Generate |
|
55 |
open ATP_Proof_Reconstruct |
|
56 |
open Sledgehammer_Util |
|
57 |
open Sledgehammer_Reconstructor |
|
58 |
open Sledgehammer_Isar_Annotate |
|
59 |
||
50259 | 60 |
type label = string * int |
54534 | 61 |
type facts = label list * string list (* local and global facts *) |
50259 | 62 |
|
51178 | 63 |
datatype isar_qualifier = Show | Then |
50259 | 64 |
|
52454 | 65 |
datatype isar_proof = |
54700 | 66 |
Proof of (string * typ) list * (label * term) list * isar_step list |
51179
0d5f8812856f
split isar_step into isar_step, fix, assms; made isar_proof explicit; register fixed variables in ctxt and auto_fix terms to avoid superfluous annotations
smolkas
parents:
51178
diff
changeset
|
67 |
and isar_step = |
50259 | 68 |
Let of term * term | |
54700 | 69 |
Prove of isar_qualifier list * (string * typ) list * label * term * isar_proof list * |
54767
81290fe85890
generalize method list further to list of list (clustering preferred methods together)
blanchet
parents:
54766
diff
changeset
|
70 |
(facts * proof_method list list) |
52592
8a25b17e3d79
optimize isar-proofs by trying different proof methods
smolkas
parents:
52590
diff
changeset
|
71 |
and proof_method = |
55194 | 72 |
Metis_Method | Simp_Method | Simp_Size_Method | Auto_Method | Fastforce_Method | Force_Method | |
73 |
Arith_Method | Blast_Method | Meson_Method |
|
52592
8a25b17e3d79
optimize isar-proofs by trying different proof methods
smolkas
parents:
52590
diff
changeset
|
74 |
|
51179
0d5f8812856f
split isar_step into isar_step, fix, assms; made isar_proof explicit; register fixed variables in ctxt and auto_fix terms to avoid superfluous annotations
smolkas
parents:
51178
diff
changeset
|
75 |
val no_label = ("", ~1) |
0d5f8812856f
split isar_step into isar_step, fix, assms; made isar_proof explicit; register fixed variables in ctxt and auto_fix terms to avoid superfluous annotations
smolkas
parents:
51178
diff
changeset
|
76 |
val no_facts = ([],[]) |
50259 | 77 |
|
52592
8a25b17e3d79
optimize isar-proofs by trying different proof methods
smolkas
parents:
52590
diff
changeset
|
78 |
val label_ord = pairself swap #> prod_ord int_ord fast_string_ord |
52556
c8357085217c
completely rewrote SH compress; added two parameters for experimentation/fine grained control
smolkas
parents:
52454
diff
changeset
|
79 |
|
51998
f732a674db1b
renamed Sledgehammer functions with 'for' in their names to 'of'
blanchet
parents:
51239
diff
changeset
|
80 |
fun string_of_label (s, num) = s ^ string_of_int num |
50259 | 81 |
|
51179
0d5f8812856f
split isar_step into isar_step, fix, assms; made isar_proof explicit; register fixed variables in ctxt and auto_fix terms to avoid superfluous annotations
smolkas
parents:
51178
diff
changeset
|
82 |
fun steps_of_proof (Proof (_, _, steps)) = steps |
0d5f8812856f
split isar_step into isar_step, fix, assms; made isar_proof explicit; register fixed variables in ctxt and auto_fix terms to avoid superfluous annotations
smolkas
parents:
51178
diff
changeset
|
83 |
|
52454 | 84 |
fun label_of_step (Prove (_, _, l, _, _, _)) = SOME l |
51179
0d5f8812856f
split isar_step into isar_step, fix, assms; made isar_proof explicit; register fixed variables in ctxt and auto_fix terms to avoid superfluous annotations
smolkas
parents:
51178
diff
changeset
|
85 |
| label_of_step _ = NONE |
51178 | 86 |
|
52454 | 87 |
fun subproofs_of_step (Prove (_, _, _, _, subproofs, _)) = SOME subproofs |
88 |
| subproofs_of_step _ = NONE |
|
89 |
||
90 |
fun byline_of_step (Prove (_, _, _, _, _, byline)) = SOME byline |
|
51179
0d5f8812856f
split isar_step into isar_step, fix, assms; made isar_proof explicit; register fixed variables in ctxt and auto_fix terms to avoid superfluous annotations
smolkas
parents:
51178
diff
changeset
|
91 |
| byline_of_step _ = NONE |
0d5f8812856f
split isar_step into isar_step, fix, assms; made isar_proof explicit; register fixed variables in ctxt and auto_fix terms to avoid superfluous annotations
smolkas
parents:
51178
diff
changeset
|
92 |
|
55212 | 93 |
fun fold_isar_step f step = |
54767
81290fe85890
generalize method list further to list of list (clustering preferred methods together)
blanchet
parents:
54766
diff
changeset
|
94 |
fold (steps_of_proof #> fold_isar_steps f) (these (subproofs_of_step step)) #> f step |
55212 | 95 |
and fold_isar_steps f = fold (fold_isar_step f) |
52454 | 96 |
|
54765 | 97 |
fun map_isar_steps f = |
52592
8a25b17e3d79
optimize isar-proofs by trying different proof methods
smolkas
parents:
52590
diff
changeset
|
98 |
let |
55212 | 99 |
fun map_proof (Proof (fix, assms, steps)) = Proof (fix, assms, map map_step steps) |
100 |
and map_step (step as Let _) = f step |
|
101 |
| map_step (Prove (qs, xs, l, t, subproofs, by)) = |
|
102 |
f (Prove (qs, xs, l, t, map map_proof subproofs, by)) |
|
103 |
in map_proof end |
|
52592
8a25b17e3d79
optimize isar-proofs by trying different proof methods
smolkas
parents:
52590
diff
changeset
|
104 |
|
55212 | 105 |
val add_isar_steps = fold_isar_steps (fn Prove _ => Integer.add 1 | _ => I) |
52556
c8357085217c
completely rewrote SH compress; added two parameters for experimentation/fine grained control
smolkas
parents:
52454
diff
changeset
|
106 |
|
55211 | 107 |
(* canonical proof labels: 1, 2, 3, ... in post traversal order *) |
52557 | 108 |
fun canonical_label_ord (((_, i1), (_, i2)) : label * label) = int_ord (i1, i2) |
52556
c8357085217c
completely rewrote SH compress; added two parameters for experimentation/fine grained control
smolkas
parents:
52454
diff
changeset
|
109 |
|
55212 | 110 |
structure Canonical_Label_Tab = Table( |
52556
c8357085217c
completely rewrote SH compress; added two parameters for experimentation/fine grained control
smolkas
parents:
52454
diff
changeset
|
111 |
type key = label |
c8357085217c
completely rewrote SH compress; added two parameters for experimentation/fine grained control
smolkas
parents:
52454
diff
changeset
|
112 |
val ord = canonical_label_ord) |
c8357085217c
completely rewrote SH compress; added two parameters for experimentation/fine grained control
smolkas
parents:
52454
diff
changeset
|
113 |
|
55213 | 114 |
fun relabel_isar_proof_canonically proof = |
52556
c8357085217c
completely rewrote SH compress; added two parameters for experimentation/fine grained control
smolkas
parents:
52454
diff
changeset
|
115 |
let |
c8357085217c
completely rewrote SH compress; added two parameters for experimentation/fine grained control
smolkas
parents:
52454
diff
changeset
|
116 |
fun next_label l (next, subst) = |
54534 | 117 |
let val l' = ("", next) in (l', (next + 1, (l, l') :: subst)) end |
52556
c8357085217c
completely rewrote SH compress; added two parameters for experimentation/fine grained control
smolkas
parents:
52454
diff
changeset
|
118 |
|
54700 | 119 |
fun do_byline by (_, subst) = apfst (apfst (map (AList.lookup (op =) subst #> the))) by |
52556
c8357085217c
completely rewrote SH compress; added two parameters for experimentation/fine grained control
smolkas
parents:
52454
diff
changeset
|
120 |
handle Option.Option => |
55213 | 121 |
raise Fail "Sledgehammer_Isar_Proof: relabel_isar_proof_canonically" |
52556
c8357085217c
completely rewrote SH compress; added two parameters for experimentation/fine grained control
smolkas
parents:
52454
diff
changeset
|
122 |
|
c8357085217c
completely rewrote SH compress; added two parameters for experimentation/fine grained control
smolkas
parents:
52454
diff
changeset
|
123 |
fun do_assm (l, t) state = |
c8357085217c
completely rewrote SH compress; added two parameters for experimentation/fine grained control
smolkas
parents:
52454
diff
changeset
|
124 |
let |
c8357085217c
completely rewrote SH compress; added two parameters for experimentation/fine grained control
smolkas
parents:
52454
diff
changeset
|
125 |
val (l, state) = next_label l state |
c8357085217c
completely rewrote SH compress; added two parameters for experimentation/fine grained control
smolkas
parents:
52454
diff
changeset
|
126 |
in ((l, t), state) end |
c8357085217c
completely rewrote SH compress; added two parameters for experimentation/fine grained control
smolkas
parents:
52454
diff
changeset
|
127 |
|
54700 | 128 |
fun do_proof (Proof (fix, assms, steps)) state = |
52556
c8357085217c
completely rewrote SH compress; added two parameters for experimentation/fine grained control
smolkas
parents:
52454
diff
changeset
|
129 |
let |
c8357085217c
completely rewrote SH compress; added two parameters for experimentation/fine grained control
smolkas
parents:
52454
diff
changeset
|
130 |
val (assms, state) = fold_map do_assm assms state |
c8357085217c
completely rewrote SH compress; added two parameters for experimentation/fine grained control
smolkas
parents:
52454
diff
changeset
|
131 |
val (steps, state) = fold_map do_step steps state |
c8357085217c
completely rewrote SH compress; added two parameters for experimentation/fine grained control
smolkas
parents:
52454
diff
changeset
|
132 |
in |
54700 | 133 |
(Proof (fix, assms, steps), state) |
52556
c8357085217c
completely rewrote SH compress; added two parameters for experimentation/fine grained control
smolkas
parents:
52454
diff
changeset
|
134 |
end |
c8357085217c
completely rewrote SH compress; added two parameters for experimentation/fine grained control
smolkas
parents:
52454
diff
changeset
|
135 |
|
c8357085217c
completely rewrote SH compress; added two parameters for experimentation/fine grained control
smolkas
parents:
52454
diff
changeset
|
136 |
and do_step (step as Let _) state = (step, state) |
c8357085217c
completely rewrote SH compress; added two parameters for experimentation/fine grained control
smolkas
parents:
52454
diff
changeset
|
137 |
| do_step (Prove (qs, fix, l, t, subproofs, by)) state= |
54534 | 138 |
let |
139 |
val by = do_byline by state |
|
140 |
val (subproofs, state) = fold_map do_proof subproofs state |
|
141 |
val (l, state) = next_label l state |
|
142 |
in |
|
143 |
(Prove (qs, fix, l, t, subproofs, by), state) |
|
144 |
end |
|
52556
c8357085217c
completely rewrote SH compress; added two parameters for experimentation/fine grained control
smolkas
parents:
52454
diff
changeset
|
145 |
in |
c8357085217c
completely rewrote SH compress; added two parameters for experimentation/fine grained control
smolkas
parents:
52454
diff
changeset
|
146 |
fst (do_proof proof (0, [])) |
c8357085217c
completely rewrote SH compress; added two parameters for experimentation/fine grained control
smolkas
parents:
52454
diff
changeset
|
147 |
end |
c8357085217c
completely rewrote SH compress; added two parameters for experimentation/fine grained control
smolkas
parents:
52454
diff
changeset
|
148 |
|
55211 | 149 |
val indent_size = 2 |
150 |
||
55213 | 151 |
fun string_of_isar_proof ctxt type_enc lam_trans i n proof = |
55211 | 152 |
let |
153 |
(* Make sure only type constraints inserted by the type annotation code are printed. *) |
|
154 |
val ctxt = |
|
155 |
ctxt |> Config.put show_markup false |
|
156 |
|> Config.put Printer.show_type_emphasis false |
|
157 |
|> Config.put show_types false |
|
158 |
|> Config.put show_sorts false |
|
159 |
|> Config.put show_consts false |
|
160 |
||
161 |
val register_fixes = map Free #> fold Variable.auto_fixes |
|
162 |
||
55216 | 163 |
fun add_str s' = apfst (suffix s') |
55211 | 164 |
|
165 |
fun of_indent ind = replicate_string (ind * indent_size) " " |
|
166 |
fun of_moreover ind = of_indent ind ^ "moreover\n" |
|
167 |
fun of_label l = if l = no_label then "" else string_of_label l ^ ": " |
|
168 |
||
169 |
fun of_obtain qs nr = |
|
170 |
(if nr > 1 orelse (nr = 1 andalso member (op =) qs Then) then "ultimately " |
|
171 |
else if nr = 1 orelse member (op =) qs Then then "then " |
|
172 |
else "") ^ "obtain" |
|
173 |
||
174 |
fun of_show_have qs = if member (op =) qs Show then "show" else "have" |
|
175 |
fun of_thus_hence qs = if member (op =) qs Show then "thus" else "hence" |
|
176 |
||
177 |
fun of_have qs nr = |
|
178 |
if nr > 1 orelse (nr = 1 andalso member (op =) qs Then) then "ultimately " ^ of_show_have qs |
|
179 |
else if nr = 1 orelse member (op =) qs Then then of_thus_hence qs |
|
180 |
else of_show_have qs |
|
181 |
||
182 |
fun add_term term (s, ctxt) = |
|
183 |
(s ^ (term |
|
184 |
|> singleton (Syntax.uncheck_terms ctxt) |
|
55213 | 185 |
|> annotate_types_in_term ctxt |
55211 | 186 |
|> with_vanilla_print_mode (Syntax.unparse_term ctxt #> Pretty.string_of) |
187 |
|> simplify_spaces |
|
188 |
|> maybe_quote), |
|
189 |
ctxt |> Variable.auto_fixes term) |
|
190 |
||
191 |
fun by_method meth = "by " ^ |
|
192 |
(case meth of |
|
193 |
Simp_Method => "simp" |
|
194 |
| Simp_Size_Method => "(simp add: size_ne_size_imp_ne)" |
|
195 |
| Auto_Method => "auto" |
|
196 |
| Fastforce_Method => "fastforce" |
|
197 |
| Force_Method => "force" |
|
198 |
| Arith_Method => "arith" |
|
199 |
| Blast_Method => "blast" |
|
200 |
| Meson_Method => "meson" |
|
201 |
| _ => raise Fail "Sledgehammer_Isar_Print: by_method") |
|
202 |
||
203 |
fun with_facts none _ [] [] = none |
|
204 |
| with_facts _ some ls ss = some (space_implode " " (map string_of_label ls @ ss)) |
|
205 |
||
206 |
val using_facts = with_facts "" (enclose "using " " ") |
|
55214
48a347b40629
better tracing + syntactically correct 'metis' calls
blanchet
parents:
55213
diff
changeset
|
207 |
fun by_facts meth ls ss = "by " ^ with_facts meth (enclose ("(" ^ meth ^ " ") ")") ls ss |
55211 | 208 |
|
209 |
(* Local facts are always passed via "using", which affects "meson" and "metis". This is |
|
210 |
arguably stylistically superior, because it emphasises the structure of the proof. It is also |
|
211 |
more robust w.r.t. preplay: Preplay is performed before chaining of local facts with "hence" |
|
212 |
and "thus" is introduced. See also "tac_of_method" in "Sledgehammer_Isar_Preplay". *) |
|
213 |
fun of_method ls ss Metis_Method = |
|
55212 | 214 |
using_facts ls [] ^ by_facts (metis_call type_enc lam_trans) [] ss |
215 |
| of_method ls ss Meson_Method = using_facts ls [] ^ by_facts "meson" [] ss |
|
55211 | 216 |
| of_method ls ss meth = using_facts ls ss ^ by_method meth |
217 |
||
218 |
fun of_free (s, T) = |
|
219 |
maybe_quote s ^ " :: " ^ |
|
220 |
maybe_quote (simplify_spaces (with_vanilla_print_mode (Syntax.string_of_typ ctxt) T)) |
|
221 |
||
222 |
fun add_frees xs (s, ctxt) = |
|
223 |
(s ^ space_implode " and " (map of_free xs), ctxt |> register_fixes xs) |
|
224 |
||
225 |
fun add_fix _ [] = I |
|
226 |
| add_fix ind xs = |
|
55216 | 227 |
add_str (of_indent ind ^ "fix ") |
55211 | 228 |
#> add_frees xs |
55216 | 229 |
#> add_str "\n" |
55211 | 230 |
|
231 |
fun add_assm ind (l, t) = |
|
55216 | 232 |
add_str (of_indent ind ^ "assume " ^ of_label l) |
55211 | 233 |
#> add_term t |
55216 | 234 |
#> add_str "\n" |
55211 | 235 |
|
236 |
fun add_assms ind assms = fold (add_assm ind) assms |
|
237 |
||
238 |
fun of_subproof ind ctxt proof = |
|
239 |
let |
|
240 |
val ind = ind + 1 |
|
241 |
val s = of_proof ind ctxt proof |
|
242 |
val prefix = "{ " |
|
243 |
val suffix = " }" |
|
244 |
in |
|
245 |
replicate_string (ind * indent_size - size prefix) " " ^ prefix ^ |
|
246 |
String.extract (s, ind * indent_size, SOME (size s - ind * indent_size - 1)) ^ |
|
247 |
suffix ^ "\n" |
|
248 |
end |
|
249 |
and of_subproofs _ _ _ [] = "" |
|
250 |
| of_subproofs ind ctxt qs subproofs = |
|
251 |
(if member (op =) qs Then then of_moreover ind else "") ^ |
|
252 |
space_implode (of_moreover ind) (map (of_subproof ind ctxt) subproofs) |
|
253 |
and add_step_pre ind qs subproofs (s, ctxt) = |
|
254 |
(s ^ of_subproofs ind ctxt qs subproofs ^ of_indent ind, ctxt) |
|
255 |
and add_step ind (Let (t1, t2)) = |
|
55216 | 256 |
add_str (of_indent ind ^ "let ") |
257 |
#> add_term t1 #> add_str " = " #> add_term t2 |
|
258 |
#> add_str "\n" |
|
55217 | 259 |
| add_step ind (Prove (qs, xs, l, t, subproofs, ((ls, ss), (meth :: _) :: _))) = |
55211 | 260 |
add_step_pre ind qs subproofs |
261 |
#> (case xs of |
|
55216 | 262 |
[] => add_str (of_have qs (length subproofs) ^ " ") |
263 |
| _ => |
|
264 |
add_str (of_obtain qs (length subproofs) ^ " ") #> add_frees xs #> add_str " where ") |
|
55217 | 265 |
#> add_str (of_label l) |
266 |
#> add_term t |
|
267 |
#> add_str (" " ^ |
|
268 |
of_method (sort_distinct label_ord ls) (sort_distinct string_ord ss) meth ^ "\n") |
|
55211 | 269 |
and add_steps ind = fold (add_step ind) |
270 |
and of_proof ind ctxt (Proof (xs, assms, steps)) = |
|
271 |
("", ctxt) |> add_fix ind xs |> add_assms ind assms |> add_steps ind steps |> fst |
|
272 |
in |
|
273 |
(* One-step Metis proofs are pointless; better use the one-liner directly. *) |
|
274 |
(case proof of |
|
275 |
Proof ([], [], []) => "" (* degenerate case: the conjecture is "True" with Z3 *) |
|
276 |
| Proof ([], [], [Prove (_, [], _, _, [], (_, (Metis_Method :: _) :: _))]) => "" |
|
277 |
| _ => |
|
278 |
(if i <> 1 then "prefer " ^ string_of_int i ^ "\n" else "") ^ |
|
279 |
of_indent 0 ^ "proof -\n" ^ of_proof 1 ctxt proof ^ |
|
280 |
of_indent 0 ^ (if n <> 1 then "next" else "qed")) |
|
281 |
end |
|
282 |
||
54504 | 283 |
end; |