author | boehmes |
Mon, 29 Dec 2014 22:14:13 +0100 | |
changeset 59215 | 35c13f4995b1 |
parent 59213 | ef5e68575bc4 |
child 59374 | 2f5447b764f9 |
permissions | -rw-r--r-- |
58061 | 1 |
(* Title: HOL/Tools/SMT/z3_replay.ML |
56078
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
2 |
Author: Sascha Boehme, TU Muenchen |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
3 |
Author: Jasmin Blanchette, TU Muenchen |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
4 |
|
57219
34018603e0d0
factor out SMT-LIB 2 type/term parsing from Z3-specific code
blanchet
parents:
57165
diff
changeset
|
5 |
Z3 proof parsing and replay. |
56078
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
6 |
*) |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
7 |
|
58061 | 8 |
signature Z3_REPLAY = |
56078
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
9 |
sig |
58061 | 10 |
val parse_proof: Proof.context -> SMT_Translate.replay_data -> |
57164 | 11 |
((string * ATP_Problem_Generate.stature) * thm) list -> term list -> term -> string list -> |
58061 | 12 |
SMT_Solver.parsed_proof |
13 |
val replay: Proof.context -> SMT_Translate.replay_data -> string list -> thm |
|
57229 | 14 |
end; |
56078
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
15 |
|
58061 | 16 |
structure Z3_Replay: Z3_REPLAY = |
56078
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
17 |
struct |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
18 |
|
56245 | 19 |
fun params_of t = Term.strip_qnt_vars @{const_name Pure.all} t |
56078
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
20 |
|
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
21 |
fun varify ctxt thm = |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
22 |
let |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
23 |
val maxidx = Thm.maxidx_of thm + 1 |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
24 |
val vs = params_of (Thm.prop_of thm) |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
25 |
val vars = map_index (fn (i, (n, T)) => Var ((n, i + maxidx), T)) vs |
58061 | 26 |
in Drule.forall_elim_list (map (SMT_Util.certify ctxt) vars) thm end |
56078
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
27 |
|
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
28 |
fun add_paramTs names t = |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
29 |
fold2 (fn n => fn (_, T) => AList.update (op =) (n, T)) names (params_of t) |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
30 |
|
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
31 |
fun new_fixes ctxt nTs = |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
32 |
let |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
33 |
val (ns, ctxt') = Variable.variant_fixes (replicate (length nTs) "") ctxt |
58061 | 34 |
fun mk (n, T) n' = (n, SMT_Util.certify ctxt' (Free (n', T))) |
56078
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
35 |
in (ctxt', Symtab.make (map2 mk nTs ns)) end |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
36 |
|
56245 | 37 |
fun forall_elim_term ct (Const (@{const_name Pure.all}, _) $ (a as Abs _)) = |
56078
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
38 |
Term.betapply (a, Thm.term_of ct) |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
39 |
| forall_elim_term _ qt = raise TERM ("forall_elim'", [qt]) |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
40 |
|
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
41 |
fun apply_fixes elim env = fold (elim o the o Symtab.lookup env) |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
42 |
|
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
43 |
val apply_fixes_prem = uncurry o apply_fixes Thm.forall_elim |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
44 |
val apply_fixes_concl = apply_fixes forall_elim_term |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
45 |
|
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
46 |
fun export_fixes env names = Drule.forall_intr_list (map (the o Symtab.lookup env) names) |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
47 |
|
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
48 |
fun under_fixes f ctxt (prems, nthms) names concl = |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
49 |
let |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
50 |
val thms1 = map (varify ctxt) prems |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
51 |
val (ctxt', env) = |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
52 |
add_paramTs names concl [] |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
53 |
|> fold (uncurry add_paramTs o apsnd Thm.prop_of) nthms |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
54 |
|> new_fixes ctxt |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
55 |
val thms2 = map (apply_fixes_prem env) nthms |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
56 |
val t = apply_fixes_concl env names concl |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
57 |
in export_fixes env names (f ctxt' (thms1 @ thms2) t) end |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
58 |
|
58061 | 59 |
fun replay_thm ctxt assumed nthms (Z3_Proof.Z3_Step {id, rule, concl, fixes, is_fix_step, ...}) = |
60 |
if Z3_Proof.is_assumption rule then |
|
56078
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
61 |
(case Inttab.lookup assumed id of |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
62 |
SOME (_, thm) => thm |
58061 | 63 |
| NONE => Thm.assume (SMT_Util.certify ctxt concl)) |
56078
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
64 |
else |
58061 | 65 |
under_fixes (Z3_Replay_Methods.method_for rule) ctxt |
56078
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
66 |
(if is_fix_step then (map snd nthms, []) else ([], nthms)) fixes concl |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
67 |
|
59215
35c13f4995b1
optionally display statistics for Z3 proof reconstruction
boehmes
parents:
59213
diff
changeset
|
68 |
fun replay_step ctxt assumed (step as Z3_Proof.Z3_Step {id, rule, prems, fixes, ...}) state = |
59213
ef5e68575bc4
limit reconstruction time of Z3 proof steps to be able to detect long-running reconstruction steps
boehmes
parents:
58482
diff
changeset
|
69 |
let |
59215
35c13f4995b1
optionally display statistics for Z3 proof reconstruction
boehmes
parents:
59213
diff
changeset
|
70 |
val (proofs, stats) = state |
59213
ef5e68575bc4
limit reconstruction time of Z3 proof steps to be able to detect long-running reconstruction steps
boehmes
parents:
58482
diff
changeset
|
71 |
val nthms = map (the o Inttab.lookup proofs) prems |
59215
35c13f4995b1
optionally display statistics for Z3 proof reconstruction
boehmes
parents:
59213
diff
changeset
|
72 |
val replay = Timing.timing (replay_thm ctxt assumed nthms) |
35c13f4995b1
optionally display statistics for Z3 proof reconstruction
boehmes
parents:
59213
diff
changeset
|
73 |
val ({elapsed, ...}, thm) = |
35c13f4995b1
optionally display statistics for Z3 proof reconstruction
boehmes
parents:
59213
diff
changeset
|
74 |
SMT_Config.with_time_limit ctxt SMT_Config.reconstruction_step_timeout replay step |
59213
ef5e68575bc4
limit reconstruction time of Z3 proof steps to be able to detect long-running reconstruction steps
boehmes
parents:
58482
diff
changeset
|
75 |
handle TimeLimit.TimeOut => raise SMT_Failure.SMT SMT_Failure.Time_Out |
59215
35c13f4995b1
optionally display statistics for Z3 proof reconstruction
boehmes
parents:
59213
diff
changeset
|
76 |
val stats' = Symtab.cons_list (Z3_Proof.string_of_rule rule, Time.toMilliseconds elapsed) stats |
35c13f4995b1
optionally display statistics for Z3 proof reconstruction
boehmes
parents:
59213
diff
changeset
|
77 |
in (Inttab.update (id, (fixes, thm)) proofs, stats') end |
56078
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
78 |
|
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
79 |
local |
57230 | 80 |
val remove_trigger = mk_meta_eq @{thm trigger_def} |
81 |
val remove_fun_app = mk_meta_eq @{thm fun_app_def} |
|
56078
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
82 |
|
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
83 |
fun rewrite_conv _ [] = Conv.all_conv |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
84 |
| rewrite_conv ctxt eqs = Simplifier.full_rewrite (empty_simpset ctxt addsimps eqs) |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
85 |
|
58061 | 86 |
val prep_rules = [@{thm Let_def}, remove_trigger, remove_fun_app, Z3_Replay_Literals.rewrite_true] |
56078
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
87 |
|
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
88 |
fun rewrite _ [] = I |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
89 |
| rewrite ctxt eqs = Conv.fconv_rule (rewrite_conv ctxt eqs) |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
90 |
|
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
91 |
fun lookup_assm assms_net ct = |
58061 | 92 |
Z3_Replay_Util.net_instances assms_net ct |
56078
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
93 |
|> map (fn ithm as (_, thm) => (ithm, Thm.cprop_of thm aconvc ct)) |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
94 |
in |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
95 |
|
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
96 |
fun add_asserted outer_ctxt rewrite_rules assms steps ctxt = |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
97 |
let |
58061 | 98 |
val eqs = map (rewrite ctxt [Z3_Replay_Literals.rewrite_true]) rewrite_rules |
56078
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
99 |
val eqs' = union Thm.eq_thm eqs prep_rules |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
100 |
|
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
101 |
val assms_net = |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
102 |
assms |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
103 |
|> map (apsnd (rewrite ctxt eqs')) |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
104 |
|> map (apsnd (Conv.fconv_rule Thm.eta_conversion)) |
58061 | 105 |
|> Z3_Replay_Util.thm_net_of snd |
56078
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
106 |
|
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
107 |
fun revert_conv ctxt = rewrite_conv ctxt eqs' then_conv Thm.eta_conversion |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
108 |
|
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
109 |
fun assume thm ctxt = |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
110 |
let |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
111 |
val ct = Thm.cprem_of thm 1 |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
112 |
val (thm', ctxt') = yield_singleton Assumption.add_assumes ct ctxt |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
113 |
in (thm' RS thm, ctxt') end |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
114 |
|
56104
fd6e132ee4fb
correctly reconstruct helper facts (e.g. 'nat_int') in Isar proofs
blanchet
parents:
56099
diff
changeset
|
115 |
fun add1 id fixes thm1 ((i, th), exact) ((iidths, thms), (ctxt, ptab)) = |
56078
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
116 |
let |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
117 |
val (thm, ctxt') = if exact then (Thm.implies_elim thm1 th, ctxt) else assume thm1 ctxt |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
118 |
val thms' = if exact then thms else th :: thms |
56104
fd6e132ee4fb
correctly reconstruct helper facts (e.g. 'nat_int') in Isar proofs
blanchet
parents:
56099
diff
changeset
|
119 |
in (((i, (id, th)) :: iidths, thms'), (ctxt', Inttab.update (id, (fixes, thm)) ptab)) end |
56078
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
120 |
|
58061 | 121 |
fun add (Z3_Proof.Z3_Step {id, rule, concl, fixes, ...}) |
56104
fd6e132ee4fb
correctly reconstruct helper facts (e.g. 'nat_int') in Isar proofs
blanchet
parents:
56099
diff
changeset
|
122 |
(cx as ((iidths, thms), (ctxt, ptab))) = |
58061 | 123 |
if Z3_Proof.is_assumption rule andalso rule <> Z3_Proof.Hypothesis then |
56078
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
124 |
let |
58061 | 125 |
val ct = SMT_Util.certify ctxt concl |
56099 | 126 |
val thm1 = Thm.trivial ct |> Conv.fconv_rule (Conv.arg1_conv (revert_conv outer_ctxt)) |
56078
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
127 |
val thm2 = singleton (Variable.export ctxt outer_ctxt) thm1 |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
128 |
in |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
129 |
(case lookup_assm assms_net (Thm.cprem_of thm2 1) of |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
130 |
[] => |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
131 |
let val (thm, ctxt') = assume thm1 ctxt |
56104
fd6e132ee4fb
correctly reconstruct helper facts (e.g. 'nat_int') in Isar proofs
blanchet
parents:
56099
diff
changeset
|
132 |
in ((iidths, thms), (ctxt', Inttab.update (id, (fixes, thm)) ptab)) end |
56078
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
133 |
| ithms => fold (add1 id fixes thm1) ithms cx) |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
134 |
end |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
135 |
else |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
136 |
cx |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
137 |
in fold add steps (([], []), (ctxt, Inttab.empty)) end |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
138 |
|
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
139 |
end |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
140 |
|
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
141 |
(* |- (EX x. P x) = P c |- ~ (ALL x. P x) = ~ P c *) |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
142 |
local |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
143 |
val sk_rules = @{lemma |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
144 |
"c = (SOME x. P x) ==> (EX x. P x) = P c" |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
145 |
"c = (SOME x. ~ P x) ==> (~ (ALL x. P x)) = (~ P c)" |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
146 |
by (metis someI_ex)+} |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
147 |
in |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
148 |
|
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
149 |
fun discharge_sk_tac i st = |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
150 |
(rtac @{thm trans} i |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
151 |
THEN resolve_tac sk_rules i |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
152 |
THEN (rtac @{thm refl} ORELSE' discharge_sk_tac) (i+1) |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
153 |
THEN rtac @{thm refl} i) st |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
154 |
|
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
155 |
end |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
156 |
|
58061 | 157 |
fun make_discharge_rules rules = rules @ [@{thm allI}, @{thm refl}, @{thm reflexive}, |
158 |
Z3_Replay_Literals.true_thm] |
|
56078
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
159 |
|
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
160 |
val intro_def_rules = @{lemma |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
161 |
"(~ P | P) & (P | ~ P)" |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
162 |
"(P | ~ P) & (~ P | P)" |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
163 |
by fast+} |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
164 |
|
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
165 |
fun discharge_assms_tac rules = |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
166 |
REPEAT (HEADGOAL (resolve_tac (intro_def_rules @ rules) ORELSE' SOLVED' discharge_sk_tac)) |
57230 | 167 |
|
56078
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
168 |
fun discharge_assms ctxt rules thm = |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
169 |
(if Thm.nprems_of thm = 0 then |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
170 |
thm |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
171 |
else |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
172 |
(case Seq.pull (discharge_assms_tac rules thm) of |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
173 |
SOME (thm', _) => thm' |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
174 |
| NONE => raise THM ("failed to discharge premise", 1, [thm]))) |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
175 |
|> Goal.norm_result ctxt |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
176 |
|
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
177 |
fun discharge rules outer_ctxt inner_ctxt = |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
178 |
singleton (Proof_Context.export inner_ctxt outer_ctxt) |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
179 |
#> discharge_assms outer_ctxt (make_discharge_rules rules) |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
180 |
|
57157 | 181 |
fun parse_proof outer_ctxt |
58061 | 182 |
({context = ctxt, typs, terms, ll_defs, rewrite_rules, assms} : SMT_Translate.replay_data) |
57541 | 183 |
xfacts prems concl output = |
57157 | 184 |
let |
58061 | 185 |
val (steps, ctxt2) = Z3_Proof.parse typs terms output ctxt |
57157 | 186 |
val ((iidths, _), _) = add_asserted outer_ctxt rewrite_rules assms steps ctxt2 |
57164 | 187 |
|
188 |
fun id_of_index i = the_default ~1 (Option.map fst (AList.lookup (op =) iidths i)) |
|
189 |
||
190 |
val conjecture_i = 0 |
|
191 |
val prems_i = 1 |
|
192 |
val facts_i = prems_i + length prems |
|
193 |
||
194 |
val conjecture_id = id_of_index conjecture_i |
|
195 |
val prem_ids = map id_of_index (prems_i upto facts_i - 1) |
|
58482
7836013951e6
simplified and repaired veriT index handling code
blanchet
parents:
58061
diff
changeset
|
196 |
val fact_ids' = |
7836013951e6
simplified and repaired veriT index handling code
blanchet
parents:
58061
diff
changeset
|
197 |
map_filter (fn (i, (id, _)) => try (apsnd (nth xfacts)) (id, i - facts_i)) iidths |
7836013951e6
simplified and repaired veriT index handling code
blanchet
parents:
58061
diff
changeset
|
198 |
val helper_ids' = map_filter (try (fn (~1, idth) => idth)) iidths |
7836013951e6
simplified and repaired veriT index handling code
blanchet
parents:
58061
diff
changeset
|
199 |
|
57164 | 200 |
val fact_helper_ts = |
58482
7836013951e6
simplified and repaired veriT index handling code
blanchet
parents:
58061
diff
changeset
|
201 |
map (fn (_, th) => (ATP_Util.short_thm_name ctxt th, prop_of th)) helper_ids' @ |
7836013951e6
simplified and repaired veriT index handling code
blanchet
parents:
58061
diff
changeset
|
202 |
map (fn (_, ((s, _), th)) => (s, prop_of th)) fact_ids' |
7836013951e6
simplified and repaired veriT index handling code
blanchet
parents:
58061
diff
changeset
|
203 |
val fact_helper_ids' = |
7836013951e6
simplified and repaired veriT index handling code
blanchet
parents:
58061
diff
changeset
|
204 |
map (apsnd (ATP_Util.short_thm_name ctxt)) helper_ids' @ map (apsnd (fst o fst)) fact_ids' |
57157 | 205 |
in |
58482
7836013951e6
simplified and repaired veriT index handling code
blanchet
parents:
58061
diff
changeset
|
206 |
{outcome = NONE, fact_ids = fact_ids', |
58061 | 207 |
atp_proof = fn () => Z3_Isar.atp_proof_of_z3_proof ctxt ll_defs rewrite_rules prems concl |
58482
7836013951e6
simplified and repaired veriT index handling code
blanchet
parents:
58061
diff
changeset
|
208 |
fact_helper_ts prem_ids conjecture_id fact_helper_ids' steps} |
57157 | 209 |
end |
210 |
||
59215
35c13f4995b1
optionally display statistics for Z3 proof reconstruction
boehmes
parents:
59213
diff
changeset
|
211 |
fun pretty_statistics total stats = |
35c13f4995b1
optionally display statistics for Z3 proof reconstruction
boehmes
parents:
59213
diff
changeset
|
212 |
let |
35c13f4995b1
optionally display statistics for Z3 proof reconstruction
boehmes
parents:
59213
diff
changeset
|
213 |
fun mean_of is = |
35c13f4995b1
optionally display statistics for Z3 proof reconstruction
boehmes
parents:
59213
diff
changeset
|
214 |
let |
35c13f4995b1
optionally display statistics for Z3 proof reconstruction
boehmes
parents:
59213
diff
changeset
|
215 |
val len = length is |
35c13f4995b1
optionally display statistics for Z3 proof reconstruction
boehmes
parents:
59213
diff
changeset
|
216 |
val mid = len div 2 |
35c13f4995b1
optionally display statistics for Z3 proof reconstruction
boehmes
parents:
59213
diff
changeset
|
217 |
in if len mod 2 = 0 then (nth is (mid - 1) + nth is mid) div 2 else nth is mid end |
35c13f4995b1
optionally display statistics for Z3 proof reconstruction
boehmes
parents:
59213
diff
changeset
|
218 |
fun pretty_item name p = Pretty.item (Pretty.separate ":" [Pretty.str name, p]) |
35c13f4995b1
optionally display statistics for Z3 proof reconstruction
boehmes
parents:
59213
diff
changeset
|
219 |
fun pretty (name, milliseconds) = pretty_item name (Pretty.block (Pretty.separate "," [ |
35c13f4995b1
optionally display statistics for Z3 proof reconstruction
boehmes
parents:
59213
diff
changeset
|
220 |
Pretty.str (string_of_int (length milliseconds) ^ " occurrences") , |
35c13f4995b1
optionally display statistics for Z3 proof reconstruction
boehmes
parents:
59213
diff
changeset
|
221 |
Pretty.str (string_of_int (mean_of milliseconds) ^ " ms mean time"), |
35c13f4995b1
optionally display statistics for Z3 proof reconstruction
boehmes
parents:
59213
diff
changeset
|
222 |
Pretty.str (string_of_int (fold Integer.max milliseconds 0) ^ " ms maximum time"), |
35c13f4995b1
optionally display statistics for Z3 proof reconstruction
boehmes
parents:
59213
diff
changeset
|
223 |
Pretty.str (string_of_int (fold Integer.add milliseconds 0) ^ " ms total time")])) |
35c13f4995b1
optionally display statistics for Z3 proof reconstruction
boehmes
parents:
59213
diff
changeset
|
224 |
in |
35c13f4995b1
optionally display statistics for Z3 proof reconstruction
boehmes
parents:
59213
diff
changeset
|
225 |
Pretty.big_list "Z3 proof reconstruction statistics:" ( |
35c13f4995b1
optionally display statistics for Z3 proof reconstruction
boehmes
parents:
59213
diff
changeset
|
226 |
pretty_item "total time" (Pretty.str (string_of_int total ^ " ms")) :: |
35c13f4995b1
optionally display statistics for Z3 proof reconstruction
boehmes
parents:
59213
diff
changeset
|
227 |
map pretty (Symtab.dest stats)) |
35c13f4995b1
optionally display statistics for Z3 proof reconstruction
boehmes
parents:
59213
diff
changeset
|
228 |
end |
35c13f4995b1
optionally display statistics for Z3 proof reconstruction
boehmes
parents:
59213
diff
changeset
|
229 |
|
56078
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
230 |
fun replay outer_ctxt |
58061 | 231 |
({context = ctxt, typs, terms, rewrite_rules, assms, ...} : SMT_Translate.replay_data) output = |
56078
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
232 |
let |
58061 | 233 |
val (steps, ctxt2) = Z3_Proof.parse typs terms output ctxt |
57157 | 234 |
val ((_, rules), (ctxt3, assumed)) = add_asserted outer_ctxt rewrite_rules assms steps ctxt2 |
235 |
val ctxt4 = |
|
236 |
ctxt3 |
|
58061 | 237 |
|> put_simpset (Z3_Replay_Util.make_simpset ctxt3 []) |
238 |
|> Config.put SAT.solver (Config.get ctxt3 SMT_Config.sat_solver) |
|
59215
35c13f4995b1
optionally display statistics for Z3 proof reconstruction
boehmes
parents:
59213
diff
changeset
|
239 |
val ({elapsed, ...}, (proofs, stats)) = |
35c13f4995b1
optionally display statistics for Z3 proof reconstruction
boehmes
parents:
59213
diff
changeset
|
240 |
Timing.timing (fold (replay_step ctxt4 assumed) steps) (assumed, Symtab.empty) |
58061 | 241 |
val (_, Z3_Proof.Z3_Step {id, ...}) = split_last steps |
59215
35c13f4995b1
optionally display statistics for Z3 proof reconstruction
boehmes
parents:
59213
diff
changeset
|
242 |
val total = Time.toMilliseconds elapsed |
35c13f4995b1
optionally display statistics for Z3 proof reconstruction
boehmes
parents:
59213
diff
changeset
|
243 |
val _ = SMT_Config.statistics_msg ctxt4 (Pretty.string_of o pretty_statistics total) stats |
56078
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
244 |
in |
57157 | 245 |
Inttab.lookup proofs id |> the |> snd |> discharge rules outer_ctxt ctxt4 |
56078
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
246 |
end |
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
blanchet
parents:
diff
changeset
|
247 |
|
57229 | 248 |
end; |