src/HOLCF/Cprod.thy
author huffman
Wed Mar 26 22:38:17 2008 +0100 (2008-03-26)
changeset 26407 562a1d615336
parent 26035 9f8810c42604
child 26962 c8b20f615d6c
permissions -rw-r--r--
rename class bifinite_cpo to profinite; generalize powerdomains from bifinite to profinite
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@25910
    11
imports Bifinite
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@26025
    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@26025
    24
instance ..
huffman@26025
    25
end
huffman@25784
    26
huffman@26025
    27
instance unit :: discrete_cpo
huffman@26025
    28
by intro_classes simp
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@26035
    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@26035
    54
instance ..
huffman@26035
    55
end
huffman@26035
    56
huffman@26035
    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@15593
    74
subsection {* Monotonicity of @{text "(_,_)"}, @{term fst}, @{term snd} *}
huffman@15576
    75
huffman@26029
    76
lemma prod_lessI: "\<lbrakk>fst p \<sqsubseteq> fst q; snd p \<sqsubseteq> snd q\<rbrakk> \<Longrightarrow> p \<sqsubseteq> q"
huffman@26029
    77
unfolding less_cprod_def by simp
huffman@26029
    78
huffman@26029
    79
lemma Pair_less_iff [simp]: "(a, b) \<sqsubseteq> (c, d) = (a \<sqsubseteq> c \<and> b \<sqsubseteq> d)"
huffman@26029
    80
unfolding less_cprod_def by simp
huffman@26029
    81
huffman@15593
    82
text {* Pair @{text "(_,_)"}  is monotone in both arguments *}
huffman@15576
    83
huffman@16081
    84
lemma monofun_pair1: "monofun (\<lambda>x. (x, y))"
huffman@26029
    85
by (simp add: monofun_def)
huffman@15576
    86
huffman@16081
    87
lemma monofun_pair2: "monofun (\<lambda>y. (x, y))"
huffman@26029
    88
by (simp add: monofun_def)
huffman@15576
    89
huffman@16081
    90
lemma monofun_pair:
huffman@16081
    91
  "\<lbrakk>x1 \<sqsubseteq> x2; y1 \<sqsubseteq> y2\<rbrakk> \<Longrightarrow> (x1, y1) \<sqsubseteq> (x2, y2)"
huffman@26029
    92
by simp
huffman@15576
    93
huffman@15593
    94
text {* @{term fst} and @{term snd} are monotone *}
huffman@15576
    95
huffman@15576
    96
lemma monofun_fst: "monofun fst"
huffman@16210
    97
by (simp add: monofun_def less_cprod_def)
huffman@15576
    98
huffman@15576
    99
lemma monofun_snd: "monofun snd"
huffman@16210
   100
by (simp add: monofun_def less_cprod_def)
huffman@15576
   101
huffman@18289
   102
subsection {* Product type is a cpo *}
huffman@15576
   103
huffman@26018
   104
lemma is_lub_Pair:
huffman@26018
   105
  "\<lbrakk>range X <<| x; range Y <<| y\<rbrakk> \<Longrightarrow> range (\<lambda>i. (X i, Y i)) <<| (x, y)"
huffman@26018
   106
apply (rule is_lubI [OF ub_rangeI])
huffman@26018
   107
apply (simp add: less_cprod_def is_ub_lub)
huffman@26018
   108
apply (frule ub2ub_monofun [OF monofun_fst])
huffman@26018
   109
apply (drule ub2ub_monofun [OF monofun_snd])
huffman@26018
   110
apply (simp add: less_cprod_def is_lub_lub)
huffman@26018
   111
done
huffman@26018
   112
huffman@25784
   113
lemma lub_cprod:
huffman@25784
   114
  fixes S :: "nat \<Rightarrow> ('a::cpo \<times> 'b::cpo)"
huffman@25784
   115
  assumes S: "chain S"
huffman@25784
   116
  shows "range S <<| (\<Squnion>i. fst (S i), \<Squnion>i. snd (S i))"
huffman@26018
   117
proof -
huffman@26018
   118
  have "chain (\<lambda>i. fst (S i))"
huffman@26018
   119
    using monofun_fst S by (rule ch2ch_monofun)
huffman@26018
   120
  hence 1: "range (\<lambda>i. fst (S i)) <<| (\<Squnion>i. fst (S i))"
huffman@26027
   121
    by (rule cpo_lubI)
huffman@26018
   122
  have "chain (\<lambda>i. snd (S i))"
huffman@26018
   123
    using monofun_snd S by (rule ch2ch_monofun)
huffman@26018
   124
  hence 2: "range (\<lambda>i. snd (S i)) <<| (\<Squnion>i. snd (S i))"
huffman@26027
   125
    by (rule cpo_lubI)
huffman@26018
   126
  show "range S <<| (\<Squnion>i. fst (S i), \<Squnion>i. snd (S i))"
huffman@26018
   127
    using is_lub_Pair [OF 1 2] by simp
huffman@26018
   128
qed
huffman@15576
   129
huffman@16081
   130
lemma thelub_cprod:
huffman@25784
   131
  "chain (S::nat \<Rightarrow> 'a::cpo \<times> 'b::cpo)
huffman@25784
   132
    \<Longrightarrow> lub (range S) = (\<Squnion>i. fst (S i), \<Squnion>i. snd (S i))"
huffman@16081
   133
by (rule lub_cprod [THEN thelubI])
huffman@15576
   134
huffman@25784
   135
instance "*" :: (cpo, cpo) cpo
huffman@25784
   136
proof
huffman@25784
   137
  fix S :: "nat \<Rightarrow> ('a \<times> 'b)"
huffman@25784
   138
  assume "chain S"
huffman@25784
   139
  hence "range S <<| (\<Squnion>i. fst (S i), \<Squnion>i. snd (S i))"
huffman@25784
   140
    by (rule lub_cprod)
huffman@25784
   141
  thus "\<exists>x. range S <<| x" ..
huffman@25784
   142
qed
huffman@15593
   143
huffman@25827
   144
instance "*" :: (finite_po, finite_po) finite_po ..
huffman@25827
   145
huffman@26025
   146
instance "*" :: (discrete_cpo, discrete_cpo) discrete_cpo
huffman@26025
   147
proof
huffman@26025
   148
  fix x y :: "'a \<times> 'b"
huffman@26025
   149
  show "x \<sqsubseteq> y \<longleftrightarrow> x = y"
huffman@26025
   150
    unfolding less_cprod_def Pair_fst_snd_eq
huffman@26025
   151
    by simp
huffman@26025
   152
qed
huffman@26025
   153
huffman@18289
   154
subsection {* Product type is pointed *}
huffman@15593
   155
huffman@16081
   156
lemma minimal_cprod: "(\<bottom>, \<bottom>) \<sqsubseteq> p"
huffman@16081
   157
by (simp add: less_cprod_def)
huffman@15593
   158
huffman@25908
   159
instance "*" :: (pcpo, pcpo) pcpo
huffman@25908
   160
by intro_classes (fast intro: minimal_cprod)
huffman@15593
   161
huffman@25908
   162
lemma inst_cprod_pcpo: "\<bottom> = (\<bottom>, \<bottom>)"
huffman@16081
   163
by (rule minimal_cprod [THEN UU_I, symmetric])
huffman@16081
   164
huffman@15593
   165
huffman@15593
   166
subsection {* Continuity of @{text "(_,_)"}, @{term fst}, @{term snd} *}
huffman@15593
   167
huffman@16081
   168
lemma cont_pair1: "cont (\<lambda>x. (x, y))"
huffman@26018
   169
apply (rule contI)
huffman@26018
   170
apply (rule is_lub_Pair)
huffman@26027
   171
apply (erule cpo_lubI)
huffman@26018
   172
apply (rule lub_const)
huffman@15593
   173
done
huffman@15593
   174
huffman@16081
   175
lemma cont_pair2: "cont (\<lambda>y. (x, y))"
huffman@26018
   176
apply (rule contI)
huffman@26018
   177
apply (rule is_lub_Pair)
huffman@26018
   178
apply (rule lub_const)
huffman@26027
   179
apply (erule cpo_lubI)
huffman@15593
   180
done
huffman@15576
   181
huffman@16081
   182
lemma contlub_fst: "contlub fst"
huffman@16210
   183
apply (rule contlubI)
huffman@16210
   184
apply (simp add: thelub_cprod)
huffman@15593
   185
done
huffman@15593
   186
huffman@16081
   187
lemma contlub_snd: "contlub snd"
huffman@16210
   188
apply (rule contlubI)
huffman@16210
   189
apply (simp add: thelub_cprod)
huffman@15593
   190
done
huffman@15576
   191
huffman@16081
   192
lemma cont_fst: "cont fst"
huffman@15593
   193
apply (rule monocontlub2cont)
huffman@15593
   194
apply (rule monofun_fst)
huffman@15593
   195
apply (rule contlub_fst)
huffman@15593
   196
done
huffman@15593
   197
huffman@16081
   198
lemma cont_snd: "cont snd"
huffman@15593
   199
apply (rule monocontlub2cont)
huffman@15593
   200
apply (rule monofun_snd)
huffman@15593
   201
apply (rule contlub_snd)
huffman@15593
   202
done
huffman@15593
   203
huffman@15593
   204
subsection {* Continuous versions of constants *}
huffman@15576
   205
wenzelm@25131
   206
definition
wenzelm@25131
   207
  cpair :: "'a \<rightarrow> 'b \<rightarrow> ('a * 'b)"  -- {* continuous pairing *}  where
wenzelm@25131
   208
  "cpair = (\<Lambda> x y. (x, y))"
wenzelm@25131
   209
wenzelm@25131
   210
definition
wenzelm@25131
   211
  cfst :: "('a * 'b) \<rightarrow> 'a" where
wenzelm@25131
   212
  "cfst = (\<Lambda> p. fst p)"
huffman@17834
   213
wenzelm@25131
   214
definition
wenzelm@25131
   215
  csnd :: "('a * 'b) \<rightarrow> 'b" where
wenzelm@25131
   216
  "csnd = (\<Lambda> p. snd p)"      
huffman@17834
   217
wenzelm@25131
   218
definition
wenzelm@25131
   219
  csplit :: "('a \<rightarrow> 'b \<rightarrow> 'c) \<rightarrow> ('a * 'b) \<rightarrow> 'c" where
wenzelm@25131
   220
  "csplit = (\<Lambda> f p. f\<cdot>(cfst\<cdot>p)\<cdot>(csnd\<cdot>p))"
huffman@15576
   221
huffman@15576
   222
syntax
huffman@17834
   223
  "_ctuple" :: "['a, args] \<Rightarrow> 'a * 'b"  ("(1<_,/ _>)")
huffman@17834
   224
huffman@17834
   225
syntax (xsymbols)
huffman@17834
   226
  "_ctuple" :: "['a, args] \<Rightarrow> 'a * 'b"  ("(1\<langle>_,/ _\<rangle>)")
huffman@15576
   227
huffman@15576
   228
translations
huffman@18078
   229
  "\<langle>x, y, z\<rangle>" == "\<langle>x, \<langle>y, z\<rangle>\<rangle>"
wenzelm@25131
   230
  "\<langle>x, y\<rangle>"    == "CONST cpair\<cdot>x\<cdot>y"
huffman@17834
   231
huffman@17816
   232
translations
wenzelm@25131
   233
  "\<Lambda>(CONST cpair\<cdot>x\<cdot>y). t" == "CONST csplit\<cdot>(\<Lambda> x y. t)"
huffman@17816
   234
huffman@15576
   235
huffman@15593
   236
subsection {* Convert all lemmas to the continuous versions *}
huffman@15576
   237
huffman@16081
   238
lemma cpair_eq_pair: "<x, y> = (x, y)"
huffman@16081
   239
by (simp add: cpair_def cont_pair1 cont_pair2)
huffman@16081
   240
huffman@25910
   241
lemma pair_eq_cpair: "(x, y) = <x, y>"
huffman@25910
   242
by (simp add: cpair_def cont_pair1 cont_pair2)
huffman@25910
   243
huffman@16081
   244
lemma inject_cpair: "<a,b> = <aa,ba> \<Longrightarrow> a = aa \<and> b = ba"
huffman@16081
   245
by (simp add: cpair_eq_pair)
huffman@15576
   246
huffman@16081
   247
lemma cpair_eq [iff]: "(<a, b> = <a', b'>) = (a = a' \<and> b = b')"
huffman@16081
   248
by (simp add: cpair_eq_pair)
huffman@15576
   249
huffman@18077
   250
lemma cpair_less [iff]: "(<a, b> \<sqsubseteq> <a', b'>) = (a \<sqsubseteq> a' \<and> b \<sqsubseteq> b')"
huffman@16081
   251
by (simp add: cpair_eq_pair less_cprod_def)
huffman@16057
   252
huffman@18077
   253
lemma cpair_defined_iff [iff]: "(<x, y> = \<bottom>) = (x = \<bottom> \<and> y = \<bottom>)"
huffman@16916
   254
by (simp add: inst_cprod_pcpo cpair_eq_pair)
huffman@16916
   255
huffman@25913
   256
lemma cpair_strict [simp]: "\<langle>\<bottom>, \<bottom>\<rangle> = \<bottom>"
huffman@18077
   257
by simp
huffman@16210
   258
huffman@16081
   259
lemma inst_cprod_pcpo2: "\<bottom> = <\<bottom>, \<bottom>>"
huffman@16916
   260
by (rule cpair_strict [symmetric])
huffman@15576
   261
huffman@15576
   262
lemma defined_cpair_rev: 
huffman@16081
   263
 "<a,b> = \<bottom> \<Longrightarrow> a = \<bottom> \<and> b = \<bottom>"
huffman@18077
   264
by simp
huffman@16081
   265
huffman@16081
   266
lemma Exh_Cprod2: "\<exists>a b. z = <a, b>"
huffman@16081
   267
by (simp add: cpair_eq_pair)
huffman@16081
   268
huffman@16081
   269
lemma cprodE: "\<lbrakk>\<And>x y. p = <x, y> \<Longrightarrow> Q\<rbrakk> \<Longrightarrow> Q"
huffman@16081
   270
by (cut_tac Exh_Cprod2, auto)
huffman@16081
   271
huffman@16210
   272
lemma cfst_cpair [simp]: "cfst\<cdot><x, y> = x"
huffman@16081
   273
by (simp add: cpair_eq_pair cfst_def cont_fst)
huffman@15576
   274
huffman@16210
   275
lemma csnd_cpair [simp]: "csnd\<cdot><x, y> = y"
huffman@16081
   276
by (simp add: cpair_eq_pair csnd_def cont_snd)
huffman@16081
   277
huffman@16081
   278
lemma cfst_strict [simp]: "cfst\<cdot>\<bottom> = \<bottom>"
huffman@25913
   279
unfolding inst_cprod_pcpo2 by (rule cfst_cpair)
huffman@16081
   280
huffman@16081
   281
lemma csnd_strict [simp]: "csnd\<cdot>\<bottom> = \<bottom>"
huffman@25913
   282
unfolding inst_cprod_pcpo2 by (rule csnd_cpair)
huffman@16081
   283
huffman@25910
   284
lemma cpair_cfst_csnd: "\<langle>cfst\<cdot>p, csnd\<cdot>p\<rangle> = p"
huffman@25910
   285
by (cases p rule: cprodE, simp)
huffman@25910
   286
huffman@25910
   287
lemmas surjective_pairing_Cprod2 = cpair_cfst_csnd
huffman@15576
   288
huffman@16750
   289
lemma less_cprod: "x \<sqsubseteq> y = (cfst\<cdot>x \<sqsubseteq> cfst\<cdot>y \<and> csnd\<cdot>x \<sqsubseteq> csnd\<cdot>y)"
huffman@16315
   290
by (simp add: less_cprod_def cfst_def csnd_def cont_fst cont_snd)
huffman@16315
   291
huffman@16750
   292
lemma eq_cprod: "(x = y) = (cfst\<cdot>x = cfst\<cdot>y \<and> csnd\<cdot>x = csnd\<cdot>y)"
huffman@16750
   293
by (auto simp add: po_eq_conv less_cprod)
huffman@16750
   294
huffman@25879
   295
lemma cfst_less_iff: "cfst\<cdot>x \<sqsubseteq> y = x \<sqsubseteq> <y, csnd\<cdot>x>"
huffman@25879
   296
by (simp add: less_cprod)
huffman@25879
   297
huffman@25879
   298
lemma csnd_less_iff: "csnd\<cdot>x \<sqsubseteq> y = x \<sqsubseteq> <cfst\<cdot>x, y>"
huffman@25879
   299
by (simp add: less_cprod)
huffman@25879
   300
huffman@25879
   301
lemma compact_cfst: "compact x \<Longrightarrow> compact (cfst\<cdot>x)"
huffman@25879
   302
by (rule compactI, simp add: cfst_less_iff)
huffman@25879
   303
huffman@25879
   304
lemma compact_csnd: "compact x \<Longrightarrow> compact (csnd\<cdot>x)"
huffman@25879
   305
by (rule compactI, simp add: csnd_less_iff)
huffman@25879
   306
huffman@25879
   307
lemma compact_cpair: "\<lbrakk>compact x; compact y\<rbrakk> \<Longrightarrow> compact <x, y>"
huffman@17837
   308
by (rule compactI, simp add: less_cprod)
huffman@17837
   309
huffman@25879
   310
lemma compact_cpair_iff [simp]: "compact <x, y> = (compact x \<and> compact y)"
huffman@25879
   311
apply (safe intro!: compact_cpair)
huffman@25879
   312
apply (drule compact_cfst, simp)
huffman@25879
   313
apply (drule compact_csnd, simp)
huffman@25879
   314
done
huffman@25879
   315
huffman@25905
   316
instance "*" :: (chfin, chfin) chfin
huffman@25921
   317
apply intro_classes
huffman@25905
   318
apply (erule compact_imp_max_in_chain)
huffman@25905
   319
apply (rule_tac p="\<Squnion>i. Y i" in cprodE, simp)
huffman@25905
   320
done
huffman@25905
   321
huffman@15576
   322
lemma lub_cprod2: 
huffman@16081
   323
  "chain S \<Longrightarrow> range S <<| <\<Squnion>i. cfst\<cdot>(S i), \<Squnion>i. csnd\<cdot>(S i)>"
huffman@16081
   324
apply (simp add: cpair_eq_pair cfst_def csnd_def cont_fst cont_snd)
huffman@15593
   325
apply (erule lub_cprod)
huffman@15576
   326
done
huffman@15576
   327
huffman@16081
   328
lemma thelub_cprod2:
huffman@16081
   329
  "chain S \<Longrightarrow> lub (range S) = <\<Squnion>i. cfst\<cdot>(S i), \<Squnion>i. csnd\<cdot>(S i)>"
huffman@16081
   330
by (rule lub_cprod2 [THEN thelubI])
huffman@15576
   331
huffman@18077
   332
lemma csplit1 [simp]: "csplit\<cdot>f\<cdot>\<bottom> = f\<cdot>\<bottom>\<cdot>\<bottom>"
huffman@18077
   333
by (simp add: csplit_def)
huffman@18077
   334
huffman@16081
   335
lemma csplit2 [simp]: "csplit\<cdot>f\<cdot><x,y> = f\<cdot>x\<cdot>y"
huffman@15593
   336
by (simp add: csplit_def)
huffman@15576
   337
huffman@16553
   338
lemma csplit3 [simp]: "csplit\<cdot>cpair\<cdot>z = z"
huffman@25910
   339
by (simp add: csplit_def cpair_cfst_csnd)
huffman@15576
   340
huffman@16210
   341
lemmas Cprod_rews = cfst_cpair csnd_cpair csplit2
huffman@15576
   342
huffman@25910
   343
subsection {* Product type is a bifinite domain *}
huffman@25910
   344
huffman@26407
   345
instance "*" :: (profinite, profinite) approx ..
huffman@25910
   346
huffman@25910
   347
defs (overloaded)
huffman@25910
   348
  approx_cprod_def:
huffman@25910
   349
    "approx \<equiv> \<lambda>n. \<Lambda>\<langle>x, y\<rangle>. \<langle>approx n\<cdot>x, approx n\<cdot>y\<rangle>"
huffman@25910
   350
huffman@26407
   351
instance "*" :: (profinite, profinite) profinite
huffman@25910
   352
proof
huffman@25910
   353
  fix i :: nat and x :: "'a \<times> 'b"
huffman@25910
   354
  show "chain (\<lambda>i. approx i\<cdot>x)"
huffman@25910
   355
    unfolding approx_cprod_def by simp
huffman@25910
   356
  show "(\<Squnion>i. approx i\<cdot>x) = x"
huffman@25910
   357
    unfolding approx_cprod_def
huffman@25910
   358
    by (simp add: lub_distribs eta_cfun)
huffman@25910
   359
  show "approx i\<cdot>(approx i\<cdot>x) = approx i\<cdot>x"
huffman@25910
   360
    unfolding approx_cprod_def csplit_def by simp
huffman@25910
   361
  have "{x::'a \<times> 'b. approx i\<cdot>x = x} \<subseteq>
huffman@25910
   362
        {x::'a. approx i\<cdot>x = x} \<times> {x::'b. approx i\<cdot>x = x}"
huffman@25910
   363
    unfolding approx_cprod_def
huffman@25910
   364
    by (clarsimp simp add: pair_eq_cpair)
huffman@25910
   365
  thus "finite {x::'a \<times> 'b. approx i\<cdot>x = x}"
huffman@25910
   366
    by (rule finite_subset,
huffman@25910
   367
        intro finite_cartesian_product finite_fixes_approx)
huffman@25910
   368
qed
huffman@25910
   369
huffman@25910
   370
instance "*" :: (bifinite, bifinite) bifinite ..
huffman@25910
   371
huffman@25910
   372
lemma approx_cpair [simp]:
huffman@25910
   373
  "approx i\<cdot>\<langle>x, y\<rangle> = \<langle>approx i\<cdot>x, approx i\<cdot>y\<rangle>"
huffman@25910
   374
unfolding approx_cprod_def by simp
huffman@25910
   375
huffman@25910
   376
lemma cfst_approx: "cfst\<cdot>(approx i\<cdot>p) = approx i\<cdot>(cfst\<cdot>p)"
huffman@25910
   377
by (cases p rule: cprodE, simp)
huffman@25910
   378
huffman@25910
   379
lemma csnd_approx: "csnd\<cdot>(approx i\<cdot>p) = approx i\<cdot>(csnd\<cdot>p)"
huffman@25910
   380
by (cases p rule: cprodE, simp)
huffman@25910
   381
huffman@15576
   382
end