author | boehmes |
Tue, 26 Oct 2010 11:39:26 +0200 | |
changeset 40161 | 539d07b00e5f |
parent 39811 | 0659e84bdc5f |
child 40162 | 7f58a9a843c2 |
permissions | -rw-r--r-- |
36898 | 1 |
(* Title: HOL/Tools/SMT/smt_solver.ML |
2 |
Author: Sascha Boehme, TU Muenchen |
|
3 |
||
4 |
SMT solvers registry and SMT tactic. |
|
5 |
*) |
|
6 |
||
7 |
signature SMT_SOLVER = |
|
8 |
sig |
|
9 |
exception SMT of string |
|
10 |
exception SMT_COUNTEREXAMPLE of bool * term list |
|
11 |
||
12 |
type interface = { |
|
13 |
extra_norm: SMT_Normalize.extra_norm, |
|
14 |
translate: SMT_Translate.config } |
|
15 |
type solver_config = { |
|
16 |
command: {env_var: string, remote_name: string option}, |
|
17 |
arguments: string list, |
|
18 |
interface: interface, |
|
19 |
reconstruct: (string list * SMT_Translate.recon) -> Proof.context -> |
|
40161
539d07b00e5f
keep track of theorems initially given to SMT (even if they are rewritten); provide interface to filter theorems necessary for SMT proofs
boehmes
parents:
39811
diff
changeset
|
20 |
(int list * thm) * Proof.context } |
36898 | 21 |
|
22 |
(*options*) |
|
23 |
val timeout: int Config.T |
|
24 |
val with_timeout: Proof.context -> ('a -> 'b) -> 'a -> 'b |
|
25 |
val trace: bool Config.T |
|
26 |
val trace_msg: Proof.context -> ('a -> string) -> 'a -> unit |
|
27 |
||
28 |
(*certificates*) |
|
29 |
val fixed_certificates: bool Config.T |
|
30 |
val select_certificates: string -> Context.generic -> Context.generic |
|
31 |
||
32 |
(*solvers*) |
|
40161
539d07b00e5f
keep track of theorems initially given to SMT (even if they are rewritten); provide interface to filter theorems necessary for SMT proofs
boehmes
parents:
39811
diff
changeset
|
33 |
type solver = Proof.context -> (int * thm) list -> int list * thm |
36898 | 34 |
type solver_info = Context.generic -> Pretty.T list |
36899
bcd6fce5bf06
layered SMT setup, adapted SMT clients, added further tests, made Z3 proof abstraction configurable
boehmes
parents:
36898
diff
changeset
|
35 |
val add_solver: string * (Proof.context -> solver_config) -> |
bcd6fce5bf06
layered SMT setup, adapted SMT clients, added further tests, made Z3 proof abstraction configurable
boehmes
parents:
36898
diff
changeset
|
36 |
Context.generic -> Context.generic |
bcd6fce5bf06
layered SMT setup, adapted SMT clients, added further tests, made Z3 proof abstraction configurable
boehmes
parents:
36898
diff
changeset
|
37 |
val all_solver_names_of: Context.generic -> string list |
bcd6fce5bf06
layered SMT setup, adapted SMT clients, added further tests, made Z3 proof abstraction configurable
boehmes
parents:
36898
diff
changeset
|
38 |
val add_solver_info: string * solver_info -> Context.generic -> |
bcd6fce5bf06
layered SMT setup, adapted SMT clients, added further tests, made Z3 proof abstraction configurable
boehmes
parents:
36898
diff
changeset
|
39 |
Context.generic |
36898 | 40 |
val solver_name_of: Context.generic -> string |
41 |
val select_solver: string -> Context.generic -> Context.generic |
|
42 |
val solver_of: Context.generic -> solver |
|
43 |
||
40161
539d07b00e5f
keep track of theorems initially given to SMT (even if they are rewritten); provide interface to filter theorems necessary for SMT proofs
boehmes
parents:
39811
diff
changeset
|
44 |
(*solver*) |
539d07b00e5f
keep track of theorems initially given to SMT (even if they are rewritten); provide interface to filter theorems necessary for SMT proofs
boehmes
parents:
39811
diff
changeset
|
45 |
val smt_solver: Proof.context -> ('a * thm) list -> 'a list * thm |
539d07b00e5f
keep track of theorems initially given to SMT (even if they are rewritten); provide interface to filter theorems necessary for SMT proofs
boehmes
parents:
39811
diff
changeset
|
46 |
val smt_filter: Proof.context -> ('a * thm) list -> 'a list * string |
539d07b00e5f
keep track of theorems initially given to SMT (even if they are rewritten); provide interface to filter theorems necessary for SMT proofs
boehmes
parents:
39811
diff
changeset
|
47 |
|
36898 | 48 |
(*tactic*) |
49 |
val smt_tac': bool -> Proof.context -> thm list -> int -> Tactical.tactic |
|
50 |
val smt_tac: Proof.context -> thm list -> int -> Tactical.tactic |
|
51 |
||
52 |
(*setup*) |
|
53 |
val setup: theory -> theory |
|
54 |
val print_setup: Context.generic -> unit |
|
55 |
end |
|
56 |
||
57 |
structure SMT_Solver: SMT_SOLVER = |
|
58 |
struct |
|
59 |
||
60 |
exception SMT of string |
|
61 |
exception SMT_COUNTEREXAMPLE of bool * term list |
|
62 |
||
63 |
||
64 |
type interface = { |
|
65 |
extra_norm: SMT_Normalize.extra_norm, |
|
66 |
translate: SMT_Translate.config } |
|
67 |
||
68 |
type solver_config = { |
|
69 |
command: {env_var: string, remote_name: string option}, |
|
70 |
arguments: string list, |
|
71 |
interface: interface, |
|
72 |
reconstruct: (string list * SMT_Translate.recon) -> Proof.context -> |
|
40161
539d07b00e5f
keep track of theorems initially given to SMT (even if they are rewritten); provide interface to filter theorems necessary for SMT proofs
boehmes
parents:
39811
diff
changeset
|
73 |
(int list * thm) * Proof.context } |
36898 | 74 |
|
75 |
||
76 |
||
77 |
(* SMT options *) |
|
78 |
||
79 |
val (timeout, setup_timeout) = Attrib.config_int "smt_timeout" (K 30) |
|
80 |
||
81 |
fun with_timeout ctxt f x = |
|
82 |
TimeLimit.timeLimit (Time.fromSeconds (Config.get ctxt timeout)) f x |
|
83 |
handle TimeLimit.TimeOut => raise SMT "timeout" |
|
84 |
||
85 |
val (trace, setup_trace) = Attrib.config_bool "smt_trace" (K false) |
|
86 |
||
87 |
fun trace_msg ctxt f x = |
|
88 |
if Config.get ctxt trace then tracing (f x) else () |
|
89 |
||
90 |
||
91 |
||
92 |
(* SMT certificates *) |
|
93 |
||
94 |
val (fixed_certificates, setup_fixed_certificates) = |
|
95 |
Attrib.config_bool "smt_fixed" (K false) |
|
96 |
||
97 |
structure Certificates = Generic_Data |
|
98 |
( |
|
99 |
type T = Cache_IO.cache option |
|
100 |
val empty = NONE |
|
101 |
val extend = I |
|
102 |
fun merge (s, _) = s |
|
103 |
) |
|
104 |
||
105 |
val get_certificates_path = |
|
106 |
Option.map (Cache_IO.cache_path_of) o Certificates.get |
|
107 |
||
108 |
fun select_certificates name = Certificates.put ( |
|
109 |
if name = "" then NONE |
|
110 |
else SOME (Cache_IO.make (Path.explode name))) |
|
111 |
||
112 |
||
113 |
||
114 |
(* interface to external solvers *) |
|
115 |
||
116 |
local |
|
117 |
||
118 |
fun choose {env_var, remote_name} = |
|
119 |
let |
|
120 |
val local_solver = getenv env_var |
|
121 |
val remote_solver = the_default "" remote_name |
|
122 |
val remote_url = getenv "REMOTE_SMT_URL" |
|
123 |
in |
|
124 |
if local_solver <> "" |
|
125 |
then |
|
126 |
(tracing ("Invoking local SMT solver " ^ quote local_solver ^ " ..."); |
|
127 |
[local_solver]) |
|
128 |
else if remote_solver <> "" |
|
129 |
then |
|
130 |
(tracing ("Invoking remote SMT solver " ^ quote remote_solver ^ " at " ^ |
|
131 |
quote remote_url ^ " ..."); |
|
132 |
[getenv "REMOTE_SMT", remote_solver]) |
|
133 |
else error ("Undefined Isabelle environment variable: " ^ quote env_var) |
|
134 |
end |
|
135 |
||
136 |
fun make_cmd solver args problem_path proof_path = space_implode " " ( |
|
137 |
map File.shell_quote (solver @ args) @ |
|
138 |
[File.shell_path problem_path, "2>&1", ">", File.shell_path proof_path]) |
|
139 |
||
140 |
fun run ctxt cmd args input = |
|
141 |
(case Certificates.get (Context.Proof ctxt) of |
|
142 |
NONE => Cache_IO.run (make_cmd (choose cmd) args) input |
|
143 |
| SOME certs => |
|
144 |
(case Cache_IO.lookup certs input of |
|
145 |
(NONE, key) => |
|
146 |
if Config.get ctxt fixed_certificates |
|
147 |
then error ("Bad certificates cache: missing certificate") |
|
148 |
else Cache_IO.run_and_cache certs key (make_cmd (choose cmd) args) |
|
149 |
input |
|
150 |
| (SOME output, _) => |
|
151 |
(tracing ("Using cached certificate from " ^ |
|
152 |
File.shell_path (Cache_IO.cache_path_of certs) ^ " ..."); |
|
153 |
output))) |
|
154 |
||
155 |
in |
|
156 |
||
157 |
fun run_solver ctxt cmd args input = |
|
158 |
let |
|
159 |
fun pretty tag ls = Pretty.string_of (Pretty.big_list tag |
|
160 |
(map Pretty.str ls)) |
|
161 |
||
162 |
val _ = trace_msg ctxt (pretty "SMT problem:" o split_lines) input |
|
163 |
||
164 |
val (res, err) = with_timeout ctxt (run ctxt cmd args) input |
|
165 |
val _ = trace_msg ctxt (pretty "SMT solver:") err |
|
166 |
||
39811 | 167 |
val ls = rev (snd (chop_while (equal "") (rev res))) |
36898 | 168 |
val _ = trace_msg ctxt (pretty "SMT result:") ls |
169 |
in ls end |
|
170 |
||
171 |
end |
|
172 |
||
36940 | 173 |
fun trace_recon_data ctxt ({typs, terms, ...} : SMT_Translate.recon) = |
36898 | 174 |
let |
175 |
fun pretty_eq n p = Pretty.block [Pretty.str n, Pretty.str " = ", p] |
|
176 |
fun pretty_typ (n, T) = pretty_eq n (Syntax.pretty_typ ctxt T) |
|
177 |
fun pretty_term (n, t) = pretty_eq n (Syntax.pretty_term ctxt t) |
|
178 |
in |
|
179 |
trace_msg ctxt (fn () => Pretty.string_of (Pretty.big_list "SMT names:" [ |
|
180 |
Pretty.big_list "sorts:" (map pretty_typ (Symtab.dest typs)), |
|
181 |
Pretty.big_list "functions:" (map pretty_term (Symtab.dest terms))])) () |
|
182 |
end |
|
183 |
||
40161
539d07b00e5f
keep track of theorems initially given to SMT (even if they are rewritten); provide interface to filter theorems necessary for SMT proofs
boehmes
parents:
39811
diff
changeset
|
184 |
fun invoke translate_config comments command arguments irules ctxt = |
539d07b00e5f
keep track of theorems initially given to SMT (even if they are rewritten); provide interface to filter theorems necessary for SMT proofs
boehmes
parents:
39811
diff
changeset
|
185 |
irules |
36898 | 186 |
|> SMT_Translate.translate translate_config ctxt comments |
187 |
||> tap (trace_recon_data ctxt) |
|
188 |
|>> run_solver ctxt command arguments |
|
189 |
|> rpair ctxt |
|
190 |
||
191 |
fun discharge_definitions thm = |
|
192 |
if Thm.nprems_of thm = 0 then thm |
|
193 |
else discharge_definitions (@{thm reflexive} RS thm) |
|
194 |
||
195 |
fun gen_solver name solver ctxt prems = |
|
196 |
let |
|
197 |
val {command, arguments, interface, reconstruct} = solver ctxt |
|
198 |
val comments = ("solver: " ^ name) :: |
|
199 |
("timeout: " ^ string_of_int (Config.get ctxt timeout)) :: |
|
200 |
"arguments:" :: arguments |
|
201 |
val {extra_norm, translate} = interface |
|
39483
9f0e5684f04b
add full support for datatypes to the SMT interface (only used by Z3 in oracle mode so far); added store to keep track of datatype selector functions
boehmes
parents:
38808
diff
changeset
|
202 |
val {builtins, ...} = translate |
9f0e5684f04b
add full support for datatypes to the SMT interface (only used by Z3 in oracle mode so far); added store to keep track of datatype selector functions
boehmes
parents:
38808
diff
changeset
|
203 |
val {has_datatypes, ...} = builtins |
36898 | 204 |
in |
205 |
(prems, ctxt) |
|
39483
9f0e5684f04b
add full support for datatypes to the SMT interface (only used by Z3 in oracle mode so far); added store to keep track of datatype selector functions
boehmes
parents:
38808
diff
changeset
|
206 |
|-> SMT_Normalize.normalize extra_norm has_datatypes |
36898 | 207 |
|-> invoke translate comments command arguments |
208 |
|-> reconstruct |
|
40161
539d07b00e5f
keep track of theorems initially given to SMT (even if they are rewritten); provide interface to filter theorems necessary for SMT proofs
boehmes
parents:
39811
diff
changeset
|
209 |
|-> (fn (idxs, thm) => fn ctxt' => thm |
36898 | 210 |
|> singleton (ProofContext.export ctxt' ctxt) |
40161
539d07b00e5f
keep track of theorems initially given to SMT (even if they are rewritten); provide interface to filter theorems necessary for SMT proofs
boehmes
parents:
39811
diff
changeset
|
211 |
|> discharge_definitions |
539d07b00e5f
keep track of theorems initially given to SMT (even if they are rewritten); provide interface to filter theorems necessary for SMT proofs
boehmes
parents:
39811
diff
changeset
|
212 |
|> pair idxs) |
36898 | 213 |
end |
214 |
||
215 |
||
216 |
||
217 |
(* solver store *) |
|
218 |
||
40161
539d07b00e5f
keep track of theorems initially given to SMT (even if they are rewritten); provide interface to filter theorems necessary for SMT proofs
boehmes
parents:
39811
diff
changeset
|
219 |
type solver = Proof.context -> (int * thm) list -> int list * thm |
36898 | 220 |
type solver_info = Context.generic -> Pretty.T list |
221 |
||
36899
bcd6fce5bf06
layered SMT setup, adapted SMT clients, added further tests, made Z3 proof abstraction configurable
boehmes
parents:
36898
diff
changeset
|
222 |
structure Solvers = Generic_Data |
36898 | 223 |
( |
224 |
type T = ((Proof.context -> solver_config) * solver_info) Symtab.table |
|
225 |
val empty = Symtab.empty |
|
226 |
val extend = I |
|
227 |
fun merge data = Symtab.merge (K true) data |
|
228 |
handle Symtab.DUP name => error ("Duplicate SMT solver: " ^ quote name) |
|
229 |
) |
|
230 |
||
231 |
val no_solver = "(none)" |
|
232 |
val add_solver = Solvers.map o Symtab.update_new o apsnd (rpair (K [])) |
|
233 |
val all_solver_names_of = Symtab.keys o Solvers.get |
|
234 |
val lookup_solver = Symtab.lookup o Solvers.get |
|
235 |
fun add_solver_info (n, i) = Solvers.map (Symtab.map_entry n (apsnd (K i))) |
|
236 |
||
237 |
||
238 |
||
239 |
(* selected solver *) |
|
240 |
||
241 |
structure Selected_Solver = Generic_Data |
|
242 |
( |
|
243 |
type T = string |
|
244 |
val empty = no_solver |
|
245 |
val extend = I |
|
246 |
fun merge (s, _) = s |
|
247 |
) |
|
248 |
||
249 |
val solver_name_of = Selected_Solver.get |
|
250 |
||
251 |
fun select_solver name context = |
|
36899
bcd6fce5bf06
layered SMT setup, adapted SMT clients, added further tests, made Z3 proof abstraction configurable
boehmes
parents:
36898
diff
changeset
|
252 |
if is_none (lookup_solver context name) |
36898 | 253 |
then error ("SMT solver not registered: " ^ quote name) |
254 |
else Selected_Solver.map (K name) context |
|
255 |
||
256 |
fun raw_solver_of context name = |
|
36899
bcd6fce5bf06
layered SMT setup, adapted SMT clients, added further tests, made Z3 proof abstraction configurable
boehmes
parents:
36898
diff
changeset
|
257 |
(case lookup_solver context name of |
36898 | 258 |
NONE => error "No SMT solver selected" |
259 |
| SOME (s, _) => s) |
|
260 |
||
261 |
fun solver_of context = |
|
262 |
let val name = solver_name_of context |
|
263 |
in gen_solver name (raw_solver_of context name) end |
|
264 |
||
265 |
||
266 |
||
40161
539d07b00e5f
keep track of theorems initially given to SMT (even if they are rewritten); provide interface to filter theorems necessary for SMT proofs
boehmes
parents:
39811
diff
changeset
|
267 |
(* SMT solver *) |
539d07b00e5f
keep track of theorems initially given to SMT (even if they are rewritten); provide interface to filter theorems necessary for SMT proofs
boehmes
parents:
39811
diff
changeset
|
268 |
|
539d07b00e5f
keep track of theorems initially given to SMT (even if they are rewritten); provide interface to filter theorems necessary for SMT proofs
boehmes
parents:
39811
diff
changeset
|
269 |
val has_topsort = Term.exists_type (Term.exists_subtype (fn |
539d07b00e5f
keep track of theorems initially given to SMT (even if they are rewritten); provide interface to filter theorems necessary for SMT proofs
boehmes
parents:
39811
diff
changeset
|
270 |
TFree (_, []) => true |
539d07b00e5f
keep track of theorems initially given to SMT (even if they are rewritten); provide interface to filter theorems necessary for SMT proofs
boehmes
parents:
39811
diff
changeset
|
271 |
| TVar (_, []) => true |
539d07b00e5f
keep track of theorems initially given to SMT (even if they are rewritten); provide interface to filter theorems necessary for SMT proofs
boehmes
parents:
39811
diff
changeset
|
272 |
| _ => false)) |
539d07b00e5f
keep track of theorems initially given to SMT (even if they are rewritten); provide interface to filter theorems necessary for SMT proofs
boehmes
parents:
39811
diff
changeset
|
273 |
|
539d07b00e5f
keep track of theorems initially given to SMT (even if they are rewritten); provide interface to filter theorems necessary for SMT proofs
boehmes
parents:
39811
diff
changeset
|
274 |
fun smt_solver ctxt xrules = |
539d07b00e5f
keep track of theorems initially given to SMT (even if they are rewritten); provide interface to filter theorems necessary for SMT proofs
boehmes
parents:
39811
diff
changeset
|
275 |
(* without this test, we would run into problems when atomizing the rules: *) |
539d07b00e5f
keep track of theorems initially given to SMT (even if they are rewritten); provide interface to filter theorems necessary for SMT proofs
boehmes
parents:
39811
diff
changeset
|
276 |
if exists (has_topsort o Thm.prop_of o snd) xrules |
539d07b00e5f
keep track of theorems initially given to SMT (even if they are rewritten); provide interface to filter theorems necessary for SMT proofs
boehmes
parents:
39811
diff
changeset
|
277 |
then raise SMT "proof state contains the universal sort {}" |
539d07b00e5f
keep track of theorems initially given to SMT (even if they are rewritten); provide interface to filter theorems necessary for SMT proofs
boehmes
parents:
39811
diff
changeset
|
278 |
else |
539d07b00e5f
keep track of theorems initially given to SMT (even if they are rewritten); provide interface to filter theorems necessary for SMT proofs
boehmes
parents:
39811
diff
changeset
|
279 |
split_list xrules |
539d07b00e5f
keep track of theorems initially given to SMT (even if they are rewritten); provide interface to filter theorems necessary for SMT proofs
boehmes
parents:
39811
diff
changeset
|
280 |
||>> solver_of (Context.Proof ctxt) ctxt o map_index I |
539d07b00e5f
keep track of theorems initially given to SMT (even if they are rewritten); provide interface to filter theorems necessary for SMT proofs
boehmes
parents:
39811
diff
changeset
|
281 |
|>> uncurry (map_filter o try o nth) o apsnd (distinct (op =)) |
539d07b00e5f
keep track of theorems initially given to SMT (even if they are rewritten); provide interface to filter theorems necessary for SMT proofs
boehmes
parents:
39811
diff
changeset
|
282 |
|
539d07b00e5f
keep track of theorems initially given to SMT (even if they are rewritten); provide interface to filter theorems necessary for SMT proofs
boehmes
parents:
39811
diff
changeset
|
283 |
fun smt_filter ctxt xrules = |
539d07b00e5f
keep track of theorems initially given to SMT (even if they are rewritten); provide interface to filter theorems necessary for SMT proofs
boehmes
parents:
39811
diff
changeset
|
284 |
(fst (smt_solver ctxt xrules), "") |
539d07b00e5f
keep track of theorems initially given to SMT (even if they are rewritten); provide interface to filter theorems necessary for SMT proofs
boehmes
parents:
39811
diff
changeset
|
285 |
handle SMT msg => ([], "SMT: " ^ msg) |
539d07b00e5f
keep track of theorems initially given to SMT (even if they are rewritten); provide interface to filter theorems necessary for SMT proofs
boehmes
parents:
39811
diff
changeset
|
286 |
| SMT_COUNTEREXAMPLE _ => ([], "SMT: potential counterexample") |
539d07b00e5f
keep track of theorems initially given to SMT (even if they are rewritten); provide interface to filter theorems necessary for SMT proofs
boehmes
parents:
39811
diff
changeset
|
287 |
|
539d07b00e5f
keep track of theorems initially given to SMT (even if they are rewritten); provide interface to filter theorems necessary for SMT proofs
boehmes
parents:
39811
diff
changeset
|
288 |
|
539d07b00e5f
keep track of theorems initially given to SMT (even if they are rewritten); provide interface to filter theorems necessary for SMT proofs
boehmes
parents:
39811
diff
changeset
|
289 |
|
36898 | 290 |
(* SMT tactic *) |
291 |
||
292 |
local |
|
293 |
fun pretty_cex ctxt (real, ex) = |
|
294 |
let |
|
295 |
val msg = if real then "SMT: counterexample found" |
|
296 |
else "SMT: potential counterexample found" |
|
297 |
in |
|
298 |
if null ex then msg ^ "." |
|
299 |
else Pretty.string_of (Pretty.big_list (msg ^ ":") |
|
300 |
(map (Syntax.pretty_term ctxt) ex)) |
|
301 |
end |
|
302 |
||
303 |
fun fail_tac f msg st = (f msg; Tactical.no_tac st) |
|
304 |
||
305 |
fun SAFE pass_exns tac ctxt i st = |
|
306 |
if pass_exns then tac ctxt i st |
|
307 |
else (tac ctxt i st |
|
308 |
handle SMT msg => fail_tac (trace_msg ctxt (prefix "SMT: ")) msg st |
|
309 |
| SMT_COUNTEREXAMPLE ce => fail_tac tracing (pretty_cex ctxt ce) st) |
|
310 |
in |
|
311 |
fun smt_tac' pass_exns ctxt rules = |
|
36899
bcd6fce5bf06
layered SMT setup, adapted SMT clients, added further tests, made Z3 proof abstraction configurable
boehmes
parents:
36898
diff
changeset
|
312 |
CONVERSION (SMT_Normalize.atomize_conv ctxt) |
bcd6fce5bf06
layered SMT setup, adapted SMT clients, added further tests, made Z3 proof abstraction configurable
boehmes
parents:
36898
diff
changeset
|
313 |
THEN' Tactic.rtac @{thm ccontr} |
bcd6fce5bf06
layered SMT setup, adapted SMT clients, added further tests, made Z3 proof abstraction configurable
boehmes
parents:
36898
diff
changeset
|
314 |
THEN' SUBPROOF (fn {context, prems, ...} => |
40161
539d07b00e5f
keep track of theorems initially given to SMT (even if they are rewritten); provide interface to filter theorems necessary for SMT proofs
boehmes
parents:
39811
diff
changeset
|
315 |
let fun solve cx = snd (smt_solver cx (map (pair ()) (rules @ prems))) |
539d07b00e5f
keep track of theorems initially given to SMT (even if they are rewritten); provide interface to filter theorems necessary for SMT proofs
boehmes
parents:
39811
diff
changeset
|
316 |
in SAFE pass_exns (Tactic.rtac o solve) context 1 end) ctxt |
36898 | 317 |
|
318 |
val smt_tac = smt_tac' false |
|
319 |
end |
|
320 |
||
321 |
val smt_method = |
|
322 |
Scan.optional Attrib.thms [] >> |
|
323 |
(fn thms => fn ctxt => METHOD (fn facts => |
|
324 |
HEADGOAL (smt_tac ctxt (thms @ facts)))) |
|
325 |
||
326 |
||
327 |
||
328 |
(* setup *) |
|
329 |
||
330 |
val setup = |
|
38808 | 331 |
Attrib.setup @{binding smt_solver} |
36960
01594f816e3a
prefer structure Keyword, Parse, Parse_Spec, Outer_Syntax;
wenzelm
parents:
36940
diff
changeset
|
332 |
(Scan.lift (Parse.$$$ "=" |-- Args.name) >> |
36898 | 333 |
(Thm.declaration_attribute o K o select_solver)) |
334 |
"SMT solver configuration" #> |
|
335 |
setup_timeout #> |
|
336 |
setup_trace #> |
|
337 |
setup_fixed_certificates #> |
|
38808 | 338 |
Attrib.setup @{binding smt_certificates} |
36960
01594f816e3a
prefer structure Keyword, Parse, Parse_Spec, Outer_Syntax;
wenzelm
parents:
36940
diff
changeset
|
339 |
(Scan.lift (Parse.$$$ "=" |-- Args.name) >> |
36898 | 340 |
(Thm.declaration_attribute o K o select_certificates)) |
341 |
"SMT certificates" #> |
|
38808 | 342 |
Method.setup @{binding smt} smt_method |
36898 | 343 |
"Applies an SMT solver to the current goal." |
344 |
||
345 |
||
36899
bcd6fce5bf06
layered SMT setup, adapted SMT clients, added further tests, made Z3 proof abstraction configurable
boehmes
parents:
36898
diff
changeset
|
346 |
fun print_setup context = |
36898 | 347 |
let |
36899
bcd6fce5bf06
layered SMT setup, adapted SMT clients, added further tests, made Z3 proof abstraction configurable
boehmes
parents:
36898
diff
changeset
|
348 |
val t = string_of_int (Config.get_generic context timeout) |
bcd6fce5bf06
layered SMT setup, adapted SMT clients, added further tests, made Z3 proof abstraction configurable
boehmes
parents:
36898
diff
changeset
|
349 |
val names = sort_strings (all_solver_names_of context) |
36898 | 350 |
val ns = if null names then [no_solver] else names |
351 |
val take_info = (fn (_, []) => NONE | info => SOME info) |
|
352 |
val infos = |
|
36899
bcd6fce5bf06
layered SMT setup, adapted SMT clients, added further tests, made Z3 proof abstraction configurable
boehmes
parents:
36898
diff
changeset
|
353 |
Solvers.get context |
bcd6fce5bf06
layered SMT setup, adapted SMT clients, added further tests, made Z3 proof abstraction configurable
boehmes
parents:
36898
diff
changeset
|
354 |
|> Symtab.dest |
bcd6fce5bf06
layered SMT setup, adapted SMT clients, added further tests, made Z3 proof abstraction configurable
boehmes
parents:
36898
diff
changeset
|
355 |
|> map_filter (fn (n, (_, info)) => take_info (n, info context)) |
36898 | 356 |
|> sort (prod_ord string_ord (K EQUAL)) |
357 |
|> map (fn (n, ps) => Pretty.big_list (n ^ ":") ps) |
|
358 |
val certs_filename = |
|
36899
bcd6fce5bf06
layered SMT setup, adapted SMT clients, added further tests, made Z3 proof abstraction configurable
boehmes
parents:
36898
diff
changeset
|
359 |
(case get_certificates_path context of |
36898 | 360 |
SOME path => Path.implode path |
361 |
| NONE => "(disabled)") |
|
36899
bcd6fce5bf06
layered SMT setup, adapted SMT clients, added further tests, made Z3 proof abstraction configurable
boehmes
parents:
36898
diff
changeset
|
362 |
val fixed = if Config.get_generic context fixed_certificates then "true" |
36898 | 363 |
else "false" |
364 |
in |
|
365 |
Pretty.writeln (Pretty.big_list "SMT setup:" [ |
|
36899
bcd6fce5bf06
layered SMT setup, adapted SMT clients, added further tests, made Z3 proof abstraction configurable
boehmes
parents:
36898
diff
changeset
|
366 |
Pretty.str ("Current SMT solver: " ^ solver_name_of context), |
36898 | 367 |
Pretty.str_list "Available SMT solvers: " "" ns, |
368 |
Pretty.str ("Current timeout: " ^ t ^ " seconds"), |
|
369 |
Pretty.str ("Certificates cache: " ^ certs_filename), |
|
370 |
Pretty.str ("Fixed certificates: " ^ fixed), |
|
371 |
Pretty.big_list "Solver-specific settings:" infos]) |
|
372 |
end |
|
373 |
||
36960
01594f816e3a
prefer structure Keyword, Parse, Parse_Spec, Outer_Syntax;
wenzelm
parents:
36940
diff
changeset
|
374 |
val _ = |
01594f816e3a
prefer structure Keyword, Parse, Parse_Spec, Outer_Syntax;
wenzelm
parents:
36940
diff
changeset
|
375 |
Outer_Syntax.improper_command "smt_status" |
40161
539d07b00e5f
keep track of theorems initially given to SMT (even if they are rewritten); provide interface to filter theorems necessary for SMT proofs
boehmes
parents:
39811
diff
changeset
|
376 |
"show the available SMT solvers and the currently selected solver" |
539d07b00e5f
keep track of theorems initially given to SMT (even if they are rewritten); provide interface to filter theorems necessary for SMT proofs
boehmes
parents:
39811
diff
changeset
|
377 |
Keyword.diag |
36898 | 378 |
(Scan.succeed (Toplevel.no_timing o Toplevel.keep (fn state => |
379 |
print_setup (Context.Proof (Toplevel.context_of state))))) |
|
380 |
||
381 |
end |