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@39232
|
10 |
type locality = Sledgehammer_Filter.locality
|
blanchet@41335
|
11 |
type params = Sledgehammer_Provers.params
|
blanchet@35867
|
12 |
|
blanchet@43517
|
13 |
val binary_min_facts : int Config.T
|
blanchet@40242
|
14 |
val minimize_facts :
|
blanchet@42613
|
15 |
string -> params -> bool option -> bool -> int -> int -> Proof.state
|
blanchet@41339
|
16 |
-> ((string * locality) * thm list) list
|
blanchet@38991
|
17 |
-> ((string * locality) * thm list) list option * string
|
blanchet@39240
|
18 |
val run_minimize :
|
blanchet@39240
|
19 |
params -> int -> (Facts.ref * Attrib.src list) list -> Proof.state -> unit
|
blanchet@35866
|
20 |
end;
|
boehmes@32525
|
21 |
|
blanchet@39232
|
22 |
structure Sledgehammer_Minimize : SLEDGEHAMMER_MINIMIZE =
|
immler@31037
|
23 |
struct
|
immler@31037
|
24 |
|
blanchet@39736
|
25 |
open ATP_Proof
|
blanchet@36140
|
26 |
open Sledgehammer_Util
|
blanchet@39232
|
27 |
open Sledgehammer_Filter
|
blanchet@41335
|
28 |
open Sledgehammer_Provers
|
nipkow@33492
|
29 |
|
blanchet@36370
|
30 |
(* wrapper for calling external prover *)
|
wenzelm@31236
|
31 |
|
blanchet@40242
|
32 |
fun n_facts names =
|
blanchet@38937
|
33 |
let val n = length names in
|
blanchet@40242
|
34 |
string_of_int n ^ " fact" ^ plural_s n ^
|
blanchet@38338
|
35 |
(if n > 0 then
|
blanchet@38937
|
36 |
": " ^ (names |> map fst
|
blanchet@38937
|
37 |
|> sort_distinct string_ord |> space_implode " ")
|
blanchet@38338
|
38 |
else
|
blanchet@38338
|
39 |
"")
|
blanchet@38338
|
40 |
end
|
blanchet@38338
|
41 |
|
blanchet@41339
|
42 |
fun print silent f = if silent then () else Output.urgent_message (f ())
|
blanchet@41339
|
43 |
|
blanchet@43589
|
44 |
fun test_facts ({debug, verbose, overlord, provers, max_mono_iters,
|
blanchet@43605
|
45 |
max_new_mono_instances, type_sys, isar_proof,
|
blanchet@43856
|
46 |
isar_shrink_factor, preplay_timeout, ...} : params)
|
blanchet@42613
|
47 |
explicit_apply_opt silent (prover : prover) timeout i n state facts =
|
wenzelm@31236
|
48 |
let
|
blanchet@43845
|
49 |
val ctxt = Proof.context_of state
|
blanchet@42613
|
50 |
val thy = Proof.theory_of state
|
blanchet@41525
|
51 |
val _ =
|
blanchet@41525
|
52 |
print silent (fn () =>
|
blanchet@41525
|
53 |
"Testing " ^ n_facts (map fst facts) ^
|
blanchet@41525
|
54 |
(if verbose then " (timeout: " ^ string_from_time timeout ^ ")"
|
blanchet@41525
|
55 |
else "") ^ "...")
|
blanchet@42613
|
56 |
val {goal, ...} = Proof.goal state
|
blanchet@42613
|
57 |
val explicit_apply =
|
blanchet@42613
|
58 |
case explicit_apply_opt of
|
blanchet@42613
|
59 |
SOME explicit_apply => explicit_apply
|
blanchet@42613
|
60 |
| NONE =>
|
blanchet@43845
|
61 |
let val (_, hyp_ts, concl_t) = strip_subgoal ctxt goal i in
|
blanchet@42613
|
62 |
not (forall (Meson.is_fol_term thy)
|
blanchet@42613
|
63 |
(concl_t :: hyp_ts @ maps (map prop_of o snd) facts))
|
blanchet@42613
|
64 |
end
|
blanchet@38346
|
65 |
val params =
|
blanchet@42915
|
66 |
{debug = debug, verbose = verbose, overlord = overlord, blocking = true,
|
blanchet@41386
|
67 |
provers = provers, type_sys = type_sys, explicit_apply = explicit_apply,
|
blanchet@41386
|
68 |
relevance_thresholds = (1.01, 1.01), max_relevant = NONE,
|
blanchet@43605
|
69 |
max_mono_iters = max_mono_iters,
|
blanchet@43605
|
70 |
max_new_mono_instances = max_new_mono_instances, isar_proof = isar_proof,
|
blanchet@43605
|
71 |
isar_shrink_factor = isar_shrink_factor, slicing = false,
|
blanchet@43856
|
72 |
timeout = timeout, preplay_timeout = preplay_timeout, expect = ""}
|
blanchet@40445
|
73 |
val facts =
|
blanchet@41338
|
74 |
facts |> maps (fn (n, ths) => ths |> map (Untranslated_Fact o pair n))
|
blanchet@40246
|
75 |
val problem =
|
blanchet@40246
|
76 |
{state = state, goal = goal, subgoal = i, subgoal_count = n,
|
blanchet@42612
|
77 |
facts = facts, smt_filter = NONE}
|
blanchet@40445
|
78 |
val result as {outcome, used_facts, ...} = prover params (K "") problem
|
blanchet@36223
|
79 |
in
|
blanchet@41525
|
80 |
print silent (fn () =>
|
blanchet@41525
|
81 |
case outcome of
|
blanchet@42616
|
82 |
SOME failure => string_for_failure failure
|
blanchet@42616
|
83 |
| NONE => if length used_facts = length facts then "Found proof."
|
blanchet@42616
|
84 |
else "Found proof with " ^ n_facts used_facts ^ ".");
|
blanchet@38338
|
85 |
result
|
blanchet@36223
|
86 |
end
|
wenzelm@31236
|
87 |
|
blanchet@40445
|
88 |
(* minimalization of facts *)
|
wenzelm@31236
|
89 |
|
blanchet@41223
|
90 |
(* The sublinear algorithm works well in almost all situations, except when the
|
blanchet@41223
|
91 |
external prover cannot return the list of used facts and hence returns all
|
blanchet@41515
|
92 |
facts as used. In that case, the binary algorithm is much more appropriate.
|
blanchet@41515
|
93 |
We can usually detect the situation by looking at the number of used facts
|
blanchet@41515
|
94 |
reported by the prover. *)
|
blanchet@43517
|
95 |
val binary_min_facts =
|
blanchet@43517
|
96 |
Attrib.setup_config_int @{binding sledgehammer_minimize_binary_min_facts}
|
blanchet@43517
|
97 |
(K 20)
|
blanchet@41223
|
98 |
|
blanchet@38249
|
99 |
fun sublinear_minimize _ [] p = p
|
blanchet@38249
|
100 |
| sublinear_minimize test (x :: xs) (seen, result) =
|
blanchet@38249
|
101 |
case test (xs @ seen) of
|
blanchet@40445
|
102 |
result as {outcome = NONE, used_facts, ...} : prover_result =>
|
blanchet@40445
|
103 |
sublinear_minimize test (filter_used_facts used_facts xs)
|
blanchet@40445
|
104 |
(filter_used_facts used_facts seen, result)
|
blanchet@38249
|
105 |
| _ => sublinear_minimize test xs (x :: seen, result)
|
blanchet@38249
|
106 |
|
blanchet@41223
|
107 |
fun binary_minimize test xs =
|
blanchet@41223
|
108 |
let
|
blanchet@41223
|
109 |
fun p xs = #outcome (test xs : prover_result) = NONE
|
blanchet@41223
|
110 |
fun split [] p = p
|
blanchet@41223
|
111 |
| split [h] (l, r) = (h :: l, r)
|
blanchet@41223
|
112 |
| split (h1 :: h2 :: t) (l, r) = split t (h1 :: l, h2 :: r)
|
blanchet@42614
|
113 |
fun min _ _ [] = raise Empty
|
blanchet@42614
|
114 |
| min _ _ [s0] = [s0]
|
blanchet@42614
|
115 |
| min depth sup xs =
|
blanchet@42614
|
116 |
let
|
blanchet@42614
|
117 |
(*
|
blanchet@42614
|
118 |
val _ = warning (replicate_string depth " " ^ "{" ^ (" " ^
|
blanchet@42614
|
119 |
n_facts (map fst sup) ^ " and " ^
|
blanchet@42614
|
120 |
n_facts (map fst xs)))
|
blanchet@42614
|
121 |
*)
|
blanchet@42614
|
122 |
val (l0, r0) = split xs ([], [])
|
blanchet@42614
|
123 |
in
|
blanchet@41223
|
124 |
if p (sup @ l0) then
|
blanchet@42614
|
125 |
min (depth + 1) sup l0
|
blanchet@41223
|
126 |
else if p (sup @ r0) then
|
blanchet@42614
|
127 |
min (depth + 1) sup r0
|
blanchet@41223
|
128 |
else
|
blanchet@41223
|
129 |
let
|
blanchet@42614
|
130 |
val l = min (depth + 1) (sup @ r0) l0
|
blanchet@42614
|
131 |
val r = min (depth + 1) (sup @ l) r0
|
blanchet@41223
|
132 |
in l @ r end
|
blanchet@41223
|
133 |
end
|
blanchet@42614
|
134 |
(*
|
blanchet@42614
|
135 |
|> tap (fn _ => warning (replicate_string depth " " ^ "}"))
|
blanchet@42614
|
136 |
*)
|
blanchet@41223
|
137 |
val xs =
|
blanchet@42614
|
138 |
case min 0 [] xs of
|
blanchet@41223
|
139 |
[x] => if p [] then [] else [x]
|
blanchet@41223
|
140 |
| xs => xs
|
blanchet@41223
|
141 |
in (xs, test xs) end
|
blanchet@41223
|
142 |
|
blanchet@41223
|
143 |
(* Give the external prover some slack. The ATP gets further slack because the
|
blanchet@41223
|
144 |
Sledgehammer preprocessing time is included in the estimate below but isn't
|
blanchet@41223
|
145 |
part of the timeout. *)
|
blanchet@41525
|
146 |
val slack_msecs = 200
|
blanchet@38338
|
147 |
|
blanchet@42613
|
148 |
fun minimize_facts prover_name (params as {timeout, ...}) explicit_apply_opt
|
blanchet@42613
|
149 |
silent i n state facts =
|
wenzelm@31236
|
150 |
let
|
blanchet@41189
|
151 |
val ctxt = Proof.context_of state
|
blanchet@43862
|
152 |
val prover = get_prover ctxt Minimize prover_name
|
blanchet@38813
|
153 |
val msecs = Time.toMilliseconds timeout
|
blanchet@41339
|
154 |
val _ = print silent (fn () => "Sledgehammer minimize: " ^
|
blanchet@41223
|
155 |
quote prover_name ^ ".")
|
blanchet@38346
|
156 |
fun do_test timeout =
|
blanchet@42613
|
157 |
test_facts params explicit_apply_opt silent prover timeout i n state
|
blanchet@38338
|
158 |
val timer = Timer.startRealTimer ()
|
wenzelm@31236
|
159 |
in
|
blanchet@40445
|
160 |
(case do_test timeout facts of
|
blanchet@40445
|
161 |
result as {outcome = NONE, used_facts, ...} =>
|
blanchet@38249
|
162 |
let
|
blanchet@38338
|
163 |
val time = Timer.checkRealTimer timer
|
blanchet@38338
|
164 |
val new_timeout =
|
blanchet@41525
|
165 |
Int.min (msecs, Time.toMilliseconds time + slack_msecs)
|
blanchet@38338
|
166 |
|> Time.fromMilliseconds
|
blanchet@41223
|
167 |
val facts = filter_used_facts used_facts facts
|
blanchet@40242
|
168 |
val (min_thms, {message, ...}) =
|
blanchet@43517
|
169 |
if length facts >= Config.get ctxt binary_min_facts then
|
blanchet@41223
|
170 |
binary_minimize (do_test new_timeout) facts
|
blanchet@41223
|
171 |
else
|
blanchet@41223
|
172 |
sublinear_minimize (do_test new_timeout) facts ([], result)
|
blanchet@38340
|
173 |
val n = length min_thms
|
blanchet@41339
|
174 |
val _ = print silent (fn () => cat_lines
|
blanchet@40242
|
175 |
["Minimized: " ^ string_of_int n ^ " fact" ^ plural_s n] ^
|
blanchet@38991
|
176 |
(case length (filter (curry (op =) Chained o snd o fst) min_thms) of
|
blanchet@38937
|
177 |
0 => ""
|
wenzelm@41739
|
178 |
| n => " (including " ^ string_of_int n ^ " chained)") ^ ".")
|
blanchet@40242
|
179 |
in (SOME min_thms, message) end
|
blanchet@38249
|
180 |
| {outcome = SOME TimedOut, ...} =>
|
blanchet@38249
|
181 |
(NONE, "Timeout: You can increase the time limit using the \"timeout\" \
|
blanchet@38249
|
182 |
\option (e.g., \"timeout = " ^
|
blanchet@40582
|
183 |
string_of_int (10 + msecs div 1000) ^ "\").")
|
blanchet@41223
|
184 |
| {message, ...} => (NONE, "Prover error: " ^ message))
|
blanchet@38228
|
185 |
handle ERROR msg => (NONE, "Error: " ^ msg)
|
immler@31037
|
186 |
end
|
immler@31037
|
187 |
|
blanchet@41513
|
188 |
fun run_minimize (params as {provers, ...}) i refs state =
|
blanchet@38291
|
189 |
let
|
blanchet@38291
|
190 |
val ctxt = Proof.context_of state
|
blanchet@38935
|
191 |
val reserved = reserved_isar_keyword_table ()
|
blanchet@38291
|
192 |
val chained_ths = #facts (Proof.goal state)
|
blanchet@40445
|
193 |
val facts =
|
blanchet@41339
|
194 |
refs
|
blanchet@41339
|
195 |
|> maps (map (apsnd single) o fact_from_ref ctxt reserved chained_ths)
|
blanchet@38291
|
196 |
in
|
blanchet@38291
|
197 |
case subgoal_count state of
|
wenzelm@40392
|
198 |
0 => Output.urgent_message "No subgoal!"
|
blanchet@41513
|
199 |
| n => case provers of
|
blanchet@41513
|
200 |
[] => error "No prover is set."
|
blanchet@41513
|
201 |
| prover :: _ =>
|
blanchet@41513
|
202 |
(kill_provers ();
|
blanchet@42613
|
203 |
minimize_facts prover params NONE false i n state facts
|
blanchet@43874
|
204 |
|> snd |> Output.urgent_message)
|
blanchet@38291
|
205 |
end
|
blanchet@38291
|
206 |
|
blanchet@35866
|
207 |
end;
|