author | huffman |
Thu, 19 Feb 2009 12:03:31 -0800 | |
changeset 29994 | 6ca6b6bd6e15 |
parent 26928 | ca87aff1ad2d |
child 30510 | 4120fc59dd85 |
permissions | -rw-r--r-- |
14620
1be590fd2422
Minor cleanup of headers and some speedup of the HOL4 import.
skalberg
parents:
14516
diff
changeset
|
1 |
(* Title: HOL/Import/import_package.ML |
1be590fd2422
Minor cleanup of headers and some speedup of the HOL4 import.
skalberg
parents:
14516
diff
changeset
|
2 |
ID: $Id$ |
1be590fd2422
Minor cleanup of headers and some speedup of the HOL4 import.
skalberg
parents:
14516
diff
changeset
|
3 |
Author: Sebastian Skalberg (TU Muenchen) |
1be590fd2422
Minor cleanup of headers and some speedup of the HOL4 import.
skalberg
parents:
14516
diff
changeset
|
4 |
*) |
1be590fd2422
Minor cleanup of headers and some speedup of the HOL4 import.
skalberg
parents:
14516
diff
changeset
|
5 |
|
14516 | 6 |
signature IMPORT_PACKAGE = |
7 |
sig |
|
15703 | 8 |
val import_meth: Method.src -> Proof.context -> Proof.method |
18708 | 9 |
val setup : theory -> theory |
14516 | 10 |
val debug : bool ref |
11 |
end |
|
12 |
||
22846 | 13 |
structure ImportData = TheoryDataFun |
14 |
( |
|
15 |
type T = ProofKernel.thm option array option |
|
16 |
val empty = NONE |
|
17 |
val copy = I |
|
18 |
val extend = I |
|
19 |
fun merge _ _ = NONE |
|
20 |
) |
|
14620
1be590fd2422
Minor cleanup of headers and some speedup of the HOL4 import.
skalberg
parents:
14516
diff
changeset
|
21 |
|
14516 | 22 |
structure ImportPackage :> IMPORT_PACKAGE = |
23 |
struct |
|
24 |
||
25 |
val debug = ref false |
|
26 |
fun message s = if !debug then writeln s else () |
|
27 |
||
26928 | 28 |
val string_of_thm = PrintMode.setmp [] Display.string_of_thm; |
29 |
val string_of_cterm = PrintMode.setmp [] Display.string_of_cterm; |
|
14516 | 30 |
|
31 |
fun import_tac (thyname,thmname) = |
|
17370 | 32 |
if ! quick_and_dirty |
14516 | 33 |
then SkipProof.cheat_tac |
34 |
else |
|
35 |
fn thy => |
|
36 |
fn th => |
|
21590 | 37 |
let |
22578 | 38 |
val sg = Thm.theory_of_thm th |
21590 | 39 |
val prem = hd (prems_of th) |
17644 | 40 |
val _ = message ("Import_tac: thyname="^thyname^", thmname="^thmname) |
21590 | 41 |
val _ = message ("Import trying to prove " ^ (string_of_cterm (cterm_of sg prem))) |
42 |
val int_thms = case ImportData.get thy of |
|
43 |
NONE => fst (Replay.setup_int_thms thyname thy) |
|
44 |
| SOME a => a |
|
45 |
val proof = snd (ProofKernel.import_proof thyname thmname thy) thy |
|
46 |
val hol4thm = snd (Replay.replay_proof int_thms thyname thmname proof thy) |
|
47 |
val thm = snd (ProofKernel.to_isa_thm hol4thm) |
|
48 |
val rew = ProofKernel.rewrite_hol4_term (concl_of thm) thy |
|
49 |
val thm = equal_elim rew thm |
|
50 |
val prew = ProofKernel.rewrite_hol4_term prem thy |
|
51 |
val prem' = #2 (Logic.dest_equals (prop_of prew)) |
|
52 |
val _ = message ("Import proved " ^ (string_of_thm thm)) |
|
17657 | 53 |
val thm = ProofKernel.disambiguate_frees thm |
21590 | 54 |
val _ = message ("Disambiguate: " ^ (string_of_thm thm)) |
55 |
in |
|
56 |
case Shuffler.set_prop thy prem' [("",thm)] of |
|
57 |
SOME (_,thm) => |
|
58 |
let |
|
59 |
val _ = if prem' aconv (prop_of thm) |
|
60 |
then message "import: Terms match up" |
|
61 |
else message "import: Terms DO NOT match up" |
|
62 |
val thm' = equal_elim (symmetric prew) thm |
|
63 |
val res = bicompose true (false,thm',0) 1 th |
|
64 |
in |
|
65 |
res |
|
66 |
end |
|
67 |
| NONE => (message "import: set_prop didn't succeed"; no_tac th) |
|
68 |
end |
|
69 |
||
14516 | 70 |
val import_meth = Method.simple_args (Args.name -- Args.name) |
21590 | 71 |
(fn arg => |
72 |
fn ctxt => |
|
73 |
let |
|
74 |
val thy = ProofContext.theory_of ctxt |
|
75 |
in |
|
76 |
Method.SIMPLE_METHOD (import_tac arg thy) |
|
77 |
end) |
|
14516 | 78 |
|
22846 | 79 |
val setup = Method.add_method("import",import_meth,"Import HOL4 theorem") |
14516 | 80 |
end |
15707 | 81 |