1 (* Title: HOL/Tools/Sledgehammer/sledgehammer_minimize.ML
2 Author: Philipp Meyer, TU Muenchen
3 Author: Jasmin Blanchette, TU Muenchen
5 Minimization of fact list for Metis using external provers.
8 signature SLEDGEHAMMER_MINIMIZE =
10 type stature = ATP_Problem_Generate.stature
11 type play = ATP_Proof_Reconstruct.play
12 type mode = Sledgehammer_Provers.mode
13 type params = Sledgehammer_Provers.params
14 type prover = Sledgehammer_Provers.prover
16 val binary_min_facts : int Config.T
17 val auto_minimize_min_facts : int Config.T
18 val auto_minimize_max_time : real Config.T
20 string -> params -> bool -> int -> int -> Proof.state
21 -> ((string * stature) * thm list) list
22 -> ((string * stature) * thm list) list option
23 * ((unit -> play) * (play -> string) * string)
24 val get_minimizing_prover : Proof.context -> mode -> string -> prover
26 params -> int -> (Facts.ref * Attrib.src list) list -> Proof.state -> unit
29 structure Sledgehammer_Minimize : SLEDGEHAMMER_MINIMIZE =
34 open ATP_Problem_Generate
35 open ATP_Proof_Reconstruct
36 open Sledgehammer_Util
37 open Sledgehammer_Fact
38 open Sledgehammer_Provers
40 (* wrapper for calling external prover *)
43 let val n = length names in
44 string_of_int n ^ " fact" ^ plural_s n ^
46 ": " ^ (names |> map fst |> sort string_ord |> space_implode " ")
51 fun print silent f = if silent then () else Output.urgent_message (f ())
53 fun test_facts ({debug, verbose, overlord, provers, max_mono_iters,
54 max_new_mono_instances, type_enc, strict, lam_trans,
55 uncurried_aliases, isar_proof, isar_shrink_factor,
56 preplay_timeout, ...} : params)
57 silent (prover : prover) timeout i n state facts =
60 print silent (fn () =>
61 "Testing " ^ n_facts (map fst facts) ^
62 (if verbose then " (timeout: " ^ string_from_time timeout ^ ")"
64 val {goal, ...} = Proof.goal state
66 facts |> maps (fn (n, ths) => ths |> map (Untranslated_Fact o pair n))
68 {debug = debug, verbose = verbose, overlord = overlord, blocking = true,
69 provers = provers, type_enc = type_enc, strict = strict,
70 lam_trans = lam_trans, uncurried_aliases = uncurried_aliases,
71 fact_thresholds = (1.01, 1.01), max_facts = SOME (length facts),
72 max_mono_iters = max_mono_iters,
73 max_new_mono_instances = max_new_mono_instances, isar_proof = isar_proof,
74 isar_shrink_factor = isar_shrink_factor, slice = false,
75 minimize = SOME false, timeout = timeout,
76 preplay_timeout = preplay_timeout, expect = ""}
78 {state = state, goal = goal, subgoal = i, subgoal_count = n,
80 val result as {outcome, used_facts, run_time, ...} =
81 prover params (K (K (K ""))) problem
86 SOME failure => string_for_failure failure
89 (if length used_facts = length facts then ""
90 else " with " ^ n_facts used_facts) ^
91 " (" ^ string_from_time run_time ^ ").");
95 (* minimalization of facts *)
97 (* Give the external prover some slack. The ATP gets further slack because the
98 Sledgehammer preprocessing time is included in the estimate below but isn't
99 part of the timeout. *)
100 val slack_msecs = 200
102 fun new_timeout timeout run_time =
103 Int.min (Time.toMilliseconds timeout,
104 Time.toMilliseconds run_time + slack_msecs)
105 |> Time.fromMilliseconds
107 (* The linear algorithm usually outperforms the binary algorithm when over 60%
108 of the facts are actually needed. The binary algorithm is much more
109 appropriate for provers that cannot return the list of used facts and hence
110 returns all facts as used. Since we cannot know in advance how many facts are
111 actually needed, we heuristically set the threshold to 10 facts. *)
112 val binary_min_facts =
113 Attrib.setup_config_int @{binding sledgehammer_minimize_binary_min_facts}
115 val auto_minimize_min_facts =
116 Attrib.setup_config_int @{binding sledgehammer_auto_minimize_min_facts}
117 (fn generic => Config.get_generic generic binary_min_facts)
118 val auto_minimize_max_time =
119 Attrib.setup_config_real @{binding sledgehammer_auto_minimize_max_time}
122 fun linear_minimize test timeout result xs =
125 | min timeout (x :: xs) (seen, result) =
126 case test timeout (xs @ seen) of
127 result as {outcome = NONE, used_facts, run_time, ...}
129 min (new_timeout timeout run_time) (filter_used_facts used_facts xs)
130 (filter_used_facts used_facts seen, result)
131 | _ => min timeout xs (x :: seen, result)
132 in min timeout xs ([], result) end
134 fun binary_minimize test timeout result xs =
136 fun min depth (result as {run_time, ...} : prover_result) sup
137 (xs as _ :: _ :: _) =
139 val (l0, r0) = chop (length xs div 2) xs
141 val _ = warning (replicate_string depth " " ^ "{ " ^
142 "sup: " ^ n_facts (map fst sup))
143 val _ = warning (replicate_string depth " " ^ " " ^
144 "xs: " ^ n_facts (map fst xs))
145 val _ = warning (replicate_string depth " " ^ " " ^
146 "l0: " ^ n_facts (map fst l0))
147 val _ = warning (replicate_string depth " " ^ " " ^
148 "r0: " ^ n_facts (map fst r0))
150 val depth = depth + 1
151 val timeout = new_timeout timeout run_time
153 case test timeout (sup @ l0) of
154 result as {outcome = NONE, used_facts, ...} =>
155 min depth result (filter_used_facts used_facts sup)
156 (filter_used_facts used_facts l0)
158 case test timeout (sup @ r0) of
159 result as {outcome = NONE, used_facts, ...} =>
160 min depth result (filter_used_facts used_facts sup)
161 (filter_used_facts used_facts r0)
164 val (sup_r0, (l, result)) = min depth result (sup @ r0) l0
166 (sup, r0) |> pairself (filter_used_facts (map fst sup_r0))
167 val (sup_l, (r, result)) = min depth result (sup @ l) r0
168 val sup = sup |> filter_used_facts (map fst sup_l)
169 in (sup, (l @ r, result)) end
172 |> tap (fn _ => warning (replicate_string depth " " ^ "}"))
174 | min _ result sup xs = (sup, (xs, result))
176 case snd (min 0 result [] xs) of
177 ([x], result as {run_time, ...}) =>
178 (case test (new_timeout timeout run_time) [] of
179 result as {outcome = NONE, ...} => ([], result)
180 | _ => ([x], result))
184 fun minimize_facts prover_name (params as {timeout, ...}) silent i n state
187 val ctxt = Proof.context_of state
189 get_prover ctxt (if silent then Auto_Minimize else Minimize) prover_name
190 val _ = print silent (fn () => "Sledgehammer minimizer: " ^
191 quote prover_name ^ ".")
192 fun test timeout = test_facts params silent prover timeout i n state
194 (case test timeout facts of
195 result as {outcome = NONE, used_facts, run_time, ...} =>
197 val facts = filter_used_facts used_facts facts
199 if length facts >= Config.get ctxt binary_min_facts then
203 val (min_facts, {preplay, message, message_tail, ...}) =
204 min test (new_timeout timeout run_time) result facts
205 val _ = print silent (fn () => cat_lines
206 ["Minimized to " ^ n_facts (map fst min_facts)] ^
207 (case min_facts |> filter (fn ((_, (sc, _)), _) => sc = Chained)
210 | n => "\n(including " ^ string_of_int n ^ " chained)") ^ ".")
211 in (SOME min_facts, (preplay, message, message_tail)) end
212 | {outcome = SOME TimedOut, preplay, ...} =>
215 fn _ => "Timeout: You can increase the time limit using the \
216 \\"timeout\" option (e.g., \"timeout = " ^
217 string_of_int (10 + Time.toMilliseconds timeout div 1000) ^
220 | {preplay, message, ...} =>
221 (NONE, (preplay, prefix "Prover error: " o message, "")))
223 (NONE, (K (Failed_to_Play plain_metis), fn _ => "Error: " ^ msg, ""))
226 fun adjust_reconstructor_params override_params
227 ({debug, verbose, overlord, blocking, provers, type_enc, strict,
228 lam_trans, uncurried_aliases, fact_thresholds, max_facts,
229 max_mono_iters, max_new_mono_instances, isar_proof, isar_shrink_factor,
230 slice, minimize, timeout, preplay_timeout, expect} : params) =
232 fun lookup_override name default_value =
233 case AList.lookup (op =) override_params name of
236 (* Only those options that reconstructors are interested in are considered
238 val type_enc = lookup_override "type_enc" type_enc
239 val lam_trans = lookup_override "lam_trans" lam_trans
241 {debug = debug, verbose = verbose, overlord = overlord, blocking = blocking,
242 provers = provers, type_enc = type_enc, strict = strict,
243 lam_trans = lam_trans, uncurried_aliases = uncurried_aliases,
244 max_facts = max_facts, fact_thresholds = fact_thresholds,
245 max_mono_iters = max_mono_iters,
246 max_new_mono_instances = max_new_mono_instances, isar_proof = isar_proof,
247 isar_shrink_factor = isar_shrink_factor, slice = slice,
248 minimize = minimize, timeout = timeout, preplay_timeout = preplay_timeout,
252 fun minimize ctxt mode name
253 (params as {debug, verbose, isar_proof, minimize, ...})
254 ({state, subgoal, subgoal_count, facts, ...} : prover_problem)
255 (result as {outcome, used_facts, run_time, preplay, message,
256 message_tail} : prover_result) =
257 if is_some outcome orelse null used_facts then
261 val num_facts = length used_facts
262 val ((perhaps_minimize, (minimize_name, params)), preplay) =
263 if mode = Normal then
264 if num_facts >= Config.get ctxt auto_minimize_min_facts then
265 ((true, (name, params)), preplay)
268 fun can_min_fast_enough time =
270 * Real.fromInt ((num_facts + 1) * Time.toMilliseconds time)
271 <= Config.get ctxt auto_minimize_max_time
272 fun prover_fast_enough () = can_min_fast_enough run_time
275 ((prover_fast_enough (), (name, params)), preplay)
277 let val preplay = preplay () in
279 Played (reconstr, timeout) =>
280 if can_min_fast_enough timeout then
281 (true, extract_reconstructor params reconstr
282 ||> (fn override_params =>
283 adjust_reconstructor_params
284 override_params params))
286 (prover_fast_enough (), (name, params))
287 | _ => (prover_fast_enough (), (name, params)),
292 ((false, (name, params)), preplay)
293 val minimize = minimize |> the_default perhaps_minimize
294 val (used_facts, (preplay, message, _)) =
296 minimize_facts minimize_name params (not verbose) subgoal
298 (filter_used_facts used_facts
299 (map (apsnd single o untranslated_fact) facts))
300 |>> Option.map (map fst)
302 (SOME used_facts, (preplay, message, ""))
306 (if debug andalso not (null used_facts) then
308 |> map (fn (j, fact) => fact |> untranslated_fact |> apsnd (K j))
309 |> filter_used_facts used_facts
310 |> map (fn ((name, _), j) => name ^ "@" ^ string_of_int j)
312 |> enclose ("Fact" ^ plural_s (length facts) ^ " in " ^ quote name ^
313 " proof (of " ^ string_of_int (length facts) ^ "): ") "."
314 |> Output.urgent_message
317 {outcome = NONE, used_facts = used_facts, run_time = run_time,
318 preplay = preplay, message = message, message_tail = message_tail})
322 fun get_minimizing_prover ctxt mode name params minimize_command problem =
323 get_prover ctxt mode name params minimize_command problem
324 |> minimize ctxt mode name params problem
326 fun run_minimize (params as {provers, ...}) i refs state =
328 val ctxt = Proof.context_of state
329 val reserved = reserved_isar_keyword_table ()
330 val chained_ths = #facts (Proof.goal state)
331 val css_table = clasimpset_rule_table_of ctxt
333 refs |> maps (map (apsnd single)
334 o fact_from_ref ctxt reserved chained_ths css_table)
336 case subgoal_count state of
337 0 => Output.urgent_message "No subgoal!"
338 | n => case provers of
339 [] => error "No prover is set."
342 minimize_facts prover params false i n state facts
343 |> (fn (_, (preplay, message, message_tail)) =>
344 message (preplay ()) ^ message_tail
345 |> Output.urgent_message))