boehmes@36890
|
1 |
(* Title: HOL/Tools/SMT/smt_solver.ML
|
boehmes@36890
|
2 |
Author: Sascha Boehme, TU Muenchen
|
boehmes@36890
|
3 |
|
boehmes@36890
|
4 |
SMT solvers registry and SMT tactic.
|
boehmes@36890
|
5 |
*)
|
boehmes@36890
|
6 |
|
boehmes@36890
|
7 |
signature SMT_SOLVER =
|
boehmes@36890
|
8 |
sig
|
boehmes@40651
|
9 |
(*configuration*)
|
boehmes@36890
|
10 |
type interface = {
|
boehmes@36890
|
11 |
extra_norm: SMT_Normalize.extra_norm,
|
boehmes@36890
|
12 |
translate: SMT_Translate.config }
|
boehmes@40403
|
13 |
datatype outcome = Unsat | Sat | Unknown
|
boehmes@36890
|
14 |
type solver_config = {
|
boehmes@40403
|
15 |
name: string,
|
boehmes@40403
|
16 |
env_var: string,
|
boehmes@40403
|
17 |
is_remote: bool,
|
boehmes@40403
|
18 |
options: Proof.context -> string list,
|
boehmes@36890
|
19 |
interface: interface,
|
boehmes@40403
|
20 |
outcome: string -> string list -> outcome * string list,
|
boehmes@40403
|
21 |
cex_parser: (Proof.context -> SMT_Translate.recon -> string list ->
|
boehmes@40403
|
22 |
term list) option,
|
boehmes@40403
|
23 |
reconstruct: (Proof.context -> SMT_Translate.recon -> string list ->
|
boehmes@40403
|
24 |
(int list * thm) * Proof.context) option }
|
boehmes@36890
|
25 |
|
boehmes@40651
|
26 |
(*registry*)
|
boehmes@40437
|
27 |
type solver = bool option -> Proof.context -> (int * thm) list ->
|
boehmes@40437
|
28 |
int list * thm
|
boehmes@40403
|
29 |
val add_solver: solver_config -> theory -> theory
|
boehmes@40651
|
30 |
val solver_of: Proof.context -> solver
|
boehmes@40407
|
31 |
val is_locally_installed: Proof.context -> bool
|
boehmes@36890
|
32 |
|
boehmes@40403
|
33 |
(*filter*)
|
boehmes@40405
|
34 |
val smt_filter: bool -> Time.time -> Proof.state -> ('a * thm) list -> int ->
|
boehmes@40651
|
35 |
{outcome: SMT_Failure.failure option, used_facts: 'a list,
|
boehmes@40438
|
36 |
run_time_in_msecs: int option}
|
boehmes@40402
|
37 |
|
boehmes@36890
|
38 |
(*tactic*)
|
boehmes@36890
|
39 |
val smt_tac': bool -> Proof.context -> thm list -> int -> Tactical.tactic
|
boehmes@36890
|
40 |
val smt_tac: Proof.context -> thm list -> int -> Tactical.tactic
|
boehmes@36890
|
41 |
|
boehmes@36890
|
42 |
(*setup*)
|
boehmes@36890
|
43 |
val setup: theory -> theory
|
boehmes@36890
|
44 |
end
|
boehmes@36890
|
45 |
|
boehmes@36890
|
46 |
structure SMT_Solver: SMT_SOLVER =
|
boehmes@36890
|
47 |
struct
|
boehmes@36890
|
48 |
|
boehmes@40651
|
49 |
structure C = SMT_Config
|
boehmes@36890
|
50 |
|
boehmes@40403
|
51 |
|
boehmes@40651
|
52 |
(* configuration *)
|
boehmes@36890
|
53 |
|
boehmes@36890
|
54 |
type interface = {
|
boehmes@36890
|
55 |
extra_norm: SMT_Normalize.extra_norm,
|
boehmes@36890
|
56 |
translate: SMT_Translate.config }
|
boehmes@36890
|
57 |
|
boehmes@40403
|
58 |
datatype outcome = Unsat | Sat | Unknown
|
boehmes@40403
|
59 |
|
boehmes@36890
|
60 |
type solver_config = {
|
boehmes@40403
|
61 |
name: string,
|
boehmes@40403
|
62 |
env_var: string,
|
boehmes@40403
|
63 |
is_remote: bool,
|
boehmes@40403
|
64 |
options: Proof.context -> string list,
|
boehmes@36890
|
65 |
interface: interface,
|
boehmes@40403
|
66 |
outcome: string -> string list -> outcome * string list,
|
boehmes@40403
|
67 |
cex_parser: (Proof.context -> SMT_Translate.recon -> string list ->
|
boehmes@40403
|
68 |
term list) option,
|
boehmes@40403
|
69 |
reconstruct: (Proof.context -> SMT_Translate.recon -> string list ->
|
boehmes@40403
|
70 |
(int list * thm) * Proof.context) option }
|
boehmes@36890
|
71 |
|
boehmes@36890
|
72 |
|
boehmes@36890
|
73 |
(* interface to external solvers *)
|
boehmes@36890
|
74 |
|
boehmes@40407
|
75 |
fun get_local_solver env_var =
|
boehmes@40407
|
76 |
let val local_solver = getenv env_var
|
boehmes@40407
|
77 |
in if local_solver <> "" then SOME local_solver else NONE end
|
boehmes@40407
|
78 |
|
boehmes@36890
|
79 |
local
|
boehmes@36890
|
80 |
|
boehmes@40437
|
81 |
fun choose (rm, env_var, is_remote, name) =
|
boehmes@36890
|
82 |
let
|
boehmes@40437
|
83 |
val force_local = (case rm of SOME false => true | _ => false)
|
boehmes@40437
|
84 |
val force_remote = (case rm of SOME true => true | _ => false)
|
boehmes@40407
|
85 |
val lsolver = get_local_solver env_var
|
boehmes@36890
|
86 |
val remote_url = getenv "REMOTE_SMT_URL"
|
boehmes@40437
|
87 |
val trace = if is_some rm then K () else tracing
|
boehmes@36890
|
88 |
in
|
boehmes@40407
|
89 |
if not force_remote andalso is_some lsolver
|
boehmes@36890
|
90 |
then
|
boehmes@40437
|
91 |
(trace ("Invoking local SMT solver " ^ quote (the lsolver) ^ " ...");
|
boehmes@40407
|
92 |
[the lsolver])
|
boehmes@40437
|
93 |
else if not force_local andalso is_remote
|
boehmes@36890
|
94 |
then
|
boehmes@40437
|
95 |
(trace ("Invoking remote SMT solver " ^ quote name ^ " at " ^
|
boehmes@36890
|
96 |
quote remote_url ^ " ...");
|
boehmes@40407
|
97 |
[getenv "REMOTE_SMT", name])
|
boehmes@40407
|
98 |
else if force_remote
|
boehmes@40437
|
99 |
then error ("The SMT solver " ^ quote name ^ " is not remotely available.")
|
boehmes@40437
|
100 |
else error ("The SMT solver " ^ quote name ^ " has not been found " ^
|
boehmes@40437
|
101 |
"on this computer. Please set the Isabelle environment variable " ^
|
boehmes@40437
|
102 |
quote env_var ^ ".")
|
boehmes@36890
|
103 |
end
|
boehmes@36890
|
104 |
|
boehmes@36890
|
105 |
fun make_cmd solver args problem_path proof_path = space_implode " " (
|
boehmes@36890
|
106 |
map File.shell_quote (solver @ args) @
|
boehmes@36890
|
107 |
[File.shell_path problem_path, "2>&1", ">", File.shell_path proof_path])
|
boehmes@36890
|
108 |
|
boehmes@36890
|
109 |
fun run ctxt cmd args input =
|
boehmes@40651
|
110 |
(case C.certificates_of ctxt of
|
boehmes@40781
|
111 |
NONE => Cache_IO.run (make_cmd (choose cmd) args) input
|
boehmes@36890
|
112 |
| SOME certs =>
|
boehmes@36890
|
113 |
(case Cache_IO.lookup certs input of
|
boehmes@36890
|
114 |
(NONE, key) =>
|
boehmes@40781
|
115 |
if Config.get ctxt C.fixed then
|
boehmes@40781
|
116 |
error ("Bad certificates cache: missing certificate")
|
boehmes@40781
|
117 |
else
|
boehmes@40781
|
118 |
Cache_IO.run_and_cache certs key (make_cmd (choose cmd) args) input
|
boehmes@36890
|
119 |
| (SOME output, _) =>
|
boehmes@36890
|
120 |
(tracing ("Using cached certificate from " ^
|
boehmes@36890
|
121 |
File.shell_path (Cache_IO.cache_path_of certs) ^ " ...");
|
boehmes@40792
|
122 |
output)))
|
boehmes@36890
|
123 |
|
boehmes@36890
|
124 |
in
|
boehmes@36890
|
125 |
|
boehmes@36890
|
126 |
fun run_solver ctxt cmd args input =
|
boehmes@36890
|
127 |
let
|
boehmes@36890
|
128 |
fun pretty tag ls = Pretty.string_of (Pretty.big_list tag
|
boehmes@36890
|
129 |
(map Pretty.str ls))
|
boehmes@36890
|
130 |
|
boehmes@40651
|
131 |
val _ = C.trace_msg ctxt (pretty "Problem:" o split_lines) input
|
boehmes@36890
|
132 |
|
boehmes@40792
|
133 |
val {redirected_output=res, output=err, return_code} =
|
boehmes@40792
|
134 |
C.with_timeout ctxt (run ctxt cmd args) input
|
boehmes@40651
|
135 |
val _ = C.trace_msg ctxt (pretty "Solver:") err
|
boehmes@36890
|
136 |
|
haftmann@40057
|
137 |
val ls = rev (snd (chop_while (equal "") (rev res)))
|
boehmes@40651
|
138 |
val _ = C.trace_msg ctxt (pretty "Result:") ls
|
boehmes@40792
|
139 |
|
boehmes@40792
|
140 |
val _ = null ls andalso return_code <> 0 andalso
|
boehmes@40802
|
141 |
raise SMT_Failure.SMT (SMT_Failure.Abnormal_Termination return_code)
|
boehmes@36890
|
142 |
in ls end
|
boehmes@36890
|
143 |
|
boehmes@36890
|
144 |
end
|
boehmes@36890
|
145 |
|
boehmes@40651
|
146 |
fun trace_assms ctxt = C.trace_msg ctxt (Pretty.string_of o
|
boehmes@40651
|
147 |
Pretty.big_list "Assertions:" o map (Display.pretty_thm ctxt o snd))
|
boehmes@40439
|
148 |
|
blanchet@36933
|
149 |
fun trace_recon_data ctxt ({typs, terms, ...} : SMT_Translate.recon) =
|
boehmes@36890
|
150 |
let
|
boehmes@36890
|
151 |
fun pretty_eq n p = Pretty.block [Pretty.str n, Pretty.str " = ", p]
|
boehmes@40651
|
152 |
fun p_typ (n, T) = pretty_eq n (Syntax.pretty_typ ctxt T)
|
boehmes@40651
|
153 |
fun p_term (n, t) = pretty_eq n (Syntax.pretty_term ctxt t)
|
boehmes@36890
|
154 |
in
|
boehmes@40651
|
155 |
C.trace_msg ctxt (fn () =>
|
boehmes@40651
|
156 |
Pretty.string_of (Pretty.big_list "Names:" [
|
boehmes@40651
|
157 |
Pretty.big_list "sorts:" (map p_typ (Symtab.dest typs)),
|
boehmes@40651
|
158 |
Pretty.big_list "functions:" (map p_term (Symtab.dest terms))])) ()
|
boehmes@36890
|
159 |
end
|
boehmes@36890
|
160 |
|
boehmes@40651
|
161 |
fun invoke translate_config name cmd options irules ctxt =
|
boehmes@40403
|
162 |
let
|
boehmes@40651
|
163 |
val args = C.solver_options_of ctxt @ options ctxt
|
boehmes@40403
|
164 |
val comments = ("solver: " ^ name) ::
|
boehmes@40651
|
165 |
("timeout: " ^ Time.toString (seconds (Config.get ctxt C.timeout))) ::
|
boehmes@40403
|
166 |
"arguments:" :: args
|
boehmes@40403
|
167 |
in
|
boehmes@40403
|
168 |
irules
|
boehmes@40439
|
169 |
|> tap (trace_assms ctxt)
|
boehmes@40403
|
170 |
|> SMT_Translate.translate translate_config ctxt comments
|
boehmes@40403
|
171 |
||> tap (trace_recon_data ctxt)
|
boehmes@40403
|
172 |
|>> run_solver ctxt cmd args
|
boehmes@40403
|
173 |
|> rpair ctxt
|
boehmes@40403
|
174 |
end
|
boehmes@36890
|
175 |
|
boehmes@36890
|
176 |
fun discharge_definitions thm =
|
boehmes@36890
|
177 |
if Thm.nprems_of thm = 0 then thm
|
boehmes@36890
|
178 |
else discharge_definitions (@{thm reflexive} RS thm)
|
boehmes@36890
|
179 |
|
boehmes@40403
|
180 |
fun set_has_datatypes with_datatypes translate =
|
boehmes@36890
|
181 |
let
|
boehmes@40403
|
182 |
val {prefixes, header, strict, builtins, serialize} = translate
|
boehmes@40403
|
183 |
val {builtin_typ, builtin_num, builtin_fun, has_datatypes} = builtins
|
boehmes@40403
|
184 |
val with_datatypes' = has_datatypes andalso with_datatypes
|
boehmes@40403
|
185 |
val builtins' = {builtin_typ=builtin_typ, builtin_num=builtin_num,
|
boehmes@40403
|
186 |
builtin_fun=builtin_fun, has_datatypes=with_datatypes}
|
boehmes@40403
|
187 |
val translate' = {prefixes=prefixes, header=header, strict=strict,
|
boehmes@40403
|
188 |
builtins=builtins', serialize=serialize}
|
boehmes@40403
|
189 |
in (with_datatypes', translate') end
|
boehmes@40403
|
190 |
|
boehmes@40405
|
191 |
fun trace_assumptions ctxt irules idxs =
|
boehmes@40405
|
192 |
let
|
boehmes@40405
|
193 |
val thms = filter (fn i => i >= 0) idxs
|
boehmes@40405
|
194 |
|> map_filter (AList.lookup (op =) irules)
|
boehmes@40405
|
195 |
in
|
boehmes@40651
|
196 |
if Config.get ctxt C.trace_used_facts andalso length thms > 0
|
boehmes@40405
|
197 |
then
|
boehmes@40405
|
198 |
tracing (Pretty.string_of (Pretty.big_list "SMT used facts:"
|
boehmes@40405
|
199 |
(map (Display.pretty_thm ctxt) thms)))
|
boehmes@40405
|
200 |
else ()
|
boehmes@40405
|
201 |
end
|
boehmes@40405
|
202 |
|
boehmes@40437
|
203 |
fun gen_solver name info rm ctxt irules =
|
boehmes@40403
|
204 |
let
|
boehmes@40651
|
205 |
val {env_var, is_remote, options, interface, reconstruct} = info
|
boehmes@36890
|
206 |
val {extra_norm, translate} = interface
|
boehmes@40403
|
207 |
val (with_datatypes, translate') =
|
boehmes@40651
|
208 |
set_has_datatypes (Config.get ctxt C.datatypes) translate
|
boehmes@40437
|
209 |
val cmd = (rm, env_var, is_remote, name)
|
boehmes@36890
|
210 |
in
|
boehmes@40403
|
211 |
(irules, ctxt)
|
boehmes@40651
|
212 |
|-> SMT_Normalize.normalize extra_norm with_datatypes
|
boehmes@40651
|
213 |
|-> invoke translate' name cmd options
|
boehmes@36890
|
214 |
|-> reconstruct
|
boehmes@40402
|
215 |
|-> (fn (idxs, thm) => fn ctxt' => thm
|
boehmes@36890
|
216 |
|> singleton (ProofContext.export ctxt' ctxt)
|
boehmes@40402
|
217 |
|> discharge_definitions
|
boehmes@40405
|
218 |
|> tap (fn _ => trace_assumptions ctxt irules idxs)
|
boehmes@40402
|
219 |
|> pair idxs)
|
boehmes@36890
|
220 |
end
|
boehmes@36890
|
221 |
|
boehmes@36890
|
222 |
|
boehmes@36890
|
223 |
|
boehmes@40651
|
224 |
(* registry *)
|
boehmes@36890
|
225 |
|
boehmes@40437
|
226 |
type solver = bool option -> Proof.context -> (int * thm) list -> int list * thm
|
boehmes@40403
|
227 |
|
boehmes@40403
|
228 |
type solver_info = {
|
boehmes@40403
|
229 |
env_var: string,
|
boehmes@40403
|
230 |
is_remote: bool,
|
boehmes@40403
|
231 |
options: Proof.context -> string list,
|
boehmes@40403
|
232 |
interface: interface,
|
boehmes@40403
|
233 |
reconstruct: string list * SMT_Translate.recon -> Proof.context ->
|
boehmes@40403
|
234 |
(int list * thm) * Proof.context }
|
boehmes@36890
|
235 |
|
boehmes@36891
|
236 |
structure Solvers = Generic_Data
|
boehmes@36890
|
237 |
(
|
boehmes@40403
|
238 |
type T = solver_info Symtab.table
|
boehmes@36890
|
239 |
val empty = Symtab.empty
|
boehmes@36890
|
240 |
val extend = I
|
boehmes@36890
|
241 |
fun merge data = Symtab.merge (K true) data
|
boehmes@36890
|
242 |
handle Symtab.DUP name => error ("Duplicate SMT solver: " ^ quote name)
|
boehmes@36890
|
243 |
)
|
boehmes@36890
|
244 |
|
boehmes@40403
|
245 |
local
|
boehmes@40403
|
246 |
fun finish outcome cex_parser reconstruct ocl (output, recon) ctxt =
|
boehmes@40403
|
247 |
(case outcome output of
|
boehmes@40403
|
248 |
(Unsat, ls) =>
|
boehmes@40651
|
249 |
if not (Config.get ctxt C.oracle) andalso is_some reconstruct
|
boehmes@40403
|
250 |
then the reconstruct ctxt recon ls
|
boehmes@40403
|
251 |
else (([], ocl ()), ctxt)
|
boehmes@40403
|
252 |
| (result, ls) =>
|
boehmes@40403
|
253 |
let val ts = (case cex_parser of SOME f => f ctxt recon ls | _ => [])
|
boehmes@40651
|
254 |
in
|
boehmes@40651
|
255 |
raise SMT_Failure.SMT (SMT_Failure.Counterexample (result = Sat, ts))
|
boehmes@40651
|
256 |
end)
|
boehmes@40403
|
257 |
in
|
boehmes@40403
|
258 |
|
boehmes@40403
|
259 |
fun add_solver cfg =
|
boehmes@40403
|
260 |
let
|
boehmes@40403
|
261 |
val {name, env_var, is_remote, options, interface, outcome, cex_parser,
|
boehmes@40403
|
262 |
reconstruct} = cfg
|
boehmes@40403
|
263 |
|
boehmes@40403
|
264 |
fun core_oracle () = @{cprop False}
|
boehmes@40403
|
265 |
|
boehmes@40403
|
266 |
fun solver ocl = { env_var=env_var, is_remote=is_remote, options=options,
|
boehmes@40651
|
267 |
interface=interface,
|
boehmes@40403
|
268 |
reconstruct=finish (outcome name) cex_parser reconstruct ocl }
|
boehmes@40403
|
269 |
in
|
boehmes@40403
|
270 |
Thm.add_oracle (Binding.name name, core_oracle) #-> (fn (_, ocl) =>
|
boehmes@40403
|
271 |
Context.theory_map (Solvers.map (Symtab.update_new (name, solver ocl)))) #>
|
boehmes@40651
|
272 |
Context.theory_map (C.add_solver name)
|
boehmes@40403
|
273 |
end
|
boehmes@40403
|
274 |
|
boehmes@40403
|
275 |
end
|
boehmes@40403
|
276 |
|
boehmes@40651
|
277 |
fun name_and_solver_of ctxt =
|
boehmes@40651
|
278 |
let val name = C.solver_of ctxt
|
boehmes@40651
|
279 |
in (name, the (Symtab.lookup (Solvers.get (Context.Proof ctxt)) name)) end
|
boehmes@36890
|
280 |
|
boehmes@40651
|
281 |
fun solver_of ctxt =
|
boehmes@40651
|
282 |
let val (name, raw_solver) = name_and_solver_of ctxt
|
boehmes@40651
|
283 |
in gen_solver name raw_solver end
|
boehmes@36890
|
284 |
|
boehmes@40407
|
285 |
fun is_locally_installed ctxt =
|
boehmes@40651
|
286 |
let val (_, {env_var, ...}) = name_and_solver_of ctxt
|
boehmes@40407
|
287 |
in is_some (get_local_solver env_var) end
|
boehmes@40407
|
288 |
|
boehmes@36890
|
289 |
|
boehmes@36890
|
290 |
|
boehmes@40651
|
291 |
(* filter *)
|
boehmes@40402
|
292 |
|
boehmes@40402
|
293 |
val has_topsort = Term.exists_type (Term.exists_subtype (fn
|
boehmes@40402
|
294 |
TFree (_, []) => true
|
boehmes@40402
|
295 |
| TVar (_, []) => true
|
boehmes@40402
|
296 |
| _ => false))
|
boehmes@40402
|
297 |
|
boehmes@40437
|
298 |
fun smt_solver rm ctxt irules =
|
boehmes@40402
|
299 |
(* without this test, we would run into problems when atomizing the rules: *)
|
boehmes@40651
|
300 |
if exists (has_topsort o Thm.prop_of o snd) irules then
|
boehmes@40651
|
301 |
raise SMT_Failure.SMT (SMT_Failure.Other_Failure ("proof state " ^
|
boehmes@40651
|
302 |
"contains the universal sort {}"))
|
boehmes@40651
|
303 |
else solver_of ctxt rm ctxt irules
|
boehmes@40403
|
304 |
|
boehmes@40437
|
305 |
fun smt_filter run_remote time_limit st xrules i =
|
boehmes@40403
|
306 |
let
|
boehmes@40440
|
307 |
val {facts, goal, ...} = Proof.goal st
|
boehmes@40405
|
308 |
val ctxt =
|
boehmes@40440
|
309 |
Proof.context_of st
|
boehmes@40651
|
310 |
|> Config.put C.oracle false
|
boehmes@40801
|
311 |
|> Config.put C.timeout (Time.toReal time_limit)
|
boehmes@40651
|
312 |
|> Config.put C.drop_bad_facts true
|
boehmes@40651
|
313 |
|> Config.put C.filter_only_facts true
|
boehmes@40603
|
314 |
val ({context=ctxt', prems, concl, ...}, _) = Subgoal.focus ctxt i goal
|
boehmes@40403
|
315 |
val cprop =
|
boehmes@40603
|
316 |
concl
|
boehmes@40603
|
317 |
|> Thm.rhs_of o SMT_Normalize.atomize_conv ctxt'
|
boehmes@40403
|
318 |
|> Thm.capply @{cterm Trueprop} o Thm.capply @{cterm Not} o Thm.dest_arg
|
boehmes@40603
|
319 |
val irs = map (pair ~1) (Thm.assume cprop :: prems @ facts)
|
boehmes@40437
|
320 |
val rm = SOME run_remote
|
boehmes@40403
|
321 |
in
|
boehmes@40402
|
322 |
split_list xrules
|
boehmes@40603
|
323 |
||> distinct (op =) o fst o smt_solver rm ctxt' o append irs o map_index I
|
boehmes@40405
|
324 |
|-> map_filter o try o nth
|
boehmes@40438
|
325 |
|> (fn xs => {outcome=NONE, used_facts=xs, run_time_in_msecs=NONE})
|
boehmes@40403
|
326 |
end
|
boehmes@40651
|
327 |
handle SMT_Failure.SMT fail => {outcome=SOME fail, used_facts=[],
|
boehmes@40651
|
328 |
run_time_in_msecs=NONE}
|
boehmes@40407
|
329 |
(* FIXME: measure runtime *)
|
boehmes@40402
|
330 |
|
boehmes@40402
|
331 |
|
boehmes@40402
|
332 |
|
boehmes@36890
|
333 |
(* SMT tactic *)
|
boehmes@36890
|
334 |
|
boehmes@36890
|
335 |
fun smt_tac' pass_exns ctxt rules =
|
boehmes@36891
|
336 |
CONVERSION (SMT_Normalize.atomize_conv ctxt)
|
boehmes@36891
|
337 |
THEN' Tactic.rtac @{thm ccontr}
|
boehmes@40651
|
338 |
THEN' SUBPROOF (fn {context=ctxt', prems, ...} =>
|
boehmes@40406
|
339 |
let
|
boehmes@40651
|
340 |
fun solve irules = snd (smt_solver NONE ctxt' irules)
|
boehmes@40651
|
341 |
val tag = "Solver " ^ C.solver_of ctxt' ^ ": "
|
boehmes@40651
|
342 |
val str_of = SMT_Failure.string_of_failure ctxt'
|
boehmes@40651
|
343 |
fun safe_solve irules =
|
boehmes@40651
|
344 |
if pass_exns then SOME (solve irules)
|
boehmes@40759
|
345 |
else (SOME (solve irules)
|
boehmes@40759
|
346 |
handle
|
boehmes@40759
|
347 |
SMT_Failure.SMT (fail as SMT_Failure.Counterexample _) =>
|
boehmes@40759
|
348 |
(C.verbose_msg ctxt' (prefix tag o str_of) fail; NONE)
|
boehmes@40759
|
349 |
| SMT_Failure.SMT fail =>
|
boehmes@40759
|
350 |
(C.trace_msg ctxt' (prefix tag o str_of) fail; NONE))
|
boehmes@40406
|
351 |
in
|
boehmes@40651
|
352 |
safe_solve (map (pair ~1) (rules @ prems))
|
boehmes@40406
|
353 |
|> (fn SOME thm => Tactic.rtac thm 1 | _ => Tactical.no_tac)
|
boehmes@40407
|
354 |
end) ctxt
|
boehmes@36890
|
355 |
|
boehmes@36890
|
356 |
val smt_tac = smt_tac' false
|
boehmes@40403
|
357 |
|
boehmes@36890
|
358 |
val smt_method =
|
boehmes@36890
|
359 |
Scan.optional Attrib.thms [] >>
|
boehmes@36890
|
360 |
(fn thms => fn ctxt => METHOD (fn facts =>
|
boehmes@36890
|
361 |
HEADGOAL (smt_tac ctxt (thms @ facts))))
|
boehmes@36890
|
362 |
|
boehmes@36890
|
363 |
|
boehmes@36890
|
364 |
|
boehmes@36890
|
365 |
(* setup *)
|
boehmes@36890
|
366 |
|
boehmes@36890
|
367 |
val setup =
|
wenzelm@39075
|
368 |
Method.setup @{binding smt} smt_method
|
boehmes@36890
|
369 |
"Applies an SMT solver to the current goal."
|
boehmes@36890
|
370 |
|
boehmes@36890
|
371 |
end
|