blanchet@39232
|
1 |
(* Title: HOL/Tools/Sledgehammer/sledgehammer_minimize.ML
|
immler@31037
|
2 |
Author: Philipp Meyer, TU Muenchen
|
blanchet@36370
|
3 |
Author: Jasmin Blanchette, TU Muenchen
|
immler@31037
|
4 |
|
blanchet@41223
|
5 |
Minimization of fact list for Metis using external provers.
|
immler@31037
|
6 |
*)
|
immler@31037
|
7 |
|
blanchet@39232
|
8 |
signature SLEDGEHAMMER_MINIMIZE =
|
boehmes@32525
|
9 |
sig
|
blanchet@47168
|
10 |
type stature = ATP_Problem_Generate.stature
|
blanchet@50929
|
11 |
type play = Sledgehammer_Reconstruct.play
|
blanchet@49265
|
12 |
type mode = Sledgehammer_Provers.mode
|
blanchet@41335
|
13 |
type params = Sledgehammer_Provers.params
|
blanchet@49265
|
14 |
type prover = Sledgehammer_Provers.prover
|
blanchet@35867
|
15 |
|
blanchet@43517
|
16 |
val binary_min_facts : int Config.T
|
blanchet@49265
|
17 |
val auto_minimize_min_facts : int Config.T
|
blanchet@49265
|
18 |
val auto_minimize_max_time : real Config.T
|
blanchet@40242
|
19 |
val minimize_facts :
|
blanchet@49414
|
20 |
(string -> thm list -> unit) -> string -> params -> bool -> int -> int
|
blanchet@52324
|
21 |
-> Proof.state -> play Lazy.lazy option
|
blanchet@52324
|
22 |
-> ((string * stature) * thm list) list
|
blanchet@47168
|
23 |
-> ((string * stature) * thm list) list option
|
blanchet@51684
|
24 |
* (play Lazy.lazy * (play -> string) * string)
|
blanchet@52324
|
25 |
val get_minimizing_prover :
|
blanchet@49414
|
26 |
Proof.context -> mode -> (string -> thm list -> unit) -> string -> prover
|
blanchet@39240
|
27 |
val run_minimize :
|
blanchet@49414
|
28 |
params -> (string -> thm list -> unit) -> int
|
blanchet@49414
|
29 |
-> (Facts.ref * Attrib.src list) list -> Proof.state -> unit
|
blanchet@35866
|
30 |
end;
|
boehmes@32525
|
31 |
|
blanchet@39232
|
32 |
structure Sledgehammer_Minimize : SLEDGEHAMMER_MINIMIZE =
|
immler@31037
|
33 |
struct
|
immler@31037
|
34 |
|
blanchet@43926
|
35 |
open ATP_Util
|
blanchet@39736
|
36 |
open ATP_Proof
|
blanchet@47148
|
37 |
open ATP_Problem_Generate
|
blanchet@52337
|
38 |
open ATP_Systems
|
blanchet@36140
|
39 |
open Sledgehammer_Util
|
blanchet@49265
|
40 |
open Sledgehammer_Fact
|
blanchet@50929
|
41 |
open Sledgehammer_Reconstruct
|
blanchet@41335
|
42 |
open Sledgehammer_Provers
|
nipkow@33492
|
43 |
|
blanchet@36370
|
44 |
(* wrapper for calling external prover *)
|
wenzelm@31236
|
45 |
|
blanchet@40242
|
46 |
fun n_facts names =
|
blanchet@38937
|
47 |
let val n = length names in
|
blanchet@40242
|
48 |
string_of_int n ^ " fact" ^ plural_s n ^
|
blanchet@38338
|
49 |
(if n > 0 then
|
blanchet@49100
|
50 |
": " ^ (names |> map fst |> sort string_ord |> space_implode " ")
|
blanchet@38338
|
51 |
else
|
blanchet@38338
|
52 |
"")
|
blanchet@38338
|
53 |
end
|
blanchet@38338
|
54 |
|
blanchet@41339
|
55 |
fun print silent f = if silent then () else Output.urgent_message (f ())
|
blanchet@41339
|
56 |
|
blanchet@43589
|
57 |
fun test_facts ({debug, verbose, overlord, provers, max_mono_iters,
|
blanchet@47129
|
58 |
max_new_mono_instances, type_enc, strict, lam_trans,
|
smolkas@52267
|
59 |
uncurried_aliases, isar_proofs, isar_compress,
|
blanchet@47237
|
60 |
preplay_timeout, ...} : params)
|
blanchet@43905
|
61 |
silent (prover : prover) timeout i n state facts =
|
wenzelm@31236
|
62 |
let
|
blanchet@41525
|
63 |
val _ =
|
blanchet@41525
|
64 |
print silent (fn () =>
|
blanchet@41525
|
65 |
"Testing " ^ n_facts (map fst facts) ^
|
blanchet@51572
|
66 |
(if verbose then
|
blanchet@51572
|
67 |
case timeout of
|
blanchet@51572
|
68 |
SOME timeout => " (timeout: " ^ string_from_time timeout ^ ")"
|
blanchet@51572
|
69 |
| _ => ""
|
blanchet@51572
|
70 |
else
|
blanchet@51572
|
71 |
"") ^ "...")
|
blanchet@42613
|
72 |
val {goal, ...} = Proof.goal state
|
blanchet@52187
|
73 |
val facts = facts |> maps (fn (n, ths) => map (pair n) ths)
|
blanchet@38346
|
74 |
val params =
|
blanchet@42915
|
75 |
{debug = debug, verbose = verbose, overlord = overlord, blocking = true,
|
blanchet@47129
|
76 |
provers = provers, type_enc = type_enc, strict = strict,
|
blanchet@47237
|
77 |
lam_trans = lam_trans, uncurried_aliases = uncurried_aliases,
|
blanchet@49336
|
78 |
learn = false, fact_filter = NONE, max_facts = SOME (length facts),
|
blanchet@49329
|
79 |
fact_thresholds = (1.01, 1.01), max_mono_iters = max_mono_iters,
|
blanchet@50933
|
80 |
max_new_mono_instances = max_new_mono_instances,
|
smolkas@52267
|
81 |
isar_proofs = isar_proofs, isar_compress = isar_compress,
|
blanchet@50933
|
82 |
slice = false, minimize = SOME false, timeout = timeout,
|
blanchet@46578
|
83 |
preplay_timeout = preplay_timeout, expect = ""}
|
blanchet@40246
|
84 |
val problem =
|
blanchet@40246
|
85 |
{state = state, goal = goal, subgoal = i, subgoal_count = n,
|
blanchet@52192
|
86 |
factss = [("", facts)]}
|
blanchet@46231
|
87 |
val result as {outcome, used_facts, run_time, ...} =
|
blanchet@46391
|
88 |
prover params (K (K (K ""))) problem
|
blanchet@36223
|
89 |
in
|
blanchet@44100
|
90 |
print silent
|
blanchet@44100
|
91 |
(fn () =>
|
blanchet@44100
|
92 |
case outcome of
|
blanchet@44100
|
93 |
SOME failure => string_for_failure failure
|
blanchet@44100
|
94 |
| NONE =>
|
blanchet@44100
|
95 |
"Found proof" ^
|
blanchet@44100
|
96 |
(if length used_facts = length facts then ""
|
blanchet@46231
|
97 |
else " with " ^ n_facts used_facts) ^
|
blanchet@46231
|
98 |
" (" ^ string_from_time run_time ^ ").");
|
blanchet@38338
|
99 |
result
|
blanchet@36223
|
100 |
end
|
wenzelm@31236
|
101 |
|
blanchet@40445
|
102 |
(* minimalization of facts *)
|
wenzelm@31236
|
103 |
|
blanchet@46233
|
104 |
(* Give the external prover some slack. The ATP gets further slack because the
|
blanchet@46233
|
105 |
Sledgehammer preprocessing time is included in the estimate below but isn't
|
blanchet@46233
|
106 |
part of the timeout. *)
|
blanchet@46233
|
107 |
val slack_msecs = 200
|
blanchet@46233
|
108 |
|
blanchet@51572
|
109 |
fun new_timeout NONE _ = NONE
|
blanchet@51572
|
110 |
| new_timeout (SOME timeout) run_time =
|
blanchet@51572
|
111 |
Int.min (Time.toMilliseconds timeout,
|
blanchet@51572
|
112 |
Time.toMilliseconds run_time + slack_msecs)
|
blanchet@51572
|
113 |
|> Time.fromMilliseconds |> SOME
|
blanchet@46233
|
114 |
|
blanchet@46228
|
115 |
(* The linear algorithm usually outperforms the binary algorithm when over 60%
|
blanchet@46228
|
116 |
of the facts are actually needed. The binary algorithm is much more
|
blanchet@46228
|
117 |
appropriate for provers that cannot return the list of used facts and hence
|
blanchet@46228
|
118 |
returns all facts as used. Since we cannot know in advance how many facts are
|
blanchet@46228
|
119 |
actually needed, we heuristically set the threshold to 10 facts. *)
|
blanchet@43517
|
120 |
val binary_min_facts =
|
blanchet@43517
|
121 |
Attrib.setup_config_int @{binding sledgehammer_minimize_binary_min_facts}
|
blanchet@46229
|
122 |
(K 20)
|
blanchet@49265
|
123 |
val auto_minimize_min_facts =
|
blanchet@49265
|
124 |
Attrib.setup_config_int @{binding sledgehammer_auto_minimize_min_facts}
|
blanchet@49265
|
125 |
(fn generic => Config.get_generic generic binary_min_facts)
|
blanchet@49265
|
126 |
val auto_minimize_max_time =
|
blanchet@49265
|
127 |
Attrib.setup_config_real @{binding sledgehammer_auto_minimize_max_time}
|
blanchet@49265
|
128 |
(K 5.0)
|
blanchet@41223
|
129 |
|
blanchet@46229
|
130 |
fun linear_minimize test timeout result xs =
|
blanchet@46229
|
131 |
let
|
blanchet@46229
|
132 |
fun min _ [] p = p
|
blanchet@46229
|
133 |
| min timeout (x :: xs) (seen, result) =
|
blanchet@46229
|
134 |
case test timeout (xs @ seen) of
|
blanchet@46233
|
135 |
result as {outcome = NONE, used_facts, run_time, ...}
|
blanchet@46233
|
136 |
: prover_result =>
|
blanchet@49813
|
137 |
min (new_timeout timeout run_time)
|
blanchet@49813
|
138 |
(filter_used_facts true used_facts xs)
|
blanchet@49813
|
139 |
(filter_used_facts false used_facts seen, result)
|
blanchet@46229
|
140 |
| _ => min timeout xs (x :: seen, result)
|
blanchet@49814
|
141 |
in min timeout xs ([], result) end
|
blanchet@38249
|
142 |
|
blanchet@46229
|
143 |
fun binary_minimize test timeout result xs =
|
blanchet@41223
|
144 |
let
|
blanchet@46233
|
145 |
fun min depth (result as {run_time, ...} : prover_result) sup
|
blanchet@46233
|
146 |
(xs as _ :: _ :: _) =
|
blanchet@42614
|
147 |
let
|
blanchet@46228
|
148 |
val (l0, r0) = chop (length xs div 2) xs
|
blanchet@42614
|
149 |
(*
|
blanchet@46227
|
150 |
val _ = warning (replicate_string depth " " ^ "{ " ^
|
blanchet@46227
|
151 |
"sup: " ^ n_facts (map fst sup))
|
blanchet@46227
|
152 |
val _ = warning (replicate_string depth " " ^ " " ^
|
blanchet@46227
|
153 |
"xs: " ^ n_facts (map fst xs))
|
blanchet@46227
|
154 |
val _ = warning (replicate_string depth " " ^ " " ^
|
blanchet@46227
|
155 |
"l0: " ^ n_facts (map fst l0))
|
blanchet@46227
|
156 |
val _ = warning (replicate_string depth " " ^ " " ^
|
blanchet@46227
|
157 |
"r0: " ^ n_facts (map fst r0))
|
blanchet@42614
|
158 |
*)
|
blanchet@46228
|
159 |
val depth = depth + 1
|
blanchet@46233
|
160 |
val timeout = new_timeout timeout run_time
|
blanchet@42614
|
161 |
in
|
blanchet@46229
|
162 |
case test timeout (sup @ l0) of
|
blanchet@46233
|
163 |
result as {outcome = NONE, used_facts, ...} =>
|
blanchet@49813
|
164 |
min depth result (filter_used_facts true used_facts sup)
|
blanchet@49813
|
165 |
(filter_used_facts true used_facts l0)
|
blanchet@46228
|
166 |
| _ =>
|
blanchet@46229
|
167 |
case test timeout (sup @ r0) of
|
blanchet@46228
|
168 |
result as {outcome = NONE, used_facts, ...} =>
|
blanchet@49813
|
169 |
min depth result (filter_used_facts true used_facts sup)
|
blanchet@49813
|
170 |
(filter_used_facts true used_facts r0)
|
blanchet@46228
|
171 |
| _ =>
|
blanchet@46228
|
172 |
let
|
blanchet@46228
|
173 |
val (sup_r0, (l, result)) = min depth result (sup @ r0) l0
|
blanchet@46228
|
174 |
val (sup, r0) =
|
blanchet@49813
|
175 |
(sup, r0)
|
blanchet@49813
|
176 |
|> pairself (filter_used_facts true (map fst sup_r0))
|
blanchet@46228
|
177 |
val (sup_l, (r, result)) = min depth result (sup @ l) r0
|
blanchet@49813
|
178 |
val sup = sup |> filter_used_facts true (map fst sup_l)
|
blanchet@46228
|
179 |
in (sup, (l @ r, result)) end
|
blanchet@41223
|
180 |
end
|
blanchet@42614
|
181 |
(*
|
blanchet@42614
|
182 |
|> tap (fn _ => warning (replicate_string depth " " ^ "}"))
|
blanchet@42614
|
183 |
*)
|
blanchet@46228
|
184 |
| min _ result sup xs = (sup, (xs, result))
|
blanchet@46228
|
185 |
in
|
blanchet@46228
|
186 |
case snd (min 0 result [] xs) of
|
blanchet@46233
|
187 |
([x], result as {run_time, ...}) =>
|
blanchet@46233
|
188 |
(case test (new_timeout timeout run_time) [] of
|
blanchet@46228
|
189 |
result as {outcome = NONE, ...} => ([], result)
|
blanchet@46228
|
190 |
| _ => ([x], result))
|
blanchet@46228
|
191 |
| p => p
|
blanchet@46228
|
192 |
end
|
blanchet@41223
|
193 |
|
blanchet@49336
|
194 |
fun minimize_facts do_learn prover_name (params as {learn, timeout, ...}) silent
|
blanchet@52324
|
195 |
i n state preplay0 facts =
|
wenzelm@31236
|
196 |
let
|
blanchet@41189
|
197 |
val ctxt = Proof.context_of state
|
blanchet@46445
|
198 |
val prover =
|
blanchet@46445
|
199 |
get_prover ctxt (if silent then Auto_Minimize else Minimize) prover_name
|
blanchet@46229
|
200 |
fun test timeout = test_facts params silent prover timeout i n state
|
blanchet@49811
|
201 |
val (chained, non_chained) = List.partition is_fact_chained facts
|
blanchet@49814
|
202 |
(* Push chained facts to the back, so that they are less likely to be
|
blanchet@49814
|
203 |
kicked out by the linear minimization algorithm. *)
|
blanchet@49811
|
204 |
val facts = non_chained @ chained
|
wenzelm@31236
|
205 |
in
|
blanchet@49811
|
206 |
(print silent (fn () => "Sledgehammer minimizer: " ^
|
blanchet@49811
|
207 |
quote prover_name ^ ".");
|
blanchet@49811
|
208 |
case test timeout facts of
|
blanchet@46232
|
209 |
result as {outcome = NONE, used_facts, run_time, ...} =>
|
blanchet@38249
|
210 |
let
|
blanchet@49813
|
211 |
val facts = filter_used_facts true used_facts facts
|
blanchet@46233
|
212 |
val min =
|
blanchet@46229
|
213 |
if length facts >= Config.get ctxt binary_min_facts then
|
blanchet@46229
|
214 |
binary_minimize
|
blanchet@46229
|
215 |
else
|
blanchet@46229
|
216 |
linear_minimize
|
blanchet@44439
|
217 |
val (min_facts, {preplay, message, message_tail, ...}) =
|
blanchet@46232
|
218 |
min test (new_timeout timeout run_time) result facts
|
blanchet@49336
|
219 |
in
|
blanchet@49336
|
220 |
print silent (fn () => cat_lines
|
blanchet@49336
|
221 |
["Minimized to " ^ n_facts (map fst min_facts)] ^
|
blanchet@49811
|
222 |
(case min_facts |> filter is_fact_chained |> length of
|
blanchet@49336
|
223 |
0 => ""
|
blanchet@49336
|
224 |
| n => "\n(including " ^ string_of_int n ^ " chained)") ^ ".");
|
blanchet@49414
|
225 |
(if learn then do_learn prover_name (maps snd min_facts) else ());
|
blanchet@52324
|
226 |
(SOME min_facts,
|
blanchet@52324
|
227 |
(if is_some preplay0 andalso length min_facts = length facts then
|
blanchet@52324
|
228 |
the preplay0
|
blanchet@52324
|
229 |
else
|
blanchet@52324
|
230 |
preplay,
|
blanchet@52324
|
231 |
message, message_tail))
|
blanchet@49336
|
232 |
end
|
blanchet@43893
|
233 |
| {outcome = SOME TimedOut, preplay, ...} =>
|
blanchet@43893
|
234 |
(NONE,
|
blanchet@43893
|
235 |
(preplay,
|
blanchet@51572
|
236 |
fn _ =>
|
blanchet@51572
|
237 |
"Timeout: You can increase the time limit using the \"timeout\" \
|
blanchet@51572
|
238 |
\option (e.g., \"timeout = " ^
|
blanchet@51572
|
239 |
string_of_int (10 + Time.toMilliseconds
|
blanchet@51572
|
240 |
(timeout |> the_default (seconds 60.0)) div 1000) ^
|
blanchet@51572
|
241 |
"\").", ""))
|
blanchet@43893
|
242 |
| {preplay, message, ...} =>
|
blanchet@44102
|
243 |
(NONE, (preplay, prefix "Prover error: " o message, "")))
|
blanchet@44007
|
244 |
handle ERROR msg =>
|
blanchet@51684
|
245 |
(NONE, (Lazy.value (Failed_to_Play plain_metis),
|
blanchet@51684
|
246 |
fn _ => "Error: " ^ msg, ""))
|
immler@31037
|
247 |
end
|
immler@31037
|
248 |
|
blanchet@49265
|
249 |
fun adjust_reconstructor_params override_params
|
blanchet@49265
|
250 |
({debug, verbose, overlord, blocking, provers, type_enc, strict,
|
blanchet@49336
|
251 |
lam_trans, uncurried_aliases, learn, fact_filter, max_facts,
|
blanchet@50933
|
252 |
fact_thresholds, max_mono_iters, max_new_mono_instances, isar_proofs,
|
smolkas@52267
|
253 |
isar_compress, slice, minimize, timeout, preplay_timeout, expect}
|
blanchet@49336
|
254 |
: params) =
|
blanchet@49265
|
255 |
let
|
blanchet@49265
|
256 |
fun lookup_override name default_value =
|
blanchet@49265
|
257 |
case AList.lookup (op =) override_params name of
|
blanchet@49265
|
258 |
SOME [s] => SOME s
|
blanchet@49265
|
259 |
| _ => default_value
|
blanchet@49265
|
260 |
(* Only those options that reconstructors are interested in are considered
|
blanchet@49265
|
261 |
here. *)
|
blanchet@49265
|
262 |
val type_enc = lookup_override "type_enc" type_enc
|
blanchet@49265
|
263 |
val lam_trans = lookup_override "lam_trans" lam_trans
|
blanchet@49265
|
264 |
in
|
blanchet@49265
|
265 |
{debug = debug, verbose = verbose, overlord = overlord, blocking = blocking,
|
blanchet@49265
|
266 |
provers = provers, type_enc = type_enc, strict = strict,
|
blanchet@49265
|
267 |
lam_trans = lam_trans, uncurried_aliases = uncurried_aliases,
|
blanchet@49336
|
268 |
learn = learn, fact_filter = fact_filter, max_facts = max_facts,
|
blanchet@49329
|
269 |
fact_thresholds = fact_thresholds, max_mono_iters = max_mono_iters,
|
blanchet@50933
|
270 |
max_new_mono_instances = max_new_mono_instances, isar_proofs = isar_proofs,
|
smolkas@52267
|
271 |
isar_compress = isar_compress, slice = slice, minimize = minimize,
|
blanchet@50933
|
272 |
timeout = timeout, preplay_timeout = preplay_timeout, expect = expect}
|
blanchet@49265
|
273 |
end
|
blanchet@49265
|
274 |
|
blanchet@49399
|
275 |
fun maybe_minimize ctxt mode do_learn name
|
blanchet@50933
|
276 |
(params as {verbose, isar_proofs, minimize, ...})
|
blanchet@52192
|
277 |
({state, subgoal, subgoal_count, ...} : prover_problem)
|
blanchet@52191
|
278 |
(result as {outcome, used_facts, used_from, run_time, preplay, message,
|
blanchet@49399
|
279 |
message_tail} : prover_result) =
|
blanchet@49265
|
280 |
if is_some outcome orelse null used_facts then
|
blanchet@49265
|
281 |
result
|
blanchet@49265
|
282 |
else
|
blanchet@49265
|
283 |
let
|
blanchet@49265
|
284 |
val num_facts = length used_facts
|
blanchet@49265
|
285 |
val ((perhaps_minimize, (minimize_name, params)), preplay) =
|
blanchet@49265
|
286 |
if mode = Normal then
|
blanchet@49265
|
287 |
if num_facts >= Config.get ctxt auto_minimize_min_facts then
|
blanchet@49265
|
288 |
((true, (name, params)), preplay)
|
blanchet@49265
|
289 |
else
|
blanchet@49265
|
290 |
let
|
blanchet@49265
|
291 |
fun can_min_fast_enough time =
|
blanchet@49265
|
292 |
0.001
|
blanchet@49265
|
293 |
* Real.fromInt ((num_facts + 1) * Time.toMilliseconds time)
|
blanchet@49265
|
294 |
<= Config.get ctxt auto_minimize_max_time
|
blanchet@49265
|
295 |
fun prover_fast_enough () = can_min_fast_enough run_time
|
blanchet@49265
|
296 |
in
|
blanchet@52327
|
297 |
(case Lazy.force preplay of
|
blanchet@52327
|
298 |
Played (reconstr as Metis _, timeout) =>
|
blanchet@52328
|
299 |
if isar_proofs = SOME true then
|
blanchet@52337
|
300 |
(* Cheat: Assume the selected ATP is as fast as "metis" for
|
blanchet@52337
|
301 |
the goal it proved itself. *)
|
blanchet@52337
|
302 |
(can_min_fast_enough timeout,
|
blanchet@52337
|
303 |
(isar_proof_reconstructor ctxt name, params))
|
blanchet@52328
|
304 |
else if can_min_fast_enough timeout then
|
blanchet@52327
|
305 |
(true, extract_reconstructor params reconstr
|
blanchet@52327
|
306 |
||> (fn override_params =>
|
blanchet@52327
|
307 |
adjust_reconstructor_params override_params
|
blanchet@52327
|
308 |
params))
|
blanchet@52327
|
309 |
else
|
blanchet@52327
|
310 |
(prover_fast_enough (), (name, params))
|
blanchet@52327
|
311 |
| Played (SMT, timeout) =>
|
blanchet@52328
|
312 |
(* Cheat: Assume the original prover is as fast as "smt" for
|
blanchet@52327
|
313 |
the goal it proved itself *)
|
blanchet@52327
|
314 |
(can_min_fast_enough timeout, (name, params))
|
blanchet@52327
|
315 |
| _ => (prover_fast_enough (), (name, params)),
|
blanchet@52327
|
316 |
preplay)
|
blanchet@49265
|
317 |
end
|
blanchet@49265
|
318 |
else
|
blanchet@49265
|
319 |
((false, (name, params)), preplay)
|
blanchet@49265
|
320 |
val minimize = minimize |> the_default perhaps_minimize
|
blanchet@49265
|
321 |
val (used_facts, (preplay, message, _)) =
|
blanchet@49265
|
322 |
if minimize then
|
blanchet@49407
|
323 |
minimize_facts do_learn minimize_name params
|
blanchet@52187
|
324 |
(mode <> Normal orelse not verbose) subgoal subgoal_count state
|
blanchet@52324
|
325 |
(SOME preplay)
|
blanchet@52192
|
326 |
(filter_used_facts true used_facts (map (apsnd single) used_from))
|
blanchet@49265
|
327 |
|>> Option.map (map fst)
|
blanchet@49265
|
328 |
else
|
blanchet@49265
|
329 |
(SOME used_facts, (preplay, message, ""))
|
blanchet@49265
|
330 |
in
|
blanchet@49265
|
331 |
case used_facts of
|
blanchet@49265
|
332 |
SOME used_facts =>
|
blanchet@52191
|
333 |
{outcome = NONE, used_facts = used_facts, used_from = used_from,
|
blanchet@52191
|
334 |
run_time = run_time, preplay = preplay, message = message,
|
blanchet@52191
|
335 |
message_tail = message_tail}
|
blanchet@49265
|
336 |
| NONE => result
|
blanchet@49265
|
337 |
end
|
blanchet@49265
|
338 |
|
blanchet@52324
|
339 |
fun get_minimizing_prover ctxt mode do_learn name params minimize_command
|
blanchet@52324
|
340 |
problem =
|
blanchet@49265
|
341 |
get_prover ctxt mode name params minimize_command problem
|
blanchet@49399
|
342 |
|> maybe_minimize ctxt mode do_learn name params problem
|
blanchet@49265
|
343 |
|
blanchet@49336
|
344 |
fun run_minimize (params as {provers, ...}) do_learn i refs state =
|
blanchet@38291
|
345 |
let
|
blanchet@38291
|
346 |
val ctxt = Proof.context_of state
|
blanchet@38935
|
347 |
val reserved = reserved_isar_keyword_table ()
|
blanchet@49307
|
348 |
val chained_ths = #facts (Proof.goal state)
|
blanchet@49411
|
349 |
val css = clasimpset_rule_table_of ctxt
|
blanchet@40445
|
350 |
val facts =
|
blanchet@47216
|
351 |
refs |> maps (map (apsnd single)
|
blanchet@49411
|
352 |
o fact_from_ref ctxt reserved chained_ths css)
|
blanchet@38291
|
353 |
in
|
blanchet@38291
|
354 |
case subgoal_count state of
|
wenzelm@40392
|
355 |
0 => Output.urgent_message "No subgoal!"
|
blanchet@41513
|
356 |
| n => case provers of
|
blanchet@41513
|
357 |
[] => error "No prover is set."
|
blanchet@41513
|
358 |
| prover :: _ =>
|
blanchet@41513
|
359 |
(kill_provers ();
|
blanchet@52324
|
360 |
minimize_facts do_learn prover params false i n state NONE facts
|
blanchet@44102
|
361 |
|> (fn (_, (preplay, message, message_tail)) =>
|
blanchet@51684
|
362 |
message (Lazy.force preplay) ^ message_tail
|
blanchet@44102
|
363 |
|> Output.urgent_message))
|
blanchet@38291
|
364 |
end
|
blanchet@38291
|
365 |
|
blanchet@35866
|
366 |
end;
|