src/HOLCF/Cprod.thy
author huffman
Fri May 08 16:19:51 2009 -0700 (2009-05-08)
changeset 31076 99fe356cbbc2
parent 29535 08824fad8879
child 31113 15cf300a742f
permissions -rw-r--r--
rename constant sq_le to below; rename class sq_ord to below; less->below in many lemma names
huffman@15600
     1
(*  Title:      HOLCF/Cprod.thy
huffman@15576
     2
    Author:     Franz Regensburger
huffman@15576
     3
*)
huffman@15576
     4
huffman@15576
     5
header {* The cpo of cartesian products *}
huffman@15576
     6
huffman@15577
     7
theory Cprod
huffman@25910
     8
imports Bifinite
huffman@15577
     9
begin
huffman@15576
    10
huffman@15576
    11
defaultsort cpo
huffman@15576
    12
huffman@16008
    13
subsection {* Type @{typ unit} is a pcpo *}
huffman@16008
    14
wenzelm@25131
    15
definition
wenzelm@25131
    16
  unit_when :: "'a \<rightarrow> unit \<rightarrow> 'a" where
wenzelm@25131
    17
  "unit_when = (\<Lambda> a _. a)"
huffman@16008
    18
huffman@18289
    19
translations
wenzelm@25131
    20
  "\<Lambda>(). t" == "CONST unit_when\<cdot>t"
huffman@18289
    21
huffman@18289
    22
lemma unit_when [simp]: "unit_when\<cdot>a\<cdot>u = a"
huffman@18289
    23
by (simp add: unit_when_def)
huffman@18289
    24
huffman@15593
    25
subsection {* Continuous versions of constants *}
huffman@15576
    26
wenzelm@25131
    27
definition
wenzelm@25131
    28
  cpair :: "'a \<rightarrow> 'b \<rightarrow> ('a * 'b)"  -- {* continuous pairing *}  where
wenzelm@25131
    29
  "cpair = (\<Lambda> x y. (x, y))"
wenzelm@25131
    30
wenzelm@25131
    31
definition
wenzelm@25131
    32
  cfst :: "('a * 'b) \<rightarrow> 'a" where
wenzelm@25131
    33
  "cfst = (\<Lambda> p. fst p)"
huffman@17834
    34
wenzelm@25131
    35
definition
wenzelm@25131
    36
  csnd :: "('a * 'b) \<rightarrow> 'b" where
wenzelm@25131
    37
  "csnd = (\<Lambda> p. snd p)"      
huffman@17834
    38
wenzelm@25131
    39
definition
wenzelm@25131
    40
  csplit :: "('a \<rightarrow> 'b \<rightarrow> 'c) \<rightarrow> ('a * 'b) \<rightarrow> 'c" where
wenzelm@25131
    41
  "csplit = (\<Lambda> f p. f\<cdot>(cfst\<cdot>p)\<cdot>(csnd\<cdot>p))"
huffman@15576
    42
huffman@15576
    43
syntax
huffman@17834
    44
  "_ctuple" :: "['a, args] \<Rightarrow> 'a * 'b"  ("(1<_,/ _>)")
huffman@17834
    45
huffman@17834
    46
syntax (xsymbols)
huffman@17834
    47
  "_ctuple" :: "['a, args] \<Rightarrow> 'a * 'b"  ("(1\<langle>_,/ _\<rangle>)")
huffman@15576
    48
huffman@15576
    49
translations
huffman@18078
    50
  "\<langle>x, y, z\<rangle>" == "\<langle>x, \<langle>y, z\<rangle>\<rangle>"
wenzelm@25131
    51
  "\<langle>x, y\<rangle>"    == "CONST cpair\<cdot>x\<cdot>y"
huffman@17834
    52
huffman@17816
    53
translations
wenzelm@25131
    54
  "\<Lambda>(CONST cpair\<cdot>x\<cdot>y). t" == "CONST csplit\<cdot>(\<Lambda> x y. t)"
huffman@17816
    55
huffman@15576
    56
huffman@15593
    57
subsection {* Convert all lemmas to the continuous versions *}
huffman@15576
    58
huffman@16081
    59
lemma cpair_eq_pair: "<x, y> = (x, y)"
huffman@16081
    60
by (simp add: cpair_def cont_pair1 cont_pair2)
huffman@16081
    61
huffman@25910
    62
lemma pair_eq_cpair: "(x, y) = <x, y>"
huffman@25910
    63
by (simp add: cpair_def cont_pair1 cont_pair2)
huffman@25910
    64
huffman@16081
    65
lemma inject_cpair: "<a,b> = <aa,ba> \<Longrightarrow> a = aa \<and> b = ba"
huffman@16081
    66
by (simp add: cpair_eq_pair)
huffman@15576
    67
huffman@16081
    68
lemma cpair_eq [iff]: "(<a, b> = <a', b'>) = (a = a' \<and> b = b')"
huffman@16081
    69
by (simp add: cpair_eq_pair)
huffman@15576
    70
huffman@31076
    71
lemma cpair_below [iff]: "(<a, b> \<sqsubseteq> <a', b'>) = (a \<sqsubseteq> a' \<and> b \<sqsubseteq> b')"
huffman@29535
    72
by (simp add: cpair_eq_pair)
huffman@16057
    73
huffman@18077
    74
lemma cpair_defined_iff [iff]: "(<x, y> = \<bottom>) = (x = \<bottom> \<and> y = \<bottom>)"
huffman@29535
    75
by (simp add: cpair_eq_pair)
huffman@16916
    76
huffman@25913
    77
lemma cpair_strict [simp]: "\<langle>\<bottom>, \<bottom>\<rangle> = \<bottom>"
huffman@18077
    78
by simp
huffman@16210
    79
huffman@16081
    80
lemma inst_cprod_pcpo2: "\<bottom> = <\<bottom>, \<bottom>>"
huffman@16916
    81
by (rule cpair_strict [symmetric])
huffman@15576
    82
huffman@15576
    83
lemma defined_cpair_rev: 
huffman@16081
    84
 "<a,b> = \<bottom> \<Longrightarrow> a = \<bottom> \<and> b = \<bottom>"
huffman@18077
    85
by simp
huffman@16081
    86
huffman@16081
    87
lemma Exh_Cprod2: "\<exists>a b. z = <a, b>"
huffman@16081
    88
by (simp add: cpair_eq_pair)
huffman@16081
    89
huffman@16081
    90
lemma cprodE: "\<lbrakk>\<And>x y. p = <x, y> \<Longrightarrow> Q\<rbrakk> \<Longrightarrow> Q"
huffman@16081
    91
by (cut_tac Exh_Cprod2, auto)
huffman@16081
    92
huffman@16210
    93
lemma cfst_cpair [simp]: "cfst\<cdot><x, y> = x"
huffman@16081
    94
by (simp add: cpair_eq_pair cfst_def cont_fst)
huffman@15576
    95
huffman@16210
    96
lemma csnd_cpair [simp]: "csnd\<cdot><x, y> = y"
huffman@16081
    97
by (simp add: cpair_eq_pair csnd_def cont_snd)
huffman@16081
    98
huffman@16081
    99
lemma cfst_strict [simp]: "cfst\<cdot>\<bottom> = \<bottom>"
huffman@29535
   100
by (simp add: cfst_def)
huffman@16081
   101
huffman@16081
   102
lemma csnd_strict [simp]: "csnd\<cdot>\<bottom> = \<bottom>"
huffman@29535
   103
by (simp add: csnd_def)
huffman@16081
   104
huffman@25910
   105
lemma cpair_cfst_csnd: "\<langle>cfst\<cdot>p, csnd\<cdot>p\<rangle> = p"
huffman@25910
   106
by (cases p rule: cprodE, simp)
huffman@25910
   107
huffman@25910
   108
lemmas surjective_pairing_Cprod2 = cpair_cfst_csnd
huffman@15576
   109
huffman@31076
   110
lemma below_cprod: "x \<sqsubseteq> y = (cfst\<cdot>x \<sqsubseteq> cfst\<cdot>y \<and> csnd\<cdot>x \<sqsubseteq> csnd\<cdot>y)"
huffman@31076
   111
by (simp add: below_prod_def cfst_def csnd_def cont_fst cont_snd)
huffman@16315
   112
huffman@16750
   113
lemma eq_cprod: "(x = y) = (cfst\<cdot>x = cfst\<cdot>y \<and> csnd\<cdot>x = csnd\<cdot>y)"
huffman@31076
   114
by (auto simp add: po_eq_conv below_cprod)
huffman@16750
   115
huffman@31076
   116
lemma cfst_below_iff: "cfst\<cdot>x \<sqsubseteq> y = x \<sqsubseteq> <y, csnd\<cdot>x>"
huffman@31076
   117
by (simp add: below_cprod)
huffman@25879
   118
huffman@31076
   119
lemma csnd_below_iff: "csnd\<cdot>x \<sqsubseteq> y = x \<sqsubseteq> <cfst\<cdot>x, y>"
huffman@31076
   120
by (simp add: below_cprod)
huffman@25879
   121
huffman@25879
   122
lemma compact_cfst: "compact x \<Longrightarrow> compact (cfst\<cdot>x)"
huffman@31076
   123
by (rule compactI, simp add: cfst_below_iff)
huffman@25879
   124
huffman@25879
   125
lemma compact_csnd: "compact x \<Longrightarrow> compact (csnd\<cdot>x)"
huffman@31076
   126
by (rule compactI, simp add: csnd_below_iff)
huffman@25879
   127
huffman@25879
   128
lemma compact_cpair: "\<lbrakk>compact x; compact y\<rbrakk> \<Longrightarrow> compact <x, y>"
huffman@29535
   129
by (simp add: cpair_eq_pair)
huffman@17837
   130
huffman@25879
   131
lemma compact_cpair_iff [simp]: "compact <x, y> = (compact x \<and> compact y)"
huffman@29535
   132
by (simp add: cpair_eq_pair)
huffman@25905
   133
huffman@15576
   134
lemma lub_cprod2: 
huffman@16081
   135
  "chain S \<Longrightarrow> range S <<| <\<Squnion>i. cfst\<cdot>(S i), \<Squnion>i. csnd\<cdot>(S i)>"
huffman@16081
   136
apply (simp add: cpair_eq_pair cfst_def csnd_def cont_fst cont_snd)
huffman@15593
   137
apply (erule lub_cprod)
huffman@15576
   138
done
huffman@15576
   139
huffman@16081
   140
lemma thelub_cprod2:
huffman@27413
   141
  "chain S \<Longrightarrow> (\<Squnion>i. S i) = <\<Squnion>i. cfst\<cdot>(S i), \<Squnion>i. csnd\<cdot>(S i)>"
huffman@16081
   142
by (rule lub_cprod2 [THEN thelubI])
huffman@15576
   143
huffman@18077
   144
lemma csplit1 [simp]: "csplit\<cdot>f\<cdot>\<bottom> = f\<cdot>\<bottom>\<cdot>\<bottom>"
huffman@18077
   145
by (simp add: csplit_def)
huffman@18077
   146
huffman@16081
   147
lemma csplit2 [simp]: "csplit\<cdot>f\<cdot><x,y> = f\<cdot>x\<cdot>y"
huffman@15593
   148
by (simp add: csplit_def)
huffman@15576
   149
huffman@16553
   150
lemma csplit3 [simp]: "csplit\<cdot>cpair\<cdot>z = z"
huffman@25910
   151
by (simp add: csplit_def cpair_cfst_csnd)
huffman@15576
   152
huffman@16210
   153
lemmas Cprod_rews = cfst_cpair csnd_cpair csplit2
huffman@15576
   154
huffman@25910
   155
subsection {* Product type is a bifinite domain *}
huffman@25910
   156
huffman@26962
   157
instantiation "*" :: (profinite, profinite) profinite
huffman@26962
   158
begin
huffman@25910
   159
huffman@26962
   160
definition
huffman@25910
   161
  approx_cprod_def:
huffman@26962
   162
    "approx = (\<lambda>n. \<Lambda>\<langle>x, y\<rangle>. \<langle>approx n\<cdot>x, approx n\<cdot>y\<rangle>)"
huffman@25910
   163
huffman@26962
   164
instance proof
huffman@25910
   165
  fix i :: nat and x :: "'a \<times> 'b"
huffman@27310
   166
  show "chain (approx :: nat \<Rightarrow> 'a \<times> 'b \<rightarrow> 'a \<times> 'b)"
huffman@25910
   167
    unfolding approx_cprod_def by simp
huffman@25910
   168
  show "(\<Squnion>i. approx i\<cdot>x) = x"
huffman@25910
   169
    unfolding approx_cprod_def
huffman@25910
   170
    by (simp add: lub_distribs eta_cfun)
huffman@25910
   171
  show "approx i\<cdot>(approx i\<cdot>x) = approx i\<cdot>x"
huffman@25910
   172
    unfolding approx_cprod_def csplit_def by simp
huffman@25910
   173
  have "{x::'a \<times> 'b. approx i\<cdot>x = x} \<subseteq>
huffman@25910
   174
        {x::'a. approx i\<cdot>x = x} \<times> {x::'b. approx i\<cdot>x = x}"
huffman@25910
   175
    unfolding approx_cprod_def
huffman@25910
   176
    by (clarsimp simp add: pair_eq_cpair)
huffman@25910
   177
  thus "finite {x::'a \<times> 'b. approx i\<cdot>x = x}"
huffman@25910
   178
    by (rule finite_subset,
huffman@25910
   179
        intro finite_cartesian_product finite_fixes_approx)
huffman@25910
   180
qed
huffman@25910
   181
huffman@26962
   182
end
huffman@26962
   183
huffman@25910
   184
instance "*" :: (bifinite, bifinite) bifinite ..
huffman@25910
   185
huffman@25910
   186
lemma approx_cpair [simp]:
huffman@25910
   187
  "approx i\<cdot>\<langle>x, y\<rangle> = \<langle>approx i\<cdot>x, approx i\<cdot>y\<rangle>"
huffman@25910
   188
unfolding approx_cprod_def by simp
huffman@25910
   189
huffman@25910
   190
lemma cfst_approx: "cfst\<cdot>(approx i\<cdot>p) = approx i\<cdot>(cfst\<cdot>p)"
huffman@25910
   191
by (cases p rule: cprodE, simp)
huffman@25910
   192
huffman@25910
   193
lemma csnd_approx: "csnd\<cdot>(approx i\<cdot>p) = approx i\<cdot>(csnd\<cdot>p)"
huffman@25910
   194
by (cases p rule: cprodE, simp)
huffman@25910
   195
huffman@15576
   196
end