author | obua |
Tue, 07 Mar 2006 16:03:31 +0100 | |
changeset 19203 | 778507520684 |
parent 18708 | 4b3dadb4fe33 |
child 20223 | 89d2758ecddf |
permissions | -rw-r--r-- |
1985
84cf16192e03
Tidied many proofs, using AddIffs to let equivalences take
paulson
parents:
diff
changeset
|
1 |
(* Title: HOL/cladata.ML |
84cf16192e03
Tidied many proofs, using AddIffs to let equivalences take
paulson
parents:
diff
changeset
|
2 |
ID: $Id$ |
84cf16192e03
Tidied many proofs, using AddIffs to let equivalences take
paulson
parents:
diff
changeset
|
3 |
Author: Tobias Nipkow |
84cf16192e03
Tidied many proofs, using AddIffs to let equivalences take
paulson
parents:
diff
changeset
|
4 |
Copyright 1996 University of Cambridge |
84cf16192e03
Tidied many proofs, using AddIffs to let equivalences take
paulson
parents:
diff
changeset
|
5 |
|
4085 | 6 |
Setting up the classical reasoner. |
1985
84cf16192e03
Tidied many proofs, using AddIffs to let equivalences take
paulson
parents:
diff
changeset
|
7 |
*) |
84cf16192e03
Tidied many proofs, using AddIffs to let equivalences take
paulson
parents:
diff
changeset
|
8 |
|
84cf16192e03
Tidied many proofs, using AddIffs to let equivalences take
paulson
parents:
diff
changeset
|
9 |
|
84cf16192e03
Tidied many proofs, using AddIffs to let equivalences take
paulson
parents:
diff
changeset
|
10 |
(** Applying HypsubstFun to generate hyp_subst_tac **) |
84cf16192e03
Tidied many proofs, using AddIffs to let equivalences take
paulson
parents:
diff
changeset
|
11 |
section "Classical Reasoner"; |
84cf16192e03
Tidied many proofs, using AddIffs to let equivalences take
paulson
parents:
diff
changeset
|
12 |
|
84cf16192e03
Tidied many proofs, using AddIffs to let equivalences take
paulson
parents:
diff
changeset
|
13 |
structure Hypsubst_Data = |
84cf16192e03
Tidied many proofs, using AddIffs to let equivalences take
paulson
parents:
diff
changeset
|
14 |
struct |
84cf16192e03
Tidied many proofs, using AddIffs to let equivalences take
paulson
parents:
diff
changeset
|
15 |
structure Simplifier = Simplifier |
84cf16192e03
Tidied many proofs, using AddIffs to let equivalences take
paulson
parents:
diff
changeset
|
16 |
(*Take apart an equality judgement; otherwise raise Match!*) |
4466
305390f23734
Better equality handling in Blast_tac, usingd a new variant of hyp_subst_tac
paulson
parents:
4305
diff
changeset
|
17 |
fun dest_eq (Const("op =",T) $ t $ u) = (t, u, domain_type T) |
305390f23734
Better equality handling in Blast_tac, usingd a new variant of hyp_subst_tac
paulson
parents:
4305
diff
changeset
|
18 |
val dest_Trueprop = HOLogic.dest_Trueprop |
305390f23734
Better equality handling in Blast_tac, usingd a new variant of hyp_subst_tac
paulson
parents:
4305
diff
changeset
|
19 |
val dest_imp = HOLogic.dest_imp |
1985
84cf16192e03
Tidied many proofs, using AddIffs to let equivalences take
paulson
parents:
diff
changeset
|
20 |
val eq_reflection = eq_reflection |
9531 | 21 |
val rev_eq_reflection = def_imp_eq |
1985
84cf16192e03
Tidied many proofs, using AddIffs to let equivalences take
paulson
parents:
diff
changeset
|
22 |
val imp_intr = impI |
84cf16192e03
Tidied many proofs, using AddIffs to let equivalences take
paulson
parents:
diff
changeset
|
23 |
val rev_mp = rev_mp |
84cf16192e03
Tidied many proofs, using AddIffs to let equivalences take
paulson
parents:
diff
changeset
|
24 |
val subst = subst |
84cf16192e03
Tidied many proofs, using AddIffs to let equivalences take
paulson
parents:
diff
changeset
|
25 |
val sym = sym |
7357 | 26 |
val thin_refl = prove_goal (the_context ()) |
4223 | 27 |
"!!X. [|x=x; PROP W|] ==> PROP W" (K [atac 1]); |
1985
84cf16192e03
Tidied many proofs, using AddIffs to let equivalences take
paulson
parents:
diff
changeset
|
28 |
end; |
84cf16192e03
Tidied many proofs, using AddIffs to let equivalences take
paulson
parents:
diff
changeset
|
29 |
|
84cf16192e03
Tidied many proofs, using AddIffs to let equivalences take
paulson
parents:
diff
changeset
|
30 |
structure Hypsubst = HypsubstFun(Hypsubst_Data); |
84cf16192e03
Tidied many proofs, using AddIffs to let equivalences take
paulson
parents:
diff
changeset
|
31 |
open Hypsubst; |
84cf16192e03
Tidied many proofs, using AddIffs to let equivalences take
paulson
parents:
diff
changeset
|
32 |
|
12355 | 33 |
(*prevent substitution on bool*) |
34 |
fun hyp_subst_tac' i thm = if i <= Thm.nprems_of thm andalso |
|
35 |
Term.exists_Const (fn ("op =", Type (_, [T, _])) => T <> Type ("bool", []) | _ => false) |
|
15570 | 36 |
(List.nth (Thm.prems_of thm, i - 1)) then hyp_subst_tac i thm else no_tac thm; |
12355 | 37 |
|
38 |
||
1985
84cf16192e03
Tidied many proofs, using AddIffs to let equivalences take
paulson
parents:
diff
changeset
|
39 |
(*** Applying ClassicalFun to create a classical prover ***) |
84cf16192e03
Tidied many proofs, using AddIffs to let equivalences take
paulson
parents:
diff
changeset
|
40 |
structure Classical_Data = |
84cf16192e03
Tidied many proofs, using AddIffs to let equivalences take
paulson
parents:
diff
changeset
|
41 |
struct |
84cf16192e03
Tidied many proofs, using AddIffs to let equivalences take
paulson
parents:
diff
changeset
|
42 |
val mp = mp |
84cf16192e03
Tidied many proofs, using AddIffs to let equivalences take
paulson
parents:
diff
changeset
|
43 |
val not_elim = notE |
84cf16192e03
Tidied many proofs, using AddIffs to let equivalences take
paulson
parents:
diff
changeset
|
44 |
val classical = classical |
9158 | 45 |
val sizef = size_of_thm |
4206 | 46 |
val hyp_subst_tacs=[hyp_subst_tac] |
1985
84cf16192e03
Tidied many proofs, using AddIffs to let equivalences take
paulson
parents:
diff
changeset
|
47 |
end; |
84cf16192e03
Tidied many proofs, using AddIffs to let equivalences take
paulson
parents:
diff
changeset
|
48 |
|
84cf16192e03
Tidied many proofs, using AddIffs to let equivalences take
paulson
parents:
diff
changeset
|
49 |
structure Classical = ClassicalFun(Classical_Data); |
10197 | 50 |
|
51 |
structure BasicClassical: BASIC_CLASSICAL = Classical; |
|
52 |
||
18362
e8b7e0a22727
removed thms 'swap' and 'nth_map' from ML toplevel
haftmann
parents:
17876
diff
changeset
|
53 |
open BasicClassical; |
e8b7e0a22727
removed thms 'swap' and 'nth_map' from ML toplevel
haftmann
parents:
17876
diff
changeset
|
54 |
|
18368 | 55 |
val _ = bind_thm ("contrapos_np", inst "Pa" "?Q" Classical.swap); |
10197 | 56 |
|
1985
84cf16192e03
Tidied many proofs, using AddIffs to let equivalences take
paulson
parents:
diff
changeset
|
57 |
(*Propositional rules*) |
84cf16192e03
Tidied many proofs, using AddIffs to let equivalences take
paulson
parents:
diff
changeset
|
58 |
val prop_cs = empty_cs addSIs [refl,TrueI,conjI,disjCI,impI,notI,iffI] |
4305
03d7de40ee4f
The change from iffE to iffCE means fewer case splits in most cases. Very few
paulson
parents:
4240
diff
changeset
|
59 |
addSEs [conjE,disjE,impCE,FalseE,iffCE]; |
1985
84cf16192e03
Tidied many proofs, using AddIffs to let equivalences take
paulson
parents:
diff
changeset
|
60 |
|
84cf16192e03
Tidied many proofs, using AddIffs to let equivalences take
paulson
parents:
diff
changeset
|
61 |
(*Quantifier rules*) |
11451
8abfb4f7bd02
partial restructuring to reduce dependence on Axiom of Choice
paulson
parents:
11440
diff
changeset
|
62 |
val HOL_cs = prop_cs addSIs [allI,ex_ex1I] addIs [exI, the_equality] |
3004 | 63 |
addSEs [exE] addEs [allE]; |
1985
84cf16192e03
Tidied many proofs, using AddIffs to let equivalences take
paulson
parents:
diff
changeset
|
64 |
|
18708 | 65 |
val clasetup = (fn thy => (change_claset_of thy (fn _ => HOL_cs); thy)); |