| author | paulson | 
| Mon, 12 Nov 2001 12:38:06 +0100 | |
| changeset 12158 | f60fe41e96e9 | 
| parent 12030 | 46d57d0290a2 | 
| child 14981 | e73f8140af78 | 
| 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 | 
| 12030 | 4 | License: GPL (GNU GENERAL PUBLIC LICENSE) | 
| 243 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 5 | |
| 12030 | 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: 
9245diff
changeset | 13 | Goalw [ONE_def] "t=UU | t = ONE"; | 
| 12030 | 14 | by (induct_tac "t" 1); | 
| 9245 | 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: 
9245diff
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); |