src/HOL/Import/import_package.ML
author wenzelm
Wed, 04 Apr 2007 00:11:03 +0200
changeset 22578 b0eb5652f210
parent 21590 ef7278f553eb
child 22846 fb79144af9a3
permissions -rw-r--r--
removed obsolete sign_of/sign_of_thm;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
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
a183dec876ab Added HOL proof importer.
skalberg
parents:
diff changeset
     6
signature IMPORT_PACKAGE =
a183dec876ab Added HOL proof importer.
skalberg
parents:
diff changeset
     7
sig
15703
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15531
diff changeset
     8
    val import_meth: Method.src -> Proof.context -> Proof.method
18708
4b3dadb4fe33 setup: theory -> theory;
wenzelm
parents: 17657
diff changeset
     9
    val setup      : theory -> theory
14516
a183dec876ab Added HOL proof importer.
skalberg
parents:
diff changeset
    10
    val debug      : bool ref
a183dec876ab Added HOL proof importer.
skalberg
parents:
diff changeset
    11
end
a183dec876ab Added HOL proof importer.
skalberg
parents:
diff changeset
    12
14620
1be590fd2422 Minor cleanup of headers and some speedup of the HOL4 import.
skalberg
parents: 14516
diff changeset
    13
structure ImportDataArgs: THEORY_DATA_ARGS =
1be590fd2422 Minor cleanup of headers and some speedup of the HOL4 import.
skalberg
parents: 14516
diff changeset
    14
struct
1be590fd2422 Minor cleanup of headers and some speedup of the HOL4 import.
skalberg
parents: 14516
diff changeset
    15
val name = "HOL4/import_data"
1be590fd2422 Minor cleanup of headers and some speedup of the HOL4 import.
skalberg
parents: 14516
diff changeset
    16
type T = ProofKernel.thm option array option
15531
08c8dad8e399 Deleted Library.option type.
skalberg
parents: 14848
diff changeset
    17
val empty = NONE
14620
1be590fd2422 Minor cleanup of headers and some speedup of the HOL4 import.
skalberg
parents: 14516
diff changeset
    18
val copy = I
16424
18a07ad8fea8 accomodate change of TheoryDataFun;
wenzelm
parents: 15707
diff changeset
    19
val extend = I
18a07ad8fea8 accomodate change of TheoryDataFun;
wenzelm
parents: 15707
diff changeset
    20
fun merge _ _ = NONE
18a07ad8fea8 accomodate change of TheoryDataFun;
wenzelm
parents: 15707
diff changeset
    21
fun print _ _ = ()
14620
1be590fd2422 Minor cleanup of headers and some speedup of the HOL4 import.
skalberg
parents: 14516
diff changeset
    22
end
1be590fd2422 Minor cleanup of headers and some speedup of the HOL4 import.
skalberg
parents: 14516
diff changeset
    23
1be590fd2422 Minor cleanup of headers and some speedup of the HOL4 import.
skalberg
parents: 14516
diff changeset
    24
structure ImportData = TheoryDataFun(ImportDataArgs)
1be590fd2422 Minor cleanup of headers and some speedup of the HOL4 import.
skalberg
parents: 14516
diff changeset
    25
14516
a183dec876ab Added HOL proof importer.
skalberg
parents:
diff changeset
    26
structure ImportPackage :> IMPORT_PACKAGE =
a183dec876ab Added HOL proof importer.
skalberg
parents:
diff changeset
    27
struct
a183dec876ab Added HOL proof importer.
skalberg
parents:
diff changeset
    28
a183dec876ab Added HOL proof importer.
skalberg
parents:
diff changeset
    29
val debug = ref false
a183dec876ab Added HOL proof importer.
skalberg
parents:
diff changeset
    30
fun message s = if !debug then writeln s else ()
a183dec876ab Added HOL proof importer.
skalberg
parents:
diff changeset
    31
14848
83f1dc18f1f1 oops -- no Output.out here;
wenzelm
parents: 14818
diff changeset
    32
val string_of_thm = Library.setmp print_mode [] string_of_thm;
83f1dc18f1f1 oops -- no Output.out here;
wenzelm
parents: 14818
diff changeset
    33
val string_of_cterm = Library.setmp print_mode [] string_of_cterm;
14516
a183dec876ab Added HOL proof importer.
skalberg
parents:
diff changeset
    34
a183dec876ab Added HOL proof importer.
skalberg
parents:
diff changeset
    35
fun import_tac (thyname,thmname) =
17370
754b7fcff03e global quick_and_dirty;
wenzelm
parents: 16424
diff changeset
    36
    if ! quick_and_dirty
14516
a183dec876ab Added HOL proof importer.
skalberg
parents:
diff changeset
    37
    then SkipProof.cheat_tac
a183dec876ab Added HOL proof importer.
skalberg
parents:
diff changeset
    38
    else
a183dec876ab Added HOL proof importer.
skalberg
parents:
diff changeset
    39
     fn thy =>
a183dec876ab Added HOL proof importer.
skalberg
parents:
diff changeset
    40
     fn th =>
21590
ef7278f553eb tuned spaces/comments;
wenzelm
parents: 18708
diff changeset
    41
        let
22578
b0eb5652f210 removed obsolete sign_of/sign_of_thm;
wenzelm
parents: 21590
diff changeset
    42
            val sg = Thm.theory_of_thm th
21590
ef7278f553eb tuned spaces/comments;
wenzelm
parents: 18708
diff changeset
    43
            val prem = hd (prems_of th)
17644
bd59bfd4bf37 fixed disambiguation problem
obua
parents: 17626
diff changeset
    44
            val _ = message ("Import_tac: thyname="^thyname^", thmname="^thmname)
21590
ef7278f553eb tuned spaces/comments;
wenzelm
parents: 18708
diff changeset
    45
            val _ = message ("Import trying to prove " ^ (string_of_cterm (cterm_of sg prem)))
ef7278f553eb tuned spaces/comments;
wenzelm
parents: 18708
diff changeset
    46
            val int_thms = case ImportData.get thy of
ef7278f553eb tuned spaces/comments;
wenzelm
parents: 18708
diff changeset
    47
                               NONE => fst (Replay.setup_int_thms thyname thy)
ef7278f553eb tuned spaces/comments;
wenzelm
parents: 18708
diff changeset
    48
                             | SOME a => a
ef7278f553eb tuned spaces/comments;
wenzelm
parents: 18708
diff changeset
    49
            val proof = snd (ProofKernel.import_proof thyname thmname thy) thy
ef7278f553eb tuned spaces/comments;
wenzelm
parents: 18708
diff changeset
    50
            val hol4thm = snd (Replay.replay_proof int_thms thyname thmname proof thy)
ef7278f553eb tuned spaces/comments;
wenzelm
parents: 18708
diff changeset
    51
            val thm = snd (ProofKernel.to_isa_thm hol4thm)
ef7278f553eb tuned spaces/comments;
wenzelm
parents: 18708
diff changeset
    52
            val rew = ProofKernel.rewrite_hol4_term (concl_of thm) thy
ef7278f553eb tuned spaces/comments;
wenzelm
parents: 18708
diff changeset
    53
            val thm = equal_elim rew thm
ef7278f553eb tuned spaces/comments;
wenzelm
parents: 18708
diff changeset
    54
            val prew = ProofKernel.rewrite_hol4_term prem thy
ef7278f553eb tuned spaces/comments;
wenzelm
parents: 18708
diff changeset
    55
            val prem' = #2 (Logic.dest_equals (prop_of prew))
ef7278f553eb tuned spaces/comments;
wenzelm
parents: 18708
diff changeset
    56
            val _ = message ("Import proved " ^ (string_of_thm thm))
17657
2f5f595eb618 moved disambiguate_frees to ProofKernel;
wenzelm
parents: 17652
diff changeset
    57
            val thm = ProofKernel.disambiguate_frees thm
21590
ef7278f553eb tuned spaces/comments;
wenzelm
parents: 18708
diff changeset
    58
            val _ = message ("Disambiguate: " ^ (string_of_thm thm))
ef7278f553eb tuned spaces/comments;
wenzelm
parents: 18708
diff changeset
    59
        in
ef7278f553eb tuned spaces/comments;
wenzelm
parents: 18708
diff changeset
    60
            case Shuffler.set_prop thy prem' [("",thm)] of
ef7278f553eb tuned spaces/comments;
wenzelm
parents: 18708
diff changeset
    61
                SOME (_,thm) =>
ef7278f553eb tuned spaces/comments;
wenzelm
parents: 18708
diff changeset
    62
                let
ef7278f553eb tuned spaces/comments;
wenzelm
parents: 18708
diff changeset
    63
                    val _ = if prem' aconv (prop_of thm)
ef7278f553eb tuned spaces/comments;
wenzelm
parents: 18708
diff changeset
    64
                            then message "import: Terms match up"
ef7278f553eb tuned spaces/comments;
wenzelm
parents: 18708
diff changeset
    65
                            else message "import: Terms DO NOT match up"
ef7278f553eb tuned spaces/comments;
wenzelm
parents: 18708
diff changeset
    66
                    val thm' = equal_elim (symmetric prew) thm
ef7278f553eb tuned spaces/comments;
wenzelm
parents: 18708
diff changeset
    67
                    val res = bicompose true (false,thm',0) 1 th
ef7278f553eb tuned spaces/comments;
wenzelm
parents: 18708
diff changeset
    68
                in
ef7278f553eb tuned spaces/comments;
wenzelm
parents: 18708
diff changeset
    69
                    res
ef7278f553eb tuned spaces/comments;
wenzelm
parents: 18708
diff changeset
    70
                end
ef7278f553eb tuned spaces/comments;
wenzelm
parents: 18708
diff changeset
    71
              | NONE => (message "import: set_prop didn't succeed"; no_tac th)
ef7278f553eb tuned spaces/comments;
wenzelm
parents: 18708
diff changeset
    72
        end
ef7278f553eb tuned spaces/comments;
wenzelm
parents: 18708
diff changeset
    73
14516
a183dec876ab Added HOL proof importer.
skalberg
parents:
diff changeset
    74
val import_meth = Method.simple_args (Args.name -- Args.name)
21590
ef7278f553eb tuned spaces/comments;
wenzelm
parents: 18708
diff changeset
    75
                  (fn arg =>
ef7278f553eb tuned spaces/comments;
wenzelm
parents: 18708
diff changeset
    76
                   fn ctxt =>
ef7278f553eb tuned spaces/comments;
wenzelm
parents: 18708
diff changeset
    77
                      let
ef7278f553eb tuned spaces/comments;
wenzelm
parents: 18708
diff changeset
    78
                          val thy = ProofContext.theory_of ctxt
ef7278f553eb tuned spaces/comments;
wenzelm
parents: 18708
diff changeset
    79
                      in
ef7278f553eb tuned spaces/comments;
wenzelm
parents: 18708
diff changeset
    80
                          Method.SIMPLE_METHOD (import_tac arg thy)
ef7278f553eb tuned spaces/comments;
wenzelm
parents: 18708
diff changeset
    81
                      end)
14516
a183dec876ab Added HOL proof importer.
skalberg
parents:
diff changeset
    82
18708
4b3dadb4fe33 setup: theory -> theory;
wenzelm
parents: 17657
diff changeset
    83
val setup = Method.add_method("import",import_meth,"Import HOL4 theorem") #> ImportData.init
14516
a183dec876ab Added HOL proof importer.
skalberg
parents:
diff changeset
    84
end
15707
80b421d8a8be *** MESSAGE REFERS TO PREVIOUS VERSION ***
wenzelm
parents: 15703
diff changeset
    85