src/HOLCF/One.thy
author wenzelm
Fri, 15 Aug 2008 16:08:08 +0200
changeset 27893 7c97cf70d663
parent 27293 de9a2fd0eab4
child 29138 661a8db7e647
permissions -rw-r--r--
added README;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
2640
ee4dfce170a0 Changes of HOLCF from Oscar Slotosch:
slotosch
parents: 2275
diff changeset
     1
(*  Title:      HOLCF/One.thy
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: 2275
diff changeset
     3
    Author:     Oscar Slotosch
16070
4a83dd540b88 removed LICENCE note -- everything is subject to Isabelle licence as
wenzelm
parents: 15577
diff changeset
     4
4a83dd540b88 removed LICENCE note -- everything is subject to Isabelle licence as
wenzelm
parents: 15577
diff changeset
     5
The unit domain.
243
c22b85994e17 Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff changeset
     6
*)
c22b85994e17 Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff changeset
     7
15577
e16da3068ad6 fix headers
huffman
parents: 15576
diff changeset
     8
header {* The unit domain *}
e16da3068ad6 fix headers
huffman
parents: 15576
diff changeset
     9
e16da3068ad6 fix headers
huffman
parents: 15576
diff changeset
    10
theory One
e16da3068ad6 fix headers
huffman
parents: 15576
diff changeset
    11
imports Lift
e16da3068ad6 fix headers
huffman
parents: 15576
diff changeset
    12
begin
243
c22b85994e17 Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff changeset
    13
15576
efb95d0d01f7 converted to new-style theories, and combined numbered files
huffman
parents: 14981
diff changeset
    14
types one = "unit lift"
25131
2c8caac48ade modernized specifications ('definition', 'abbreviation', 'notation');
wenzelm
parents: 18111
diff changeset
    15
translations
2c8caac48ade modernized specifications ('definition', 'abbreviation', 'notation');
wenzelm
parents: 18111
diff changeset
    16
  "one" <= (type) "unit lift" 
243
c22b85994e17 Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff changeset
    17
3717
e28553315355 eliminated rules;
wenzelm
parents: 2640
diff changeset
    18
constdefs
e28553315355 eliminated rules;
wenzelm
parents: 2640
diff changeset
    19
  ONE :: "one"
25131
2c8caac48ade modernized specifications ('definition', 'abbreviation', 'notation');
wenzelm
parents: 18111
diff changeset
    20
  "ONE == Def ()"
243
c22b85994e17 Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff changeset
    21
16747
934b6b36d794 cleaned up
huffman
parents: 16070
diff changeset
    22
text {* Exhaustion and Elimination for type @{typ one} *}
15576
efb95d0d01f7 converted to new-style theories, and combined numbered files
huffman
parents: 14981
diff changeset
    23
16747
934b6b36d794 cleaned up
huffman
parents: 16070
diff changeset
    24
lemma Exh_one: "t = \<bottom> \<or> t = ONE"
27293
de9a2fd0eab4 added some lemmas; tuned proofs
huffman
parents: 25131
diff changeset
    25
unfolding ONE_def by (induct t) simp_all
15576
efb95d0d01f7 converted to new-style theories, and combined numbered files
huffman
parents: 14981
diff changeset
    26
16747
934b6b36d794 cleaned up
huffman
parents: 16070
diff changeset
    27
lemma oneE: "\<lbrakk>p = \<bottom> \<Longrightarrow> Q; p = ONE \<Longrightarrow> Q\<rbrakk> \<Longrightarrow> Q"
27293
de9a2fd0eab4 added some lemmas; tuned proofs
huffman
parents: 25131
diff changeset
    28
unfolding ONE_def by (induct p) simp_all
de9a2fd0eab4 added some lemmas; tuned proofs
huffman
parents: 25131
diff changeset
    29
de9a2fd0eab4 added some lemmas; tuned proofs
huffman
parents: 25131
diff changeset
    30
lemma one_induct: "\<lbrakk>P \<bottom>; P ONE\<rbrakk> \<Longrightarrow> P x"
de9a2fd0eab4 added some lemmas; tuned proofs
huffman
parents: 25131
diff changeset
    31
by (cases x rule: oneE) simp_all
15576
efb95d0d01f7 converted to new-style theories, and combined numbered files
huffman
parents: 14981
diff changeset
    32
16747
934b6b36d794 cleaned up
huffman
parents: 16070
diff changeset
    33
lemma dist_less_one [simp]: "\<not> ONE \<sqsubseteq> \<bottom>"
27293
de9a2fd0eab4 added some lemmas; tuned proofs
huffman
parents: 25131
diff changeset
    34
unfolding ONE_def by simp
de9a2fd0eab4 added some lemmas; tuned proofs
huffman
parents: 25131
diff changeset
    35
de9a2fd0eab4 added some lemmas; tuned proofs
huffman
parents: 25131
diff changeset
    36
lemma less_ONE [simp]: "x \<sqsubseteq> ONE"
de9a2fd0eab4 added some lemmas; tuned proofs
huffman
parents: 25131
diff changeset
    37
by (induct x rule: one_induct) simp_all
de9a2fd0eab4 added some lemmas; tuned proofs
huffman
parents: 25131
diff changeset
    38
de9a2fd0eab4 added some lemmas; tuned proofs
huffman
parents: 25131
diff changeset
    39
lemma ONE_less_iff [simp]: "ONE \<sqsubseteq> x \<longleftrightarrow> x = ONE"
de9a2fd0eab4 added some lemmas; tuned proofs
huffman
parents: 25131
diff changeset
    40
by (induct x rule: one_induct) simp_all
15576
efb95d0d01f7 converted to new-style theories, and combined numbered files
huffman
parents: 14981
diff changeset
    41
16747
934b6b36d794 cleaned up
huffman
parents: 16070
diff changeset
    42
lemma dist_eq_one [simp]: "ONE \<noteq> \<bottom>" "\<bottom> \<noteq> ONE"
27293
de9a2fd0eab4 added some lemmas; tuned proofs
huffman
parents: 25131
diff changeset
    43
unfolding ONE_def by simp_all
15576
efb95d0d01f7 converted to new-style theories, and combined numbered files
huffman
parents: 14981
diff changeset
    44
27293
de9a2fd0eab4 added some lemmas; tuned proofs
huffman
parents: 25131
diff changeset
    45
lemma one_neq_iffs [simp]:
de9a2fd0eab4 added some lemmas; tuned proofs
huffman
parents: 25131
diff changeset
    46
  "x \<noteq> ONE \<longleftrightarrow> x = \<bottom>"
de9a2fd0eab4 added some lemmas; tuned proofs
huffman
parents: 25131
diff changeset
    47
  "ONE \<noteq> x \<longleftrightarrow> x = \<bottom>"
de9a2fd0eab4 added some lemmas; tuned proofs
huffman
parents: 25131
diff changeset
    48
  "x \<noteq> \<bottom> \<longleftrightarrow> x = ONE"
de9a2fd0eab4 added some lemmas; tuned proofs
huffman
parents: 25131
diff changeset
    49
  "\<bottom> \<noteq> x \<longleftrightarrow> x = ONE"
de9a2fd0eab4 added some lemmas; tuned proofs
huffman
parents: 25131
diff changeset
    50
by (induct x rule: one_induct) simp_all
de9a2fd0eab4 added some lemmas; tuned proofs
huffman
parents: 25131
diff changeset
    51
de9a2fd0eab4 added some lemmas; tuned proofs
huffman
parents: 25131
diff changeset
    52
lemma compact_ONE: "compact ONE"
17838
3032e90c4975 added compactness theorems
huffman
parents: 16747
diff changeset
    53
by (rule compact_chfin)
3032e90c4975 added compactness theorems
huffman
parents: 16747
diff changeset
    54
18080
c1a7490ee3ff add constant one_when; LAM pattern for ONE
huffman
parents: 17838
diff changeset
    55
text {* Case analysis function for type @{typ one} *}
c1a7490ee3ff add constant one_when; LAM pattern for ONE
huffman
parents: 17838
diff changeset
    56
25131
2c8caac48ade modernized specifications ('definition', 'abbreviation', 'notation');
wenzelm
parents: 18111
diff changeset
    57
definition
2c8caac48ade modernized specifications ('definition', 'abbreviation', 'notation');
wenzelm
parents: 18111
diff changeset
    58
  one_when :: "'a::pcpo \<rightarrow> one \<rightarrow> 'a" where
2c8caac48ade modernized specifications ('definition', 'abbreviation', 'notation');
wenzelm
parents: 18111
diff changeset
    59
  "one_when = (\<Lambda> a. strictify\<cdot>(\<Lambda> _. a))"
18080
c1a7490ee3ff add constant one_when; LAM pattern for ONE
huffman
parents: 17838
diff changeset
    60
c1a7490ee3ff add constant one_when; LAM pattern for ONE
huffman
parents: 17838
diff changeset
    61
translations
27293
de9a2fd0eab4 added some lemmas; tuned proofs
huffman
parents: 25131
diff changeset
    62
  "case x of XCONST ONE \<Rightarrow> t" == "CONST one_when\<cdot>t\<cdot>x"
de9a2fd0eab4 added some lemmas; tuned proofs
huffman
parents: 25131
diff changeset
    63
  "\<Lambda> (XCONST ONE). t" == "CONST one_when\<cdot>t"
18080
c1a7490ee3ff add constant one_when; LAM pattern for ONE
huffman
parents: 17838
diff changeset
    64
18111
2b56f74fd605 add case syntax for type one
huffman
parents: 18080
diff changeset
    65
lemma one_when1 [simp]: "(case \<bottom> of ONE \<Rightarrow> t) = \<bottom>"
18080
c1a7490ee3ff add constant one_when; LAM pattern for ONE
huffman
parents: 17838
diff changeset
    66
by (simp add: one_when_def)
c1a7490ee3ff add constant one_when; LAM pattern for ONE
huffman
parents: 17838
diff changeset
    67
18111
2b56f74fd605 add case syntax for type one
huffman
parents: 18080
diff changeset
    68
lemma one_when2 [simp]: "(case ONE of ONE \<Rightarrow> t) = t"
18080
c1a7490ee3ff add constant one_when; LAM pattern for ONE
huffman
parents: 17838
diff changeset
    69
by (simp add: one_when_def)
c1a7490ee3ff add constant one_when; LAM pattern for ONE
huffman
parents: 17838
diff changeset
    70
18111
2b56f74fd605 add case syntax for type one
huffman
parents: 18080
diff changeset
    71
lemma one_when3 [simp]: "(case x of ONE \<Rightarrow> ONE) = x"
27293
de9a2fd0eab4 added some lemmas; tuned proofs
huffman
parents: 25131
diff changeset
    72
by (induct x rule: one_induct) simp_all
18080
c1a7490ee3ff add constant one_when; LAM pattern for ONE
huffman
parents: 17838
diff changeset
    73
243
c22b85994e17 Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff changeset
    74
end