author | oheimb |
Tue, 20 Feb 2001 18:47:29 +0100 | |
changeset 11166 | eca861fd1eb5 |
parent 9248 | e1dee89de037 |
child 12030 | 46d57d0290a2 |
permissions | -rw-r--r-- |
2275 | 1 |
(* Title: HOLCF/One.ML |
243
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
2 |
ID: $Id$ |
2640 | 3 |
Author: Oscar Slotosch |
4 |
Copyright 1997 Technische Universitaet Muenchen |
|
243
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
5 |
|
9245 | 6 |
The unit domain |
243
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
7 |
*) |
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
8 |
|
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
9 |
(* ------------------------------------------------------------------------ *) |
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
10 |
(* Exhaustion and Elimination for type one *) |
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
11 |
(* ------------------------------------------------------------------------ *) |
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
12 |
|
9248
e1dee89de037
massive tidy-up: goal -> Goal, remove use of prems, etc.
paulson
parents:
9245
diff
changeset
|
13 |
Goalw [ONE_def] "t=UU | t = ONE"; |
9245 | 14 |
by (lift.induct_tac "t" 1); |
15 |
by (Simp_tac 1); |
|
16 |
by (Simp_tac 1); |
|
17 |
qed "Exh_one"; |
|
243
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
18 |
|
9248
e1dee89de037
massive tidy-up: goal -> Goal, remove use of prems, etc.
paulson
parents:
9245
diff
changeset
|
19 |
val prems = Goal "[| p=UU ==> Q; p = ONE ==>Q|] ==>Q"; |
9245 | 20 |
by (rtac (Exh_one RS disjE) 1); |
21 |
by (eresolve_tac prems 1); |
|
22 |
by (eresolve_tac prems 1); |
|
23 |
qed "oneE"; |
|
243
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
24 |
|
2640 | 25 |
(* ------------------------------------------------------------------------ *) |
26 |
(* tactic for one-thms *) |
|
27 |
(* ------------------------------------------------------------------------ *) |
|
28 |
||
29 |
fun prover t = prove_goalw thy [ONE_def] t |
|
30 |
(fn prems => |
|
31 |
[ |
|
4098 | 32 |
(asm_simp_tac (simpset() addsimps [inst_lift_po]) 1) |
2640 | 33 |
]); |
34 |
||
243
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
35 |
(* ------------------------------------------------------------------------ *) |
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
36 |
(* distinctness for type one : stored in a list *) |
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
37 |
(* ------------------------------------------------------------------------ *) |
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
38 |
|
2640 | 39 |
val dist_less_one = map prover ["~ONE << UU"]; |
243
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
40 |
|
2640 | 41 |
val dist_eq_one = map prover ["ONE~=UU","UU~=ONE"]; |
243
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
42 |
|
2640 | 43 |
Addsimps (dist_less_one@dist_eq_one); |