1 (* Title: HOL/Tools/Sledgehammer/sledgehammer_shrink.ML |
1 (* Title: HOL/Tools/Sledgehammer/sledgehammer_shrink.ML |
2 Author: Jasmin Blanchette, TU Muenchen |
2 Author: Jasmin Blanchette, TU Muenchen |
3 Author: Steffen Juilf Smolka, TU Muenchen |
3 Author: Steffen Juilf Smolka, TU Muenchen |
4 |
4 |
5 Preplaying of reconstructed isar proofs. |
5 Preplaying of isar proofs. |
6 *) |
6 *) |
7 |
7 |
8 signature SLEDGEHAMMER_PREPLAY = |
8 signature SLEDGEHAMMER_PREPLAY = |
9 sig |
9 sig |
10 type isar_step = Sledgehammer_Proof.isar_step |
10 type isar_step = Sledgehammer_Proof.isar_step |
|
11 eqtype preplay_time |
|
12 val zero_preplay_time : preplay_time |
|
13 val some_preplay_time : preplay_time |
|
14 val add_preplay_time : preplay_time -> preplay_time -> preplay_time |
|
15 val string_of_preplay_time : preplay_time -> string |
11 val try_metis : bool -> string -> string -> Proof.context -> |
16 val try_metis : bool -> string -> string -> Proof.context -> |
12 Time.time -> (isar_step option * isar_step) -> unit -> Time.time option |
17 Time.time -> (isar_step option * isar_step) -> unit -> preplay_time |
13 val try_metis_quietly : bool -> string -> string -> Proof.context -> |
18 val try_metis_quietly : bool -> string -> string -> Proof.context -> |
14 Time.time -> (isar_step option * isar_step) -> unit -> Time.time option |
19 Time.time -> (isar_step option * isar_step) -> unit -> preplay_time |
15 end |
20 end |
16 |
21 |
17 structure Sledgehammer_Preplay : SLEDGEHAMMER_PREPLAY = |
22 structure Sledgehammer_Preplay : SLEDGEHAMMER_PREPLAY = |
18 struct |
23 struct |
19 |
24 |
20 open Sledgehammer_Util |
25 open Sledgehammer_Util |
21 open Sledgehammer_Proof |
26 open Sledgehammer_Proof |
22 |
27 |
|
28 (* The boolean flag encodes whether the time is exact (false) or an lower bound |
|
29 (true) *) |
|
30 type preplay_time = bool * Time.time |
|
31 |
|
32 val zero_preplay_time = (false, Time.zeroTime) |
|
33 val some_preplay_time = (true, Time.zeroTime) |
|
34 |
|
35 fun add_preplay_time (b1, t1) (b2, t2) = (b1 orelse b2, Time.+(t1,t2)) |
|
36 |
|
37 val string_of_preplay_time = ATP_Util.string_from_ext_time |
|
38 |
23 (* timing *) |
39 (* timing *) |
24 fun take_time timeout tac arg = |
40 fun take_time timeout tac arg = |
25 let |
41 let |
26 val timing = Timing.start () |
42 val timing = Timing.start () |
27 in |
43 in |
28 (TimeLimit.timeLimit timeout tac arg; Timing.result timing |> #cpu |> SOME) |
44 (TimeLimit.timeLimit timeout tac arg; |
29 handle TimeLimit.TimeOut => NONE |
45 Timing.result timing |> #cpu |> pair false) |
|
46 handle TimeLimit.TimeOut => (true, timeout) |
30 end |
47 end |
31 |
48 |
32 (* lookup facts in context *) |
49 (* lookup facts in context *) |
33 fun resolve_fact_names ctxt names = |
50 fun resolve_fact_names ctxt names = |
34 names |
51 names |
69 resolve_fact_names ctxt fact_names |
86 resolve_fact_names ctxt fact_names |
70 @ (case the succedent of |
87 @ (case the succedent of |
71 Assume (_, t) => make_thm t |
88 Assume (_, t) => make_thm t |
72 | Obtain (_, _, _, t, _) => make_thm t |
89 | Obtain (_, _, _, t, _) => make_thm t |
73 | Prove (_, _, t, _) => make_thm t |
90 | Prove (_, _, t, _) => make_thm t |
74 | _ => error "Preplay error: unexpected succedent of case split") |
91 | _ => error "preplay error: unexpected succedent of case split") |
75 :: map (hd #> (fn Assume (_, a) => Logic.mk_implies (a, t) |
92 :: map (hd #> (fn Assume (_, a) => Logic.mk_implies (a, t) |
76 | _ => error "Preplay error: malformed case split") |
93 | _ => error "preplay error: malformed case split") |
77 #> make_thm) |
94 #> make_thm) |
78 cases) |
95 cases) |
79 val ctxt = ctxt |> Config.put Metis_Tactic.verbose debug |
96 val ctxt = ctxt |> Config.put Metis_Tactic.verbose debug |
80 |> obtain ? Config.put Metis_Tactic.new_skolem true |
97 |> obtain ? Config.put Metis_Tactic.new_skolem true |
81 val goal = |
98 val goal = |
82 Goal.prove (Config.put Metis_Tactic.verbose debug ctxt) [] [] t |
99 Goal.prove (Config.put Metis_Tactic.verbose debug ctxt) [] [] t |
83 fun tac {context = ctxt, prems = _} = |
100 fun tac {context = ctxt, prems = _} = |
84 Metis_Tactic.metis_tac [type_enc] lam_trans ctxt facts 1 |
101 Metis_Tactic.metis_tac [type_enc] lam_trans ctxt facts 1 |
85 in |
102 in |
86 take_time timeout (fn () => goal tac) |
103 take_time timeout |
|
104 (fn () => goal tac handle ERROR msg => error ("preplay error: " ^ msg)) |
87 end |
105 end |
88 handle ZEROTIME => K (SOME Time.zeroTime) |
106 handle ZEROTIME => K zero_preplay_time |
89 |
107 |
90 (* this version does not throw exceptions but returns NONE instead *) |
108 (* this version treats exceptions like timeouts *) |
91 fun try_metis_quietly debug type_enc lam_trans ctxt = |
109 fun try_metis_quietly debug type_enc lam_trans ctxt timeout = |
92 the_default NONE oo try oo try_metis debug type_enc lam_trans ctxt |
110 the_default (true, timeout) oo try o try_metis debug type_enc lam_trans ctxt timeout |
93 |
111 |
94 end |
112 end |