1 (* Title: HOL/Tools/ATP_Manager/atp_minimal.ML |
1 (* Title: HOL/Tools/ATP_Manager/atp_minimal.ML |
2 Author: Philipp Meyer, TU Muenchen |
2 Author: Philipp Meyer, TU Muenchen |
3 |
3 |
4 Minimization of theorem list for metis by using an external automated theorem prover |
4 Minimization of theorem list for Metis using automatic theorem provers. |
5 *) |
5 *) |
6 |
6 |
7 signature ATP_MINIMAL = |
7 signature ATP_MINIMAL = |
8 sig |
8 sig |
|
9 type prover = ATP_Manager.prover |
|
10 type prover_result = ATP_Manager.prover_result |
9 type 'a minimize_fun = ('a list -> bool) -> 'a list -> 'a list |
11 type 'a minimize_fun = ('a list -> bool) -> 'a list -> 'a list |
|
12 |
10 val linear_minimize : 'a minimize_fun |
13 val linear_minimize : 'a minimize_fun |
11 val binary_minimize : 'a minimize_fun |
14 val binary_minimize : 'a minimize_fun |
12 val minimize_theorems : |
15 val minimize_theorems : |
13 (string * thm list) minimize_fun -> ATP_Wrapper.prover -> string -> int |
16 (string * thm list) minimize_fun -> prover -> string -> int |
14 -> Proof.state -> (string * thm list) list |
17 -> Proof.state -> (string * thm list) list |
15 -> (string * thm list) list option * string |
18 -> (string * thm list) list option * string |
16 end; |
19 end; |
17 |
20 |
18 structure ATP_Minimal : ATP_MINIMAL = |
21 structure ATP_Minimal : ATP_MINIMAL = |
19 struct |
22 struct |
20 |
23 |
21 open Sledgehammer_Fact_Preprocessor |
24 open Sledgehammer_Fact_Preprocessor |
|
25 open ATP_Manager |
22 |
26 |
23 type 'a minimize_fun = ('a list -> bool) -> 'a list -> 'a list |
27 type 'a minimize_fun = ('a list -> bool) -> 'a list -> 'a list |
24 |
28 |
25 (* Linear minimization algorithm *) |
29 (* Linear minimization algorithm *) |
26 |
30 |
85 ("Timeout", Timeout), |
89 ("Timeout", Timeout), |
86 ("time limit exceeded", Timeout), |
90 ("time limit exceeded", Timeout), |
87 ("# Cannot determine problem status within resource limit", Timeout), |
91 ("# Cannot determine problem status within resource limit", Timeout), |
88 ("Error", Error)] |
92 ("Error", Error)] |
89 |
93 |
90 fun produce_answer (result : ATP_Wrapper.prover_result) = |
94 fun produce_answer ({success, proof, internal_thm_names, filtered_clauses, ...} |
91 let |
95 : prover_result) = |
92 val {success, proof = result_string, internal_thm_names = thm_name_vec, |
96 if success then |
93 filtered_clauses = filtered, ...} = result |
97 (Success (Vector.foldr (op ::) [] internal_thm_names, filtered_clauses), |
94 in |
98 proof) |
95 if success then |
99 else |
96 (Success (Vector.foldr (op ::) [] thm_name_vec, filtered), result_string) |
100 let |
97 else |
101 val failure = failure_strings |> get_first (fn (s, t) => |
98 let |
102 if String.isSubstring s proof then SOME (t, proof) else NONE) |
99 val failure = failure_strings |> get_first (fn (s, t) => |
103 in |
100 if String.isSubstring s result_string then SOME (t, result_string) else NONE) |
104 (case failure of |
101 in |
105 SOME res => res |
102 (case failure of |
106 | NONE => (Failure, proof)) |
103 SOME res => res |
107 end |
104 | NONE => (Failure, result_string)) |
|
105 end |
|
106 end |
|
107 |
108 |
108 |
109 |
109 (* wrapper for calling external prover *) |
110 (* wrapper for calling external prover *) |
110 |
111 |
111 fun sh_test_thms prover time_limit subgoalno state filtered name_thms_pairs = |
112 fun sledgehammer_test_theorems prover time_limit subgoalno state filtered |
|
113 name_thms_pairs = |
112 let |
114 let |
113 val _ = priority ("Testing " ^ string_of_int (length name_thms_pairs) ^ " theorems... ") |
115 val _ = priority ("Testing " ^ string_of_int (length name_thms_pairs) ^ |
|
116 " theorems... ") |
114 val name_thm_pairs = maps (fn (n, ths) => map (pair n) ths) name_thms_pairs |
117 val name_thm_pairs = maps (fn (n, ths) => map (pair n) ths) name_thms_pairs |
115 val axclauses = cnf_rules_pairs (Proof.theory_of state) name_thm_pairs |
118 val axclauses = cnf_rules_pairs (Proof.theory_of state) name_thm_pairs |
116 val {context = ctxt, facts, goal} = Proof.goal state |
119 val {context = ctxt, facts, goal} = Proof.goal state |
117 val problem = |
120 val problem = |
118 {with_full_types = ! ATP_Manager.full_types, |
121 {with_full_types = ! ATP_Manager.full_types, |
120 goal = (ctxt, (facts, goal)), |
123 goal = (ctxt, (facts, goal)), |
121 axiom_clauses = SOME axclauses, |
124 axiom_clauses = SOME axclauses, |
122 filtered_clauses = filtered} |
125 filtered_clauses = filtered} |
123 val (result, proof) = produce_answer (prover time_limit problem) |
126 val (result, proof) = produce_answer (prover time_limit problem) |
124 val _ = priority (string_of_result result) |
127 val _ = priority (string_of_result result) |
125 in |
128 in (result, proof) end |
126 (result, proof) |
|
127 end |
|
128 |
129 |
129 |
130 |
130 (* minimalization of thms *) |
131 (* minimalization of thms *) |
131 |
132 |
132 fun minimize_theorems gen_min prover prover_name time_limit state |
133 fun minimize_theorems gen_min prover prover_name time_limit state |
134 let |
135 let |
135 val _ = |
136 val _ = |
136 priority ("Minimize called with " ^ string_of_int (length name_thms_pairs) ^ |
137 priority ("Minimize called with " ^ string_of_int (length name_thms_pairs) ^ |
137 " theorems, prover: " ^ prover_name ^ |
138 " theorems, prover: " ^ prover_name ^ |
138 ", time limit: " ^ string_of_int time_limit ^ " seconds") |
139 ", time limit: " ^ string_of_int time_limit ^ " seconds") |
139 val test_thms_fun = sh_test_thms prover time_limit 1 state |
140 val test_thms_fun = sledgehammer_test_theorems prover time_limit 1 state |
140 fun test_thms filtered thms = |
141 fun test_thms filtered thms = |
141 case test_thms_fun filtered thms of (Success _, _) => true | _ => false |
142 case test_thms_fun filtered thms of (Success _, _) => true | _ => false |
142 in |
143 in |
143 (* try prove first to check result and get used theorems *) |
144 (* try prove first to check result and get used theorems *) |
144 (case test_thms_fun NONE name_thms_pairs of |
145 (case test_thms_fun NONE name_thms_pairs of |