src/HOLCF/One.ML
author wenzelm
Sun, 29 Nov 1998 13:14:45 +0100
changeset 5986 6ebbc9e7cc20
parent 5087 ee8a754f1981
child 9245 428385c4bc50
permissions -rw-r--r--
added oct_char;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
2275
dbce3dce821a renamed is_flat to flat,
oheimb
parents: 1461
diff changeset
     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
ee4dfce170a0 Changes of HOLCF from Oscar Slotosch:
slotosch
parents: 2452
diff changeset
     3
    Author:     Oscar Slotosch
ee4dfce170a0 Changes of HOLCF from Oscar Slotosch:
slotosch
parents: 2452
diff changeset
     4
    Copyright   1997 Technische Universitaet Muenchen
243
c22b85994e17 Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff changeset
     5
2640
ee4dfce170a0 Changes of HOLCF from Oscar Slotosch:
slotosch
parents: 2452
diff changeset
     6
Lemmas for One.thy
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
open One;
c22b85994e17 Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff changeset
    10
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
(* Exhaustion and Elimination for type one                                  *)
c22b85994e17 Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff changeset
    13
(* ------------------------------------------------------------------------ *)
c22b85994e17 Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff changeset
    14
2640
ee4dfce170a0 Changes of HOLCF from Oscar Slotosch:
slotosch
parents: 2452
diff changeset
    15
qed_goalw "Exh_one" thy [ONE_def] "t=UU | t = ONE"
243
c22b85994e17 Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff changeset
    16
 (fn prems =>
1461
6bcb44e4d6e5 expanded tabs
clasohm
parents: 1410
diff changeset
    17
        [
2640
ee4dfce170a0 Changes of HOLCF from Oscar Slotosch:
slotosch
parents: 2452
diff changeset
    18
	(lift.induct_tac "t" 1),
ee4dfce170a0 Changes of HOLCF from Oscar Slotosch:
slotosch
parents: 2452
diff changeset
    19
	(Simp_tac 1),
5087
ee8a754f1981 fixed unit_eq;
wenzelm
parents: 4098
diff changeset
    20
	(Simp_tac 1)
2640
ee4dfce170a0 Changes of HOLCF from Oscar Slotosch:
slotosch
parents: 2452
diff changeset
    21
	]);
243
c22b85994e17 Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff changeset
    22
2640
ee4dfce170a0 Changes of HOLCF from Oscar Slotosch:
slotosch
parents: 2452
diff changeset
    23
qed_goal "oneE" thy
ee4dfce170a0 Changes of HOLCF from Oscar Slotosch:
slotosch
parents: 2452
diff changeset
    24
        "[| p=UU ==> Q; p = ONE ==>Q|] ==>Q"
243
c22b85994e17 Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff changeset
    25
 (fn prems =>
1461
6bcb44e4d6e5 expanded tabs
clasohm
parents: 1410
diff changeset
    26
        [
6bcb44e4d6e5 expanded tabs
clasohm
parents: 1410
diff changeset
    27
        (rtac (Exh_one RS disjE) 1),
6bcb44e4d6e5 expanded tabs
clasohm
parents: 1410
diff changeset
    28
        (eresolve_tac prems 1),
6bcb44e4d6e5 expanded tabs
clasohm
parents: 1410
diff changeset
    29
        (eresolve_tac prems 1)
6bcb44e4d6e5 expanded tabs
clasohm
parents: 1410
diff changeset
    30
        ]);
243
c22b85994e17 Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff changeset
    31
2640
ee4dfce170a0 Changes of HOLCF from Oscar Slotosch:
slotosch
parents: 2452
diff changeset
    32
(* ------------------------------------------------------------------------ *) 
ee4dfce170a0 Changes of HOLCF from Oscar Slotosch:
slotosch
parents: 2452
diff changeset
    33
(* tactic for one-thms                                                      *)
ee4dfce170a0 Changes of HOLCF from Oscar Slotosch:
slotosch
parents: 2452
diff changeset
    34
(* ------------------------------------------------------------------------ *)
ee4dfce170a0 Changes of HOLCF from Oscar Slotosch:
slotosch
parents: 2452
diff changeset
    35
ee4dfce170a0 Changes of HOLCF from Oscar Slotosch:
slotosch
parents: 2452
diff changeset
    36
fun prover t = prove_goalw thy [ONE_def] t
ee4dfce170a0 Changes of HOLCF from Oscar Slotosch:
slotosch
parents: 2452
diff changeset
    37
 (fn prems =>
ee4dfce170a0 Changes of HOLCF from Oscar Slotosch:
slotosch
parents: 2452
diff changeset
    38
        [
4098
71e05eb27fb6 isatool fixclasimp;
wenzelm
parents: 2640
diff changeset
    39
	(asm_simp_tac (simpset() addsimps [inst_lift_po]) 1)
2640
ee4dfce170a0 Changes of HOLCF from Oscar Slotosch:
slotosch
parents: 2452
diff changeset
    40
	]);
ee4dfce170a0 Changes of HOLCF from Oscar Slotosch:
slotosch
parents: 2452
diff changeset
    41
243
c22b85994e17 Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff changeset
    42
(* ------------------------------------------------------------------------ *)
c22b85994e17 Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff changeset
    43
(* distinctness for type one : stored in a list                             *)
c22b85994e17 Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff changeset
    44
(* ------------------------------------------------------------------------ *)
c22b85994e17 Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff changeset
    45
2640
ee4dfce170a0 Changes of HOLCF from Oscar Slotosch:
slotosch
parents: 2452
diff changeset
    46
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
    47
2640
ee4dfce170a0 Changes of HOLCF from Oscar Slotosch:
slotosch
parents: 2452
diff changeset
    48
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
    49
2640
ee4dfce170a0 Changes of HOLCF from Oscar Slotosch:
slotosch
parents: 2452
diff changeset
    50
Addsimps (dist_less_one@dist_eq_one);