src/HOLCF/Cprod.thy
author huffman
Mon Mar 22 22:55:26 2010 -0700 (2010-03-22)
changeset 35922 bfa52a972745
parent 35900 aa5dfb03eb1e
child 35926 e6aec5d665f0
permissions -rw-r--r--
define csplit using fst, snd
     1 (*  Title:      HOLCF/Cprod.thy
     2     Author:     Franz Regensburger
     3 *)
     4 
     5 header {* The cpo of cartesian products *}
     6 
     7 theory Cprod
     8 imports Bifinite
     9 begin
    10 
    11 defaultsort cpo
    12 
    13 subsection {* Continuous case function for unit type *}
    14 
    15 definition
    16   unit_when :: "'a \<rightarrow> unit \<rightarrow> 'a" where
    17   "unit_when = (\<Lambda> a _. a)"
    18 
    19 translations
    20   "\<Lambda>(). t" == "CONST unit_when\<cdot>t"
    21 
    22 lemma unit_when [simp]: "unit_when\<cdot>a\<cdot>u = a"
    23 by (simp add: unit_when_def)
    24 
    25 subsection {* Continuous versions of constants *}
    26 
    27 definition
    28   cpair :: "'a \<rightarrow> 'b \<rightarrow> ('a * 'b)"  -- {* continuous pairing *}  where
    29   "cpair = (\<Lambda> x y. (x, y))"
    30 
    31 definition
    32   cfst :: "('a * 'b) \<rightarrow> 'a" where
    33   "cfst = (\<Lambda> p. fst p)"
    34 
    35 definition
    36   csnd :: "('a * 'b) \<rightarrow> 'b" where
    37   "csnd = (\<Lambda> p. snd p)"
    38 
    39 definition
    40   csplit :: "('a \<rightarrow> 'b \<rightarrow> 'c) \<rightarrow> ('a * 'b) \<rightarrow> 'c" where
    41   "csplit = (\<Lambda> f p. f\<cdot>(fst p)\<cdot>(snd p))"
    42 
    43 syntax
    44   "_ctuple" :: "['a, args] \<Rightarrow> 'a * 'b"  ("(1<_,/ _>)")
    45 
    46 syntax (xsymbols)
    47   "_ctuple" :: "['a, args] \<Rightarrow> 'a * 'b"  ("(1\<langle>_,/ _\<rangle>)")
    48 
    49 translations
    50   "\<langle>x, y, z\<rangle>" == "\<langle>x, \<langle>y, z\<rangle>\<rangle>"
    51   "\<langle>x, y\<rangle>"    == "CONST cpair\<cdot>x\<cdot>y"
    52 
    53 translations
    54   "\<Lambda>(CONST cpair\<cdot>x\<cdot>y). t" == "CONST csplit\<cdot>(\<Lambda> x y. t)"
    55   "\<Lambda>(CONST Pair x y). t" => "CONST csplit\<cdot>(\<Lambda> x y. t)"
    56 
    57 
    58 subsection {* Convert all lemmas to the continuous versions *}
    59 
    60 lemma cpair_eq_pair: "<x, y> = (x, y)"
    61 by (simp add: cpair_def cont_pair1 cont_pair2)
    62 
    63 lemma pair_eq_cpair: "(x, y) = <x, y>"
    64 by (simp add: cpair_def cont_pair1 cont_pair2)
    65 
    66 lemma inject_cpair: "<a,b> = <aa,ba> \<Longrightarrow> a = aa \<and> b = ba"
    67 by (simp add: cpair_eq_pair)
    68 
    69 lemma cpair_eq [iff]: "(<a, b> = <a', b'>) = (a = a' \<and> b = b')"
    70 by (simp add: cpair_eq_pair)
    71 
    72 lemma cpair_below [iff]: "(<a, b> \<sqsubseteq> <a', b'>) = (a \<sqsubseteq> a' \<and> b \<sqsubseteq> b')"
    73 by (simp add: cpair_eq_pair)
    74 
    75 lemma cpair_defined_iff [iff]: "(<x, y> = \<bottom>) = (x = \<bottom> \<and> y = \<bottom>)"
    76 by (simp add: cpair_eq_pair)
    77 
    78 lemma cpair_strict [simp]: "\<langle>\<bottom>, \<bottom>\<rangle> = \<bottom>"
    79 by simp
    80 
    81 lemma inst_cprod_pcpo2: "\<bottom> = <\<bottom>, \<bottom>>"
    82 by (rule cpair_strict [symmetric])
    83 
    84 lemma defined_cpair_rev: 
    85  "<a,b> = \<bottom> \<Longrightarrow> a = \<bottom> \<and> b = \<bottom>"
    86 by simp
    87 
    88 lemma Exh_Cprod2: "\<exists>a b. z = <a, b>"
    89 by (simp add: cpair_eq_pair)
    90 
    91 lemma cprodE: "\<lbrakk>\<And>x y. p = <x, y> \<Longrightarrow> Q\<rbrakk> \<Longrightarrow> Q"
    92 by (cut_tac Exh_Cprod2, auto)
    93 
    94 lemma cfst_cpair [simp]: "cfst\<cdot><x, y> = x"
    95 by (simp add: cpair_eq_pair cfst_def)
    96 
    97 lemma csnd_cpair [simp]: "csnd\<cdot><x, y> = y"
    98 by (simp add: cpair_eq_pair csnd_def)
    99 
   100 lemma cfst_strict [simp]: "cfst\<cdot>\<bottom> = \<bottom>"
   101 by (simp add: cfst_def)
   102 
   103 lemma csnd_strict [simp]: "csnd\<cdot>\<bottom> = \<bottom>"
   104 by (simp add: csnd_def)
   105 
   106 lemma cpair_cfst_csnd: "\<langle>cfst\<cdot>p, csnd\<cdot>p\<rangle> = p"
   107 by (cases p rule: cprodE, simp)
   108 
   109 lemmas surjective_pairing_Cprod2 = cpair_cfst_csnd
   110 
   111 lemma below_cprod: "x \<sqsubseteq> y = (cfst\<cdot>x \<sqsubseteq> cfst\<cdot>y \<and> csnd\<cdot>x \<sqsubseteq> csnd\<cdot>y)"
   112 by (simp add: below_prod_def cfst_def csnd_def)
   113 
   114 lemma eq_cprod: "(x = y) = (cfst\<cdot>x = cfst\<cdot>y \<and> csnd\<cdot>x = csnd\<cdot>y)"
   115 by (auto simp add: po_eq_conv below_cprod)
   116 
   117 lemma cfst_below_iff: "cfst\<cdot>x \<sqsubseteq> y = x \<sqsubseteq> <y, csnd\<cdot>x>"
   118 by (simp add: below_cprod)
   119 
   120 lemma csnd_below_iff: "csnd\<cdot>x \<sqsubseteq> y = x \<sqsubseteq> <cfst\<cdot>x, y>"
   121 by (simp add: below_cprod)
   122 
   123 lemma compact_cfst: "compact x \<Longrightarrow> compact (cfst\<cdot>x)"
   124 by (rule compactI, simp add: cfst_below_iff)
   125 
   126 lemma compact_csnd: "compact x \<Longrightarrow> compact (csnd\<cdot>x)"
   127 by (rule compactI, simp add: csnd_below_iff)
   128 
   129 lemma compact_cpair: "\<lbrakk>compact x; compact y\<rbrakk> \<Longrightarrow> compact <x, y>"
   130 by (simp add: cpair_eq_pair)
   131 
   132 lemma compact_cpair_iff [simp]: "compact <x, y> = (compact x \<and> compact y)"
   133 by (simp add: cpair_eq_pair)
   134 
   135 lemma lub_cprod2: 
   136   "chain S \<Longrightarrow> range S <<| <\<Squnion>i. cfst\<cdot>(S i), \<Squnion>i. csnd\<cdot>(S i)>"
   137 apply (simp add: cpair_eq_pair cfst_def csnd_def)
   138 apply (erule lub_cprod)
   139 done
   140 
   141 lemma thelub_cprod2:
   142   "chain S \<Longrightarrow> (\<Squnion>i. S i) = <\<Squnion>i. cfst\<cdot>(S i), \<Squnion>i. csnd\<cdot>(S i)>"
   143 by (rule lub_cprod2 [THEN thelubI])
   144 
   145 lemma csplit1 [simp]: "csplit\<cdot>f\<cdot>\<bottom> = f\<cdot>\<bottom>\<cdot>\<bottom>"
   146 by (simp add: csplit_def)
   147 
   148 lemma csplit2 [simp]: "csplit\<cdot>f\<cdot><x,y> = f\<cdot>x\<cdot>y"
   149 by (simp add: csplit_def cpair_def)
   150 
   151 lemma csplit3 [simp]: "csplit\<cdot>cpair\<cdot>z = z"
   152 by (simp add: csplit_def cpair_def)
   153 
   154 lemma csplit_Pair [simp]: "csplit\<cdot>f\<cdot>(x, y) = f\<cdot>x\<cdot>y"
   155 by (simp add: csplit_def)
   156 
   157 lemmas Cprod_rews = cfst_cpair csnd_cpair csplit2
   158 
   159 subsection {* Product type is a bifinite domain *}
   160 
   161 lemma approx_cpair [simp]:
   162   "approx i\<cdot>\<langle>x, y\<rangle> = \<langle>approx i\<cdot>x, approx i\<cdot>y\<rangle>"
   163 by (simp add: cpair_eq_pair)
   164 
   165 lemma cfst_approx: "cfst\<cdot>(approx i\<cdot>p) = approx i\<cdot>(cfst\<cdot>p)"
   166 by (cases p rule: cprodE, simp)
   167 
   168 lemma csnd_approx: "csnd\<cdot>(approx i\<cdot>p) = approx i\<cdot>(csnd\<cdot>p)"
   169 by (cases p rule: cprodE, simp)
   170 
   171 end