author | wenzelm |
Sun, 05 Jun 2005 11:31:22 +0200 | |
changeset 16259 | aed1a8ae4b23 |
parent 16157 | 1764cc98bafd |
child 16357 | f1275d2a1dee |
permissions | -rw-r--r-- |
15789
4cb16144c81b
added hearder lines and deleted some redundant material
paulson
parents:
15774
diff
changeset
|
1 |
(* ID: $Id$ |
4cb16144c81b
added hearder lines and deleted some redundant material
paulson
parents:
15774
diff
changeset
|
2 |
Author: Claire Quigley |
4cb16144c81b
added hearder lines and deleted some redundant material
paulson
parents:
15774
diff
changeset
|
3 |
Copyright 2004 University of Cambridge |
4cb16144c81b
added hearder lines and deleted some redundant material
paulson
parents:
15774
diff
changeset
|
4 |
*) |
15642 | 5 |
|
6 |
fun add_in_order (x:string) [] = [x] |
|
7 |
| add_in_order (x:string) ((y:string)::ys) = if (x < y) |
|
8 |
then |
|
9 |
(x::(y::ys)) |
|
10 |
else |
|
11 |
(y::(add_in_order x ys)) |
|
12 |
fun add_once x [] = [x] |
|
16157 | 13 |
| add_once x (y::ys) = if x mem (y::ys) then (y::ys) |
14 |
else add_in_order x (y::ys) |
|
15642 | 15 |
|
15684
5ec4d21889d6
Reconstruction code, now packaged to avoid name clashes
paulson
parents:
15658
diff
changeset
|
16 |
fun thm_vars thm = map (fn ((name,ix),_) => name) (Drule.vars_of thm); |
15642 | 17 |
|
18 |
Goal "False ==> False"; |
|
19 |
by Auto_tac; |
|
20 |
qed "False_imp"; |
|
21 |
||
22 |
exception Reflex_equal; |
|
23 |
||
24 |
(********************************) |
|
25 |
(* Proofstep datatype *) |
|
26 |
(********************************) |
|
27 |
(* Assume rewrite steps have only two clauses in them just now, but lcl109-5 has Rew[5,3,5,3] *) |
|
28 |
||
29 |
datatype Side = Left |Right |
|
30 |
||
31 |
datatype Proofstep = ExtraAxiom |
|
32 |
|OrigAxiom |
|
33 |
| Axiom |
|
34 |
| Binary of (int * int) * (int * int) (* (clause1,lit1), (clause2, lit2) *) |
|
35 |
| MRR of (int * int) * (int * int) |
|
36 |
| Factor of (int * int * int) (* (clause,lit1, lit2) *) |
|
37 |
| Para of (int * int) * (int * int) |
|
38 |
| Rewrite of (int * int) * (int * int) |
|
39 |
| Obvious of (int * int) |
|
40 |
(*| Hyper of int list*) |
|
41 |
| Unusedstep of unit |
|
42 |
||
43 |
||
44 |
datatype Clausesimp = Binary_s of int * int |
|
45 |
| Factor_s of unit |
|
46 |
| Demod_s of (int * int) list |
|
47 |
| Hyper_s of int list |
|
48 |
| Unusedstep_s of unit |
|
49 |
||
50 |
||
51 |
||
52 |
datatype Step_label = T_info |
|
53 |
|P_info |
|
54 |
||
55 |
||
16061 | 56 |
fun is_alpha_space_digit_or_neg ch = |
57 |
(ch = "~") orelse (ReconOrderClauses.is_alpha ch) orelse |
|
58 |
(ReconOrderClauses.is_digit ch) orelse ( ch = " "); |
|
15642 | 59 |
|
60 |
||
15697 | 61 |
fun lit_string_with_nums t = let val termstr = Term.string_of_term t |
15642 | 62 |
val exp_term = explode termstr |
63 |
in |
|
64 |
implode(List.filter is_alpha_space_digit_or_neg exp_term) |
|
65 |
end |
|
66 |
||
15774 | 67 |
fun reconstruction_failed fname = error (fname ^ ": reconstruction failed") |
15642 | 68 |
|
15919
b30a35432f5a
Replaced reference to SPASS with general one - set SPASS_HOME in settings file.
quigley
parents:
15794
diff
changeset
|
69 |
(************************************************) |
b30a35432f5a
Replaced reference to SPASS with general one - set SPASS_HOME in settings file.
quigley
parents:
15794
diff
changeset
|
70 |
(* Reconstruct an axiom resolution step *) |
b30a35432f5a
Replaced reference to SPASS with general one - set SPASS_HOME in settings file.
quigley
parents:
15794
diff
changeset
|
71 |
(* clauses is a list of (clausenum,clause) pairs*) |
b30a35432f5a
Replaced reference to SPASS with general one - set SPASS_HOME in settings file.
quigley
parents:
15794
diff
changeset
|
72 |
(************************************************) |
15642 | 73 |
|
15774 | 74 |
fun follow_axiom clauses allvars (clausenum:int) thml clause_strs = |
16061 | 75 |
let val this_axiom = valOf (assoc (clauses,clausenum)) |
76 |
val (res, numlist, symlist, nsymlist) = (ReconOrderClauses.rearrange_clause this_axiom clause_strs allvars) |
|
77 |
val thmvars = thm_vars res |
|
78 |
in |
|
79 |
(res, (Axiom,clause_strs,thmvars ) ) |
|
80 |
end |
|
81 |
handle Option => reconstruction_failed "follow_axiom" |
|
15642 | 82 |
|
83 |
(****************************************) |
|
84 |
(* Reconstruct a binary resolution step *) |
|
85 |
(****************************************) |
|
86 |
||
87 |
(* numbers of clauses and literals*) (*vars*) (*list of current thms*) (* literal strings as parsed from spass *) |
|
16061 | 88 |
fun follow_binary ((clause1, lit1), (clause2 , lit2)) allvars thml clause_strs = |
89 |
let val thm1 = select_literal (lit1 + 1) (valOf (assoc (thml,clause1))) |
|
90 |
val thm2 = valOf (assoc (thml,clause2)) |
|
91 |
val res = thm1 RSN ((lit2 +1), thm2) |
|
92 |
val (res', numlist, symlist, nsymlist) = (ReconOrderClauses.rearrange_clause res clause_strs allvars) |
|
93 |
val thmvars = thm_vars res |
|
94 |
in |
|
95 |
(res', ((Binary ((clause1, lit1), (clause2 , lit2))),clause_strs,thmvars) ) |
|
96 |
end |
|
97 |
handle Option => reconstruction_failed "follow_binary" |
|
15642 | 98 |
|
99 |
||
100 |
||
101 |
(******************************************************) |
|
102 |
(* Reconstruct a matching replacement resolution step *) |
|
103 |
(******************************************************) |
|
104 |
||
105 |
||
16061 | 106 |
fun follow_mrr ((clause1, lit1), (clause2 , lit2)) allvars thml clause_strs = |
107 |
let val thm1 = select_literal (lit1 + 1) (valOf (assoc (thml,clause1))) |
|
108 |
val thm2 = valOf (assoc (thml,clause2)) |
|
109 |
val res = thm1 RSN ((lit2 +1), thm2) |
|
110 |
val (res', numlist, symlist, nsymlist) = |
|
111 |
(ReconOrderClauses.rearrange_clause res clause_strs allvars) |
|
112 |
val thmvars = thm_vars res |
|
113 |
in |
|
114 |
(res', ((MRR ((clause1, lit1), (clause2 , lit2))) ,clause_strs,thmvars)) |
|
115 |
end |
|
116 |
handle Option => reconstruction_failed "follow_mrr" |
|
15642 | 117 |
|
118 |
||
119 |
(*******************************************) |
|
120 |
(* Reconstruct a factoring resolution step *) |
|
121 |
(*******************************************) |
|
122 |
||
123 |
fun mksubstlist [] sublist = sublist |
|
16061 | 124 |
|mksubstlist ((a, (_, b)) :: rest) sublist = |
125 |
let val vartype = type_of b |
|
126 |
val avar = Var(a,vartype) |
|
127 |
val newlist = ((avar,b)::sublist) |
|
128 |
in |
|
129 |
mksubstlist rest newlist |
|
130 |
end; |
|
15642 | 131 |
|
132 |
(* based on Tactic.distinct_subgoals_tac *) |
|
133 |
||
134 |
fun delete_assump_tac state lit = |
|
135 |
let val (frozth,thawfn) = freeze_thaw state |
|
136 |
val froz_prems = cprems_of frozth |
|
137 |
val assumed = implies_elim_list frozth (map assume froz_prems) |
|
16061 | 138 |
val new_prems = ReconOrderClauses.remove_nth lit froz_prems |
15642 | 139 |
val implied = implies_intr_list new_prems assumed |
140 |
in |
|
141 |
Seq.single (thawfn implied) |
|
142 |
end |
|
143 |
||
144 |
||
145 |
||
146 |
||
147 |
||
148 |
(*************************************) |
|
149 |
(* Reconstruct a factoring step *) |
|
150 |
(*************************************) |
|
151 |
||
15739
bb2acfed8212
yet more tidying up: removal of some references to Main
paulson
parents:
15736
diff
changeset
|
152 |
(*FIXME: share code with that in Tools/reconstruction.ML*) |
16061 | 153 |
fun follow_factor clause lit1 lit2 allvars thml clause_strs = |
154 |
let |
|
155 |
val th = valOf (assoc (thml,clause)) |
|
156 |
val prems = prems_of th |
|
157 |
val sign = sign_of_thm th |
|
158 |
val fac1 = ReconOrderClauses.get_nth (lit1+1) prems |
|
159 |
val fac2 = ReconOrderClauses.get_nth (lit2+1) prems |
|
160 |
val unif_env = Unify.unifiers (sign,Envir.empty 0, [(fac1, fac2)]) |
|
161 |
val newenv = getnewenv unif_env |
|
162 |
val envlist = Envir.alist_of newenv |
|
163 |
||
164 |
val (t1,t2)::_ = mksubstlist envlist [] |
|
165 |
in |
|
166 |
if (is_Var t1) |
|
167 |
then |
|
168 |
let |
|
169 |
val str1 = lit_string_with_nums t1; |
|
170 |
val str2 = lit_string_with_nums t2; |
|
171 |
val facthm = read_instantiate [(str1,str2)] th; |
|
172 |
val res = hd (Seq.list_of(delete_assump_tac facthm (lit1 + 1))) |
|
173 |
val (res', numlist, symlist, nsymlist) = |
|
174 |
ReconOrderClauses.rearrange_clause res clause_strs allvars |
|
175 |
val thmvars = thm_vars res' |
|
176 |
in |
|
177 |
(res',((Factor (clause, lit1, lit2)),clause_strs,thmvars)) |
|
178 |
end |
|
179 |
else |
|
180 |
let |
|
181 |
val str2 = lit_string_with_nums t1; |
|
182 |
val str1 = lit_string_with_nums t2; |
|
183 |
val facthm = read_instantiate [(str1,str2)] th; |
|
184 |
val res = hd (Seq.list_of(delete_assump_tac facthm (lit1 + 1))) |
|
185 |
val (res', numlist, symlist, nsymlist) = |
|
186 |
ReconOrderClauses.rearrange_clause res clause_strs allvars |
|
187 |
val thmvars = thm_vars res' |
|
188 |
in |
|
189 |
(res', ((Factor (clause, lit1, lit2)),clause_strs, thmvars)) |
|
190 |
end |
|
191 |
end |
|
192 |
handle Option => reconstruction_failed "follow_factor" |
|
15642 | 193 |
|
194 |
||
195 |
||
15684
5ec4d21889d6
Reconstruction code, now packaged to avoid name clashes
paulson
parents:
15658
diff
changeset
|
196 |
fun get_unif_comb t eqterm = |
5ec4d21889d6
Reconstruction code, now packaged to avoid name clashes
paulson
parents:
15658
diff
changeset
|
197 |
if ((type_of t) = (type_of eqterm)) |
5ec4d21889d6
Reconstruction code, now packaged to avoid name clashes
paulson
parents:
15658
diff
changeset
|
198 |
then t |
5ec4d21889d6
Reconstruction code, now packaged to avoid name clashes
paulson
parents:
15658
diff
changeset
|
199 |
else |
5ec4d21889d6
Reconstruction code, now packaged to avoid name clashes
paulson
parents:
15658
diff
changeset
|
200 |
let val _ $ rand = t |
5ec4d21889d6
Reconstruction code, now packaged to avoid name clashes
paulson
parents:
15658
diff
changeset
|
201 |
in get_unif_comb rand eqterm end; |
15642 | 202 |
|
15684
5ec4d21889d6
Reconstruction code, now packaged to avoid name clashes
paulson
parents:
15658
diff
changeset
|
203 |
fun get_unif_lit t eqterm = |
5ec4d21889d6
Reconstruction code, now packaged to avoid name clashes
paulson
parents:
15658
diff
changeset
|
204 |
if (can HOLogic.dest_eq t) |
5ec4d21889d6
Reconstruction code, now packaged to avoid name clashes
paulson
parents:
15658
diff
changeset
|
205 |
then |
5ec4d21889d6
Reconstruction code, now packaged to avoid name clashes
paulson
parents:
15658
diff
changeset
|
206 |
let val (lhs,rhs) = HOLogic.dest_eq(HOLogic.dest_Trueprop eqterm) |
5ec4d21889d6
Reconstruction code, now packaged to avoid name clashes
paulson
parents:
15658
diff
changeset
|
207 |
in lhs end |
5ec4d21889d6
Reconstruction code, now packaged to avoid name clashes
paulson
parents:
15658
diff
changeset
|
208 |
else |
5ec4d21889d6
Reconstruction code, now packaged to avoid name clashes
paulson
parents:
15658
diff
changeset
|
209 |
get_unif_comb t eqterm; |
5ec4d21889d6
Reconstruction code, now packaged to avoid name clashes
paulson
parents:
15658
diff
changeset
|
210 |
|
15642 | 211 |
|
212 |
||
213 |
(*************************************) |
|
214 |
(* Reconstruct a paramodulation step *) |
|
215 |
(*************************************) |
|
216 |
||
217 |
val rev_subst = rotate_prems 1 subst; |
|
218 |
val rev_ssubst = rotate_prems 1 ssubst; |
|
219 |
||
220 |
||
16061 | 221 |
fun follow_standard_para ((clause1, lit1), (clause2 , lit2)) allvars thml clause_strs = |
222 |
let |
|
223 |
val th1 = valOf (assoc (thml,clause1)) |
|
224 |
val th2 = valOf (assoc (thml,clause2)) |
|
225 |
val eq_lit_th = select_literal (lit1+1) th1 |
|
226 |
val mod_lit_th = select_literal (lit2+1) th2 |
|
227 |
val eqsubst = eq_lit_th RSN (2,rev_subst) |
|
228 |
val newth = Seq.hd (biresolution false [(false, mod_lit_th)] 1 eqsubst) |
|
229 |
val newth' =negate_head newth |
|
230 |
val (res, numlist, symlist, nsymlist) = |
|
231 |
(ReconOrderClauses.rearrange_clause newth' clause_strs allvars |
|
232 |
handle Not_in_list => |
|
233 |
let val mod_lit_th' = mod_lit_th RS not_sym |
|
234 |
val newth = Seq.hd (biresolution false [(false, mod_lit_th')] 1 eqsubst) |
|
235 |
val newth' =negate_head newth |
|
236 |
in |
|
237 |
ReconOrderClauses.rearrange_clause newth' clause_strs allvars |
|
238 |
end) |
|
239 |
val thmvars = thm_vars res |
|
240 |
in |
|
241 |
(res, ((Para((clause1, lit1), (clause2 , lit2))),clause_strs,thmvars)) |
|
242 |
end |
|
243 |
handle Option => reconstruction_failed "follow_standard_para" |
|
15642 | 244 |
|
245 |
(* |
|
246 |
fun follow_standard_para ((clause1, lit1), (clause2 , lit2)) allvars thml clause_strs= |
|
247 |
let |
|
15774 | 248 |
val th1 = valOf (assoc (thml,clause1)) |
249 |
val th2 = valOf (assoc (thml,clause2)) |
|
15642 | 250 |
val eq_lit_th = select_literal (lit1+1) th1 |
251 |
val mod_lit_th = select_literal (lit2+1) th2 |
|
252 |
val eqsubst = eq_lit_th RSN (2,rev_subst) |
|
253 |
val newth = Seq.hd (biresolution false [(false, mod_lit_th)] 1 eqsubst) |
|
254 |
val newth' =negate_nead newth |
|
255 |
val (res, numlist, symlist, nsymlist) = (rearrange_clause newth' clause_strs allvars) |
|
256 |
val thmvars = thm_vars res |
|
257 |
in |
|
258 |
(res, ((Para((clause1, lit1), (clause2 , lit2))),clause_strs,thmvars)) |
|
259 |
end |
|
15774 | 260 |
handle Option => reconstruction_failed "follow_standard_para" |
15642 | 261 |
|
262 |
*) |
|
263 |
||
264 |
||
265 |
(********************************) |
|
266 |
(* Reconstruct a rewriting step *) |
|
267 |
(********************************) |
|
268 |
||
269 |
(* |
|
270 |
||
271 |
val rev_subst = rotate_prems 1 subst; |
|
272 |
||
273 |
fun paramod_rule ((cl1, lit1), (cl2 , lit2)) = |
|
274 |
let val eq_lit_th = select_literal (lit1+1) cl1 |
|
275 |
val mod_lit_th = select_literal (lit2+1) cl2 |
|
276 |
val eqsubst = eq_lit_th RSN (2,rev_subst) |
|
277 |
val newth = Seq.hd (biresolution false [(false, mod_lit_th)] 1 |
|
278 |
eqsubst) |
|
15697 | 279 |
in Meson.negated_asm_of_head newth end; |
15642 | 280 |
|
281 |
val newth = Seq.hd (biresolution false [(false, mod_lit_th)] 1 |
|
282 |
eqsubst) |
|
283 |
||
284 |
val mod_lit_th' = mod_lit_th RS not_sym |
|
285 |
||
286 |
*) |
|
287 |
||
288 |
||
289 |
fun delete_assumps 0 th = th |
|
290 |
| delete_assumps n th = let val th_prems = length (prems_of th) |
|
291 |
val th' = hd (Seq.list_of(delete_assump_tac th (th_prems -1))) |
|
292 |
in |
|
293 |
delete_assumps (n-1) th' |
|
294 |
end |
|
295 |
||
296 |
(* extra conditions from the equality turn up as 2nd to last literals of result. Need to delete them *) |
|
297 |
(* changed negate_nead to negate_head here too*) |
|
298 |
(* clause1, lit1 is thing to rewrite with *) |
|
16061 | 299 |
fun follow_rewrite ((clause1, lit1), (clause2, lit2)) allvars thml clause_strs = |
300 |
let val th1 = valOf (assoc (thml,clause1)) |
|
301 |
val th2 = valOf (assoc (thml,clause2)) |
|
302 |
val eq_lit_th = select_literal (lit1+1) th1 |
|
303 |
val mod_lit_th = select_literal (lit2+1) th2 |
|
304 |
val eqsubst = eq_lit_th RSN (2,rev_subst) |
|
305 |
val eq_lit_prem_num = length (prems_of eq_lit_th) |
|
306 |
val sign = Sign.merge (sign_of_thm th1, sign_of_thm th2) |
|
307 |
val newth = Seq.hd (biresolution false [(false, mod_lit_th)] 1 eqsubst) |
|
308 |
val newthm = negate_head newth |
|
309 |
val newthm' = delete_assumps eq_lit_prem_num newthm |
|
310 |
val (res, numlist, symlist, nsymlist) = |
|
311 |
ReconOrderClauses.rearrange_clause newthm clause_strs allvars |
|
312 |
val thmvars = thm_vars res |
|
313 |
in |
|
314 |
(res, ((Rewrite ((clause1, lit1), (clause2, lit2))),clause_strs,thmvars)) |
|
315 |
end |
|
316 |
handle Option => reconstruction_failed "follow_rewrite" |
|
15642 | 317 |
|
318 |
||
319 |
||
320 |
(*****************************************) |
|
321 |
(* Reconstruct an obvious reduction step *) |
|
322 |
(*****************************************) |
|
323 |
||
324 |
||
16061 | 325 |
fun follow_obvious (clause1, lit1) allvars thml clause_strs = |
326 |
let val th1 = valOf (assoc (thml,clause1)) |
|
327 |
val prems1 = prems_of th1 |
|
328 |
val newthm = refl RSN ((lit1+ 1), th1) |
|
329 |
handle THM _ => hd (Seq.list_of(delete_assump_tac th1 (lit1 + 1))) |
|
330 |
val (res, numlist, symlist, nsymlist) = |
|
331 |
ReconOrderClauses.rearrange_clause newthm clause_strs allvars |
|
332 |
val thmvars = thm_vars res |
|
333 |
in |
|
334 |
(res, ((Obvious (clause1, lit1)),clause_strs,thmvars)) |
|
335 |
end |
|
336 |
handle Option => reconstruction_failed "follow_obvious" |
|
15642 | 337 |
|
338 |
(**************************************************************************************) |
|
339 |
(* reconstruct a single line of the res. proof - depending on what sort of proof step it was*) |
|
340 |
(**************************************************************************************) |
|
341 |
||
342 |
fun follow_proof clauses allvars clausenum thml (Axiom ) clause_strs |
|
343 |
= follow_axiom clauses allvars clausenum thml clause_strs |
|
344 |
||
345 |
| follow_proof clauses allvars clausenum thml (Binary (a, b)) clause_strs |
|
346 |
= follow_binary (a, b) allvars thml clause_strs |
|
347 |
||
348 |
| follow_proof clauses allvars clausenum thml (MRR (a, b)) clause_strs |
|
349 |
= follow_mrr (a, b) allvars thml clause_strs |
|
350 |
||
351 |
| follow_proof clauses allvars clausenum thml (Factor (a, b, c)) clause_strs |
|
352 |
= follow_factor a b c allvars thml clause_strs |
|
353 |
||
354 |
| follow_proof clauses allvars clausenum thml (Para (a, b)) clause_strs |
|
355 |
= follow_standard_para (a, b) allvars thml clause_strs |
|
356 |
||
357 |
| follow_proof clauses allvars clausenum thml (Rewrite (a,b)) clause_strs |
|
358 |
= follow_rewrite (a,b) allvars thml clause_strs |
|
359 |
||
360 |
| follow_proof clauses allvars clausenum thml (Obvious (a,b)) clause_strs |
|
361 |
= follow_obvious (a,b) allvars thml clause_strs |
|
362 |
||
363 |
(*| follow_proof clauses clausenum thml (Hyper l) |
|
364 |
= follow_hyper l thml*) |
|
365 |
| follow_proof clauses allvars clausenum thml _ _ = |
|
366 |
raise ASSERTION "proof step not implemented" |
|
367 |
||
368 |
||
369 |
||
370 |
||
371 |
(**************************************************************************************) |
|
372 |
(* reconstruct a single line of the res. proof - at the moment do only inference steps*) |
|
373 |
(**************************************************************************************) |
|
374 |
||
375 |
fun follow_line clauses allvars thml (clause_num, proof_step, clause_strs) recons |
|
376 |
= let |
|
377 |
val (thm, recon_fun) = follow_proof clauses allvars clause_num thml proof_step clause_strs |
|
378 |
val recon_step = (recon_fun) |
|
379 |
in |
|
380 |
(((clause_num, thm)::thml), ((clause_num,recon_step)::recons)) |
|
381 |
end |
|
382 |
||
383 |
(***************************************************************) |
|
384 |
(* follow through the res. proof, creating an Isabelle theorem *) |
|
385 |
(***************************************************************) |
|
386 |
||
387 |
||
388 |
||
389 |
(*fun is_proof_char ch = (case ch of |
|
390 |
||
391 |
"(" => true |
|
392 |
| ")" => true |
|
393 |
| ":" => true |
|
394 |
| "'" => true |
|
395 |
| "&" => true |
|
396 |
| "|" => true |
|
397 |
| "~" => true |
|
398 |
| "." => true |
|
399 |
|(is_alpha ) => true |
|
400 |
|(is_digit) => true |
|
401 |
| _ => false)*) |
|
402 |
||
403 |
fun is_proof_char ch = ((33 <= (ord ch)) andalso ((ord ch ) <= 126)) orelse (ch = " ") |
|
404 |
||
405 |
fun proofstring x = let val exp = explode x |
|
406 |
in |
|
407 |
List.filter (is_proof_char ) exp |
|
408 |
end |
|
409 |
||
410 |
||
411 |
fun not_newline ch = not (ch = "\n"); |
|
412 |
||
413 |
(* |
|
414 |
||
415 |
fun follow clauses [] allvars thml recons = |
|
416 |
let (* val _ = reset show_sorts*) |
|
15736 | 417 |
val thmstring = Meson.concat_with_and (map string_of_thm (map snd thml)) |
15642 | 418 |
val thmproofstring = proofstring ( thmstring) |
419 |
val no_returns =List.filter not_newline ( thmproofstring) |
|
420 |
val thmstr = implode no_returns |
|
16259 | 421 |
val outfile = TextIO.openOut(File.platform_path(File.tmp_path (Path.basic "thml_file"))) |
15642 | 422 |
val _ = TextIO.output(outfile, "thmstr is "^thmstr) |
423 |
val _ = TextIO.flushOut outfile; |
|
424 |
val _ = TextIO.closeOut outfile |
|
425 |
(*val _ = set show_sorts*) |
|
426 |
in |
|
427 |
((snd( hd thml)), recons) |
|
428 |
end |
|
429 |
| follow clauses (h::t) allvars thml recons |
|
430 |
= let |
|
431 |
val (thml', recons') = follow_line clauses allvars thml h recons |
|
432 |
val (thm, recons_list) = follow clauses t allvars thml' recons' |
|
433 |
||
434 |
||
435 |
in |
|
436 |
(thm,recons_list) |
|
437 |
end |
|
438 |
||
439 |
*) |
|
440 |
||
16061 | 441 |
fun replace_clause_strs [] recons newrecons = (newrecons) |
442 |
| replace_clause_strs ((thmnum, thm)::thml) |
|
443 |
((clausenum,(step,clause_strs,thmvars))::recons) newrecons = |
|
444 |
let val new_clause_strs = ReconOrderClauses.get_meta_lits_bracket thm |
|
445 |
in |
|
446 |
replace_clause_strs thml recons |
|
447 |
((clausenum,(step,new_clause_strs,thmvars))::newrecons) |
|
448 |
end |
|
15642 | 449 |
|
450 |
||
451 |
fun follow clauses [] allvars thml recons = |
|
16061 | 452 |
let |
453 |
val new_recons = replace_clause_strs thml recons [] |
|
454 |
in |
|
455 |
(#2(hd thml), new_recons) |
|
456 |
end |
|
457 |
| follow clauses (h::t) allvars thml recons = |
|
458 |
let |
|
459 |
val (thml', recons') = follow_line clauses allvars thml h recons |
|
460 |
val (thm, recons_list) = follow clauses t allvars thml' recons' |
|
461 |
in |
|
462 |
(thm,recons_list) |
|
463 |
end |
|
15642 | 464 |
|
465 |
||
466 |
||
467 |
(* Assume we have the cnf clauses as a list of (clauseno, clause) *) |
|
468 |
(* and the proof as a list of the proper datatype *) |
|
469 |
(* take the cnf clauses of the goal and the proof from the res. prover *) |
|
470 |
(* as a list of type Proofstep and return the thm goal ==> False *) |
|
471 |
||
472 |
fun first_pair (a,b,c) = (a,b); |
|
473 |
||
474 |
fun second_pair (a,b,c) = (b,c); |
|
475 |
||
476 |
(* takes original axioms, proof_steps parsed from spass, variables *) |
|
477 |
||
478 |
fun translate_proof clauses proof allvars |
|
479 |
= let val (thm, recons) = follow clauses proof allvars [] [] |
|
480 |
in |
|
481 |
(thm, (recons)) |
|
482 |
end |
|
483 |
||
484 |
||
485 |
||
486 |
fun remove_tinfo [] = [] |
|
16061 | 487 |
| remove_tinfo ( (clausenum, step, T_info, newstrs)::xs) = |
488 |
(clausenum, step , newstrs)::(remove_tinfo xs) |