src/HOLCF/Cprod.thy
author huffman
Thu Jan 10 05:15:43 2008 +0100 (2008-01-10)
changeset 25879 98b93782c3b1
parent 25827 c2adeb1bae5c
child 25905 098469c6c351
permissions -rw-r--r--
new compactness lemmas
huffman@15600
     1
(*  Title:      HOLCF/Cprod.thy
huffman@15576
     2
    ID:         $Id$
huffman@15576
     3
    Author:     Franz Regensburger
huffman@15576
     4
wenzelm@16070
     5
Partial ordering for cartesian product of HOL products.
huffman@15576
     6
*)
huffman@15576
     7
huffman@15576
     8
header {* The cpo of cartesian products *}
huffman@15576
     9
huffman@15577
    10
theory Cprod
huffman@15577
    11
imports Cfun
huffman@15577
    12
begin
huffman@15576
    13
huffman@15576
    14
defaultsort cpo
huffman@15576
    15
huffman@16008
    16
subsection {* Type @{typ unit} is a pcpo *}
huffman@16008
    17
huffman@25784
    18
instantiation unit :: sq_ord
huffman@25784
    19
begin
huffman@16008
    20
huffman@25784
    21
definition
huffman@16008
    22
  less_unit_def [simp]: "x \<sqsubseteq> (y::unit) \<equiv> True"
huffman@16008
    23
huffman@25784
    24
instance ..
huffman@25784
    25
end
huffman@25784
    26
huffman@16008
    27
instance unit :: po
huffman@16008
    28
by intro_classes simp_all
huffman@16008
    29
huffman@25815
    30
instance unit :: finite_po ..
huffman@16008
    31
huffman@16008
    32
instance unit :: pcpo
huffman@16008
    33
by intro_classes simp
huffman@16008
    34
wenzelm@25131
    35
definition
wenzelm@25131
    36
  unit_when :: "'a \<rightarrow> unit \<rightarrow> 'a" where
wenzelm@25131
    37
  "unit_when = (\<Lambda> a _. a)"
huffman@16008
    38
huffman@18289
    39
translations
wenzelm@25131
    40
  "\<Lambda>(). t" == "CONST unit_when\<cdot>t"
huffman@18289
    41
huffman@18289
    42
lemma unit_when [simp]: "unit_when\<cdot>a\<cdot>u = a"
huffman@18289
    43
by (simp add: unit_when_def)
huffman@18289
    44
huffman@18289
    45
huffman@18289
    46
subsection {* Product type is a partial order *}
huffman@15593
    47
huffman@25784
    48
instantiation "*" :: (sq_ord, sq_ord) sq_ord
huffman@25784
    49
begin
huffman@15576
    50
huffman@25784
    51
definition
huffman@16081
    52
  less_cprod_def: "(op \<sqsubseteq>) \<equiv> \<lambda>p1 p2. (fst p1 \<sqsubseteq> fst p2 \<and> snd p1 \<sqsubseteq> snd p2)"
huffman@15576
    53
huffman@25784
    54
instance ..
huffman@25784
    55
end
huffman@15576
    56
huffman@25784
    57
instance "*" :: (po, po) po
huffman@25784
    58
proof
huffman@25784
    59
  fix x :: "'a \<times> 'b"
huffman@25784
    60
  show "x \<sqsubseteq> x"
huffman@25784
    61
    unfolding less_cprod_def by simp
huffman@25784
    62
next
huffman@25784
    63
  fix x y :: "'a \<times> 'b"
huffman@25784
    64
  assume "x \<sqsubseteq> y" "y \<sqsubseteq> x" thus "x = y"
huffman@25784
    65
    unfolding less_cprod_def Pair_fst_snd_eq
huffman@25784
    66
    by (fast intro: antisym_less)
huffman@25784
    67
next
huffman@25784
    68
  fix x y z :: "'a \<times> 'b"
huffman@25784
    69
  assume "x \<sqsubseteq> y" "y \<sqsubseteq> z" thus "x \<sqsubseteq> z"
huffman@25784
    70
    unfolding less_cprod_def
huffman@25784
    71
    by (fast intro: trans_less)
huffman@25784
    72
qed
huffman@15576
    73
huffman@15576
    74
huffman@15593
    75
subsection {* Monotonicity of @{text "(_,_)"}, @{term fst}, @{term snd} *}
huffman@15576
    76
huffman@15593
    77
text {* Pair @{text "(_,_)"}  is monotone in both arguments *}
huffman@15576
    78
huffman@16081
    79
lemma monofun_pair1: "monofun (\<lambda>x. (x, y))"
huffman@16210
    80
by (simp add: monofun_def less_cprod_def)
huffman@15576
    81
huffman@16081
    82
lemma monofun_pair2: "monofun (\<lambda>y. (x, y))"
huffman@16210
    83
by (simp add: monofun_def less_cprod_def)
huffman@15576
    84
huffman@16081
    85
lemma monofun_pair:
huffman@16081
    86
  "\<lbrakk>x1 \<sqsubseteq> x2; y1 \<sqsubseteq> y2\<rbrakk> \<Longrightarrow> (x1, y1) \<sqsubseteq> (x2, y2)"
huffman@16081
    87
by (simp add: less_cprod_def)
huffman@15576
    88
huffman@15593
    89
text {* @{term fst} and @{term snd} are monotone *}
huffman@15576
    90
huffman@15576
    91
lemma monofun_fst: "monofun fst"
huffman@16210
    92
by (simp add: monofun_def less_cprod_def)
huffman@15576
    93
huffman@15576
    94
lemma monofun_snd: "monofun snd"
huffman@16210
    95
by (simp add: monofun_def less_cprod_def)
huffman@15576
    96
huffman@18289
    97
subsection {* Product type is a cpo *}
huffman@15576
    98
huffman@25784
    99
lemma lub_cprod:
huffman@25784
   100
  fixes S :: "nat \<Rightarrow> ('a::cpo \<times> 'b::cpo)"
huffman@25784
   101
  assumes S: "chain S"
huffman@25784
   102
  shows "range S <<| (\<Squnion>i. fst (S i), \<Squnion>i. snd (S i))"
huffman@15576
   103
apply (rule is_lubI)
huffman@15576
   104
apply (rule ub_rangeI)
huffman@15576
   105
apply (rule_tac t = "S i" in surjective_pairing [THEN ssubst])
huffman@15576
   106
apply (rule monofun_pair)
huffman@15576
   107
apply (rule is_ub_thelub)
huffman@25784
   108
apply (rule ch2ch_monofun [OF monofun_fst S])
huffman@15576
   109
apply (rule is_ub_thelub)
huffman@25784
   110
apply (rule ch2ch_monofun [OF monofun_snd S])
huffman@15576
   111
apply (rule_tac t = "u" in surjective_pairing [THEN ssubst])
huffman@15576
   112
apply (rule monofun_pair)
huffman@15576
   113
apply (rule is_lub_thelub)
huffman@25784
   114
apply (rule ch2ch_monofun [OF monofun_fst S])
huffman@15576
   115
apply (erule monofun_fst [THEN ub2ub_monofun])
huffman@15576
   116
apply (rule is_lub_thelub)
huffman@25784
   117
apply (rule ch2ch_monofun [OF monofun_snd S])
huffman@15576
   118
apply (erule monofun_snd [THEN ub2ub_monofun])
huffman@15576
   119
done
huffman@15576
   120
huffman@25784
   121
lemma directed_lub_cprod:
huffman@25784
   122
  fixes S :: "('a::dcpo \<times> 'b::dcpo) set"
huffman@25784
   123
  assumes S: "directed S"
huffman@25784
   124
  shows "S <<| (\<Squnion>x\<in>S. fst x, \<Squnion>x\<in>S. snd x)"
huffman@25784
   125
apply (rule is_lubI)
huffman@25784
   126
apply (rule is_ubI)
huffman@25784
   127
apply (rule_tac t=x in surjective_pairing [THEN ssubst])
huffman@25784
   128
apply (rule monofun_pair)
huffman@25784
   129
apply (erule is_ub_thelub' [OF dir2dir_monofun [OF monofun_fst S] imageI])
huffman@25784
   130
apply (erule is_ub_thelub' [OF dir2dir_monofun [OF monofun_snd S] imageI])
huffman@25784
   131
apply (rule_tac t=u in surjective_pairing [THEN ssubst])
huffman@25784
   132
apply (rule monofun_pair)
huffman@25784
   133
apply (rule is_lub_thelub')
huffman@25784
   134
apply (rule dir2dir_monofun [OF monofun_fst S])
huffman@25784
   135
apply (erule ub2ub_monofun' [OF monofun_fst])
huffman@25784
   136
apply (rule is_lub_thelub')
huffman@25784
   137
apply (rule dir2dir_monofun [OF monofun_snd S])
huffman@25784
   138
apply (erule ub2ub_monofun' [OF monofun_snd])
huffman@25784
   139
done
huffman@25784
   140
huffman@16081
   141
lemma thelub_cprod:
huffman@25784
   142
  "chain (S::nat \<Rightarrow> 'a::cpo \<times> 'b::cpo)
huffman@25784
   143
    \<Longrightarrow> lub (range S) = (\<Squnion>i. fst (S i), \<Squnion>i. snd (S i))"
huffman@16081
   144
by (rule lub_cprod [THEN thelubI])
huffman@15576
   145
huffman@25784
   146
instance "*" :: (cpo, cpo) cpo
huffman@25784
   147
proof
huffman@25784
   148
  fix S :: "nat \<Rightarrow> ('a \<times> 'b)"
huffman@25784
   149
  assume "chain S"
huffman@25784
   150
  hence "range S <<| (\<Squnion>i. fst (S i), \<Squnion>i. snd (S i))"
huffman@25784
   151
    by (rule lub_cprod)
huffman@25784
   152
  thus "\<exists>x. range S <<| x" ..
huffman@25784
   153
qed
huffman@15593
   154
huffman@25784
   155
instance "*" :: (dcpo, dcpo) dcpo
huffman@25784
   156
proof
huffman@25784
   157
  fix S :: "('a \<times> 'b) set"
huffman@25784
   158
  assume "directed S"
huffman@25784
   159
  hence "S <<| (\<Squnion>x\<in>S. fst x, \<Squnion>x\<in>S. snd x)"
huffman@25784
   160
    by (rule directed_lub_cprod)
huffman@25784
   161
  thus "\<exists>x. S <<| x" ..
huffman@25784
   162
qed
huffman@15593
   163
huffman@25827
   164
instance "*" :: (finite_po, finite_po) finite_po ..
huffman@25827
   165
huffman@25827
   166
instance "*" :: (chfin, chfin) chfin
huffman@25827
   167
proof (intro_classes, clarify)
huffman@25827
   168
  fix Y :: "nat \<Rightarrow> 'a \<times> 'b"
huffman@25827
   169
  assume Y: "chain Y"
huffman@25827
   170
  from Y have "chain (\<lambda>i. fst (Y i))"
huffman@25827
   171
    by (rule ch2ch_monofun [OF monofun_fst])
huffman@25827
   172
  hence "\<exists>m. max_in_chain m (\<lambda>i. fst (Y i))"
huffman@25827
   173
    by (rule chfin [rule_format])
huffman@25827
   174
  then obtain m where m: "max_in_chain m (\<lambda>i. fst (Y i))" ..
huffman@25827
   175
  from Y have "chain (\<lambda>i. snd (Y i))"
huffman@25827
   176
    by (rule ch2ch_monofun [OF monofun_snd])
huffman@25827
   177
  hence "\<exists>n. max_in_chain n (\<lambda>i. snd (Y i))"
huffman@25827
   178
    by (rule chfin [rule_format])
huffman@25827
   179
  then obtain n where n: "max_in_chain n (\<lambda>i. snd (Y i))" ..
huffman@25827
   180
  from m have m': "max_in_chain (max m n) (\<lambda>i. fst (Y i))"
huffman@25827
   181
    by (rule maxinch_mono [OF _ le_maxI1])
huffman@25827
   182
  from n have n': "max_in_chain (max m n) (\<lambda>i. snd (Y i))"
huffman@25827
   183
    by (rule maxinch_mono [OF _ le_maxI2])
huffman@25827
   184
  from m' n' have "max_in_chain (max m n) Y"
huffman@25827
   185
    unfolding max_in_chain_def Pair_fst_snd_eq by fast
huffman@25827
   186
  thus "\<exists>n. max_in_chain n Y" ..
huffman@25827
   187
qed
huffman@25827
   188
huffman@18289
   189
subsection {* Product type is pointed *}
huffman@15593
   190
huffman@16081
   191
lemma minimal_cprod: "(\<bottom>, \<bottom>) \<sqsubseteq> p"
huffman@16081
   192
by (simp add: less_cprod_def)
huffman@15593
   193
huffman@16081
   194
lemma least_cprod: "EX x::'a::pcpo * 'b::pcpo. ALL y. x \<sqsubseteq> y"
huffman@16081
   195
apply (rule_tac x = "(\<bottom>, \<bottom>)" in exI)
huffman@15593
   196
apply (rule minimal_cprod [THEN allI])
huffman@15593
   197
done
huffman@15593
   198
huffman@15609
   199
instance "*" :: (pcpo, pcpo) pcpo
huffman@15593
   200
by intro_classes (rule least_cprod)
huffman@15593
   201
huffman@15593
   202
text {* for compatibility with old HOLCF-Version *}
huffman@15593
   203
lemma inst_cprod_pcpo: "UU = (UU,UU)"
huffman@16081
   204
by (rule minimal_cprod [THEN UU_I, symmetric])
huffman@16081
   205
huffman@15593
   206
huffman@15593
   207
subsection {* Continuity of @{text "(_,_)"}, @{term fst}, @{term snd} *}
huffman@15593
   208
huffman@16916
   209
lemma contlub_pair1: "contlub (\<lambda>x. (x, y))"
huffman@16210
   210
apply (rule contlubI)
huffman@15593
   211
apply (subst thelub_cprod)
huffman@15593
   212
apply (erule monofun_pair1 [THEN ch2ch_monofun])
huffman@18077
   213
apply simp
huffman@15576
   214
done
huffman@15576
   215
huffman@16081
   216
lemma contlub_pair2: "contlub (\<lambda>y. (x, y))"
huffman@16210
   217
apply (rule contlubI)
huffman@15593
   218
apply (subst thelub_cprod)
huffman@15593
   219
apply (erule monofun_pair2 [THEN ch2ch_monofun])
huffman@18077
   220
apply simp
huffman@15593
   221
done
huffman@15593
   222
huffman@16081
   223
lemma cont_pair1: "cont (\<lambda>x. (x, y))"
huffman@15593
   224
apply (rule monocontlub2cont)
huffman@15593
   225
apply (rule monofun_pair1)
huffman@15593
   226
apply (rule contlub_pair1)
huffman@15593
   227
done
huffman@15593
   228
huffman@16081
   229
lemma cont_pair2: "cont (\<lambda>y. (x, y))"
huffman@15593
   230
apply (rule monocontlub2cont)
huffman@15593
   231
apply (rule monofun_pair2)
huffman@15593
   232
apply (rule contlub_pair2)
huffman@15593
   233
done
huffman@15576
   234
huffman@16081
   235
lemma contlub_fst: "contlub fst"
huffman@16210
   236
apply (rule contlubI)
huffman@16210
   237
apply (simp add: thelub_cprod)
huffman@15593
   238
done
huffman@15593
   239
huffman@16081
   240
lemma contlub_snd: "contlub snd"
huffman@16210
   241
apply (rule contlubI)
huffman@16210
   242
apply (simp add: thelub_cprod)
huffman@15593
   243
done
huffman@15576
   244
huffman@16081
   245
lemma cont_fst: "cont fst"
huffman@15593
   246
apply (rule monocontlub2cont)
huffman@15593
   247
apply (rule monofun_fst)
huffman@15593
   248
apply (rule contlub_fst)
huffman@15593
   249
done
huffman@15593
   250
huffman@16081
   251
lemma cont_snd: "cont snd"
huffman@15593
   252
apply (rule monocontlub2cont)
huffman@15593
   253
apply (rule monofun_snd)
huffman@15593
   254
apply (rule contlub_snd)
huffman@15593
   255
done
huffman@15593
   256
huffman@15593
   257
subsection {* Continuous versions of constants *}
huffman@15576
   258
wenzelm@25131
   259
definition
wenzelm@25131
   260
  cpair :: "'a \<rightarrow> 'b \<rightarrow> ('a * 'b)"  -- {* continuous pairing *}  where
wenzelm@25131
   261
  "cpair = (\<Lambda> x y. (x, y))"
wenzelm@25131
   262
wenzelm@25131
   263
definition
wenzelm@25131
   264
  cfst :: "('a * 'b) \<rightarrow> 'a" where
wenzelm@25131
   265
  "cfst = (\<Lambda> p. fst p)"
huffman@17834
   266
wenzelm@25131
   267
definition
wenzelm@25131
   268
  csnd :: "('a * 'b) \<rightarrow> 'b" where
wenzelm@25131
   269
  "csnd = (\<Lambda> p. snd p)"      
huffman@17834
   270
wenzelm@25131
   271
definition
wenzelm@25131
   272
  csplit :: "('a \<rightarrow> 'b \<rightarrow> 'c) \<rightarrow> ('a * 'b) \<rightarrow> 'c" where
wenzelm@25131
   273
  "csplit = (\<Lambda> f p. f\<cdot>(cfst\<cdot>p)\<cdot>(csnd\<cdot>p))"
huffman@15576
   274
huffman@15576
   275
syntax
huffman@17834
   276
  "_ctuple" :: "['a, args] \<Rightarrow> 'a * 'b"  ("(1<_,/ _>)")
huffman@17834
   277
huffman@17834
   278
syntax (xsymbols)
huffman@17834
   279
  "_ctuple" :: "['a, args] \<Rightarrow> 'a * 'b"  ("(1\<langle>_,/ _\<rangle>)")
huffman@15576
   280
huffman@15576
   281
translations
huffman@18078
   282
  "\<langle>x, y, z\<rangle>" == "\<langle>x, \<langle>y, z\<rangle>\<rangle>"
wenzelm@25131
   283
  "\<langle>x, y\<rangle>"    == "CONST cpair\<cdot>x\<cdot>y"
huffman@17834
   284
huffman@17816
   285
translations
wenzelm@25131
   286
  "\<Lambda>(CONST cpair\<cdot>x\<cdot>y). t" == "CONST csplit\<cdot>(\<Lambda> x y. t)"
huffman@17816
   287
huffman@15576
   288
huffman@15593
   289
subsection {* Convert all lemmas to the continuous versions *}
huffman@15576
   290
huffman@16081
   291
lemma cpair_eq_pair: "<x, y> = (x, y)"
huffman@16081
   292
by (simp add: cpair_def cont_pair1 cont_pair2)
huffman@16081
   293
huffman@16081
   294
lemma inject_cpair: "<a,b> = <aa,ba> \<Longrightarrow> a = aa \<and> b = ba"
huffman@16081
   295
by (simp add: cpair_eq_pair)
huffman@15576
   296
huffman@16081
   297
lemma cpair_eq [iff]: "(<a, b> = <a', b'>) = (a = a' \<and> b = b')"
huffman@16081
   298
by (simp add: cpair_eq_pair)
huffman@15576
   299
huffman@18077
   300
lemma cpair_less [iff]: "(<a, b> \<sqsubseteq> <a', b'>) = (a \<sqsubseteq> a' \<and> b \<sqsubseteq> b')"
huffman@16081
   301
by (simp add: cpair_eq_pair less_cprod_def)
huffman@16057
   302
huffman@18077
   303
lemma cpair_defined_iff [iff]: "(<x, y> = \<bottom>) = (x = \<bottom> \<and> y = \<bottom>)"
huffman@16916
   304
by (simp add: inst_cprod_pcpo cpair_eq_pair)
huffman@16916
   305
huffman@16210
   306
lemma cpair_strict: "<\<bottom>, \<bottom>> = \<bottom>"
huffman@18077
   307
by simp
huffman@16210
   308
huffman@16081
   309
lemma inst_cprod_pcpo2: "\<bottom> = <\<bottom>, \<bottom>>"
huffman@16916
   310
by (rule cpair_strict [symmetric])
huffman@15576
   311
huffman@15576
   312
lemma defined_cpair_rev: 
huffman@16081
   313
 "<a,b> = \<bottom> \<Longrightarrow> a = \<bottom> \<and> b = \<bottom>"
huffman@18077
   314
by simp
huffman@16081
   315
huffman@16081
   316
lemma Exh_Cprod2: "\<exists>a b. z = <a, b>"
huffman@16081
   317
by (simp add: cpair_eq_pair)
huffman@16081
   318
huffman@16081
   319
lemma cprodE: "\<lbrakk>\<And>x y. p = <x, y> \<Longrightarrow> Q\<rbrakk> \<Longrightarrow> Q"
huffman@16081
   320
by (cut_tac Exh_Cprod2, auto)
huffman@16081
   321
huffman@16210
   322
lemma cfst_cpair [simp]: "cfst\<cdot><x, y> = x"
huffman@16081
   323
by (simp add: cpair_eq_pair cfst_def cont_fst)
huffman@15576
   324
huffman@16210
   325
lemma csnd_cpair [simp]: "csnd\<cdot><x, y> = y"
huffman@16081
   326
by (simp add: cpair_eq_pair csnd_def cont_snd)
huffman@16081
   327
huffman@16081
   328
lemma cfst_strict [simp]: "cfst\<cdot>\<bottom> = \<bottom>"
huffman@16081
   329
by (simp add: inst_cprod_pcpo2)
huffman@16081
   330
huffman@16081
   331
lemma csnd_strict [simp]: "csnd\<cdot>\<bottom> = \<bottom>"
huffman@16081
   332
by (simp add: inst_cprod_pcpo2)
huffman@16081
   333
huffman@16081
   334
lemma surjective_pairing_Cprod2: "<cfst\<cdot>p, csnd\<cdot>p> = p"
huffman@16081
   335
apply (unfold cfst_def csnd_def)
huffman@16081
   336
apply (simp add: cont_fst cont_snd cpair_eq_pair)
huffman@15576
   337
done
huffman@15576
   338
huffman@16750
   339
lemma less_cprod: "x \<sqsubseteq> y = (cfst\<cdot>x \<sqsubseteq> cfst\<cdot>y \<and> csnd\<cdot>x \<sqsubseteq> csnd\<cdot>y)"
huffman@16315
   340
by (simp add: less_cprod_def cfst_def csnd_def cont_fst cont_snd)
huffman@16315
   341
huffman@16750
   342
lemma eq_cprod: "(x = y) = (cfst\<cdot>x = cfst\<cdot>y \<and> csnd\<cdot>x = csnd\<cdot>y)"
huffman@16750
   343
by (auto simp add: po_eq_conv less_cprod)
huffman@16750
   344
huffman@25879
   345
lemma cfst_less_iff: "cfst\<cdot>x \<sqsubseteq> y = x \<sqsubseteq> <y, csnd\<cdot>x>"
huffman@25879
   346
by (simp add: less_cprod)
huffman@25879
   347
huffman@25879
   348
lemma csnd_less_iff: "csnd\<cdot>x \<sqsubseteq> y = x \<sqsubseteq> <cfst\<cdot>x, y>"
huffman@25879
   349
by (simp add: less_cprod)
huffman@25879
   350
huffman@25879
   351
lemma compact_cfst: "compact x \<Longrightarrow> compact (cfst\<cdot>x)"
huffman@25879
   352
by (rule compactI, simp add: cfst_less_iff)
huffman@25879
   353
huffman@25879
   354
lemma compact_csnd: "compact x \<Longrightarrow> compact (csnd\<cdot>x)"
huffman@25879
   355
by (rule compactI, simp add: csnd_less_iff)
huffman@25879
   356
huffman@25879
   357
lemma compact_cpair: "\<lbrakk>compact x; compact y\<rbrakk> \<Longrightarrow> compact <x, y>"
huffman@17837
   358
by (rule compactI, simp add: less_cprod)
huffman@17837
   359
huffman@25879
   360
lemma compact_cpair_iff [simp]: "compact <x, y> = (compact x \<and> compact y)"
huffman@25879
   361
apply (safe intro!: compact_cpair)
huffman@25879
   362
apply (drule compact_cfst, simp)
huffman@25879
   363
apply (drule compact_csnd, simp)
huffman@25879
   364
done
huffman@25879
   365
huffman@15576
   366
lemma lub_cprod2: 
huffman@16081
   367
  "chain S \<Longrightarrow> range S <<| <\<Squnion>i. cfst\<cdot>(S i), \<Squnion>i. csnd\<cdot>(S i)>"
huffman@16081
   368
apply (simp add: cpair_eq_pair cfst_def csnd_def cont_fst cont_snd)
huffman@15593
   369
apply (erule lub_cprod)
huffman@15576
   370
done
huffman@15576
   371
huffman@16081
   372
lemma thelub_cprod2:
huffman@16081
   373
  "chain S \<Longrightarrow> lub (range S) = <\<Squnion>i. cfst\<cdot>(S i), \<Squnion>i. csnd\<cdot>(S i)>"
huffman@16081
   374
by (rule lub_cprod2 [THEN thelubI])
huffman@15576
   375
huffman@18077
   376
lemma csplit1 [simp]: "csplit\<cdot>f\<cdot>\<bottom> = f\<cdot>\<bottom>\<cdot>\<bottom>"
huffman@18077
   377
by (simp add: csplit_def)
huffman@18077
   378
huffman@16081
   379
lemma csplit2 [simp]: "csplit\<cdot>f\<cdot><x,y> = f\<cdot>x\<cdot>y"
huffman@15593
   380
by (simp add: csplit_def)
huffman@15576
   381
huffman@16553
   382
lemma csplit3 [simp]: "csplit\<cdot>cpair\<cdot>z = z"
huffman@15593
   383
by (simp add: csplit_def surjective_pairing_Cprod2)
huffman@15576
   384
huffman@16210
   385
lemmas Cprod_rews = cfst_cpair csnd_cpair csplit2
huffman@15576
   386
huffman@15576
   387
end