header {* The cpo of cartesian products *}
theory Cprod
imports Bifinite
begin
defaultsort cpo
subsection {* Type @{typ unit} is a pcpo *}
definition
unit_when :: "'a -> unit -> 'a" where
"unit_when = (Λ a _. a)"
translations
"Λ(). t" == "CONST unit_when·t"
lemma unit_when [simp]: "unit_when·a·u = a"
by (simp add: unit_when_def)
subsection {* Continuous versions of constants *}
definition
cpair :: "'a -> 'b -> ('a * 'b)" -- {* continuous pairing *} where
"cpair = (Λ x y. (x, y))"
definition
cfst :: "('a * 'b) -> 'a" where
"cfst = (Λ p. fst p)"
definition
csnd :: "('a * 'b) -> 'b" where
"csnd = (Λ p. snd p)"
definition
csplit :: "('a -> 'b -> 'c) -> ('a * 'b) -> 'c" where
"csplit = (Λ f p. f·(cfst·p)·(csnd·p))"
syntax
"_ctuple" :: "['a, args] => 'a * 'b" ("(1<_,/ _>)")
syntax (xsymbols)
"_ctuple" :: "['a, args] => 'a * 'b" ("(1〈_,/ _〉)")
translations
"〈x, y, z〉" == "〈x, 〈y, z〉〉"
"〈x, y〉" == "CONST cpair·x·y"
translations
"Λ(CONST cpair·x·y). t" == "CONST csplit·(Λ x y. t)"
subsection {* Convert all lemmas to the continuous versions *}
lemma cpair_eq_pair: "<x, y> = (x, y)"
by (simp add: cpair_def cont_pair1 cont_pair2)
lemma pair_eq_cpair: "(x, y) = <x, y>"
by (simp add: cpair_def cont_pair1 cont_pair2)
lemma inject_cpair: "<a,b> = <aa,ba> ==> a = aa ∧ b = ba"
by (simp add: cpair_eq_pair)
lemma cpair_eq [iff]: "(<a, b> = <a', b'>) = (a = a' ∧ b = b')"
by (simp add: cpair_eq_pair)
lemma cpair_less [iff]: "(<a, b> \<sqsubseteq> <a', b'>) = (a \<sqsubseteq> a' ∧ b \<sqsubseteq> b')"
by (simp add: cpair_eq_pair)
lemma cpair_defined_iff [iff]: "(<x, y> = ⊥) = (x = ⊥ ∧ y = ⊥)"
by (simp add: cpair_eq_pair)
lemma cpair_strict [simp]: "〈⊥, ⊥〉 = ⊥"
by simp
lemma inst_cprod_pcpo2: "⊥ = <⊥, ⊥>"
by (rule cpair_strict [symmetric])
lemma defined_cpair_rev:
"<a,b> = ⊥ ==> a = ⊥ ∧ b = ⊥"
by simp
lemma Exh_Cprod2: "∃a b. z = <a, b>"
by (simp add: cpair_eq_pair)
lemma cprodE: "[|!!x y. p = <x, y> ==> Q|] ==> Q"
by (cut_tac Exh_Cprod2, auto)
lemma cfst_cpair [simp]: "cfst·<x, y> = x"
by (simp add: cpair_eq_pair cfst_def cont_fst)
lemma csnd_cpair [simp]: "csnd·<x, y> = y"
by (simp add: cpair_eq_pair csnd_def cont_snd)
lemma cfst_strict [simp]: "cfst·⊥ = ⊥"
by (simp add: cfst_def)
lemma csnd_strict [simp]: "csnd·⊥ = ⊥"
by (simp add: csnd_def)
lemma cpair_cfst_csnd: "〈cfst·p, csnd·p〉 = p"
by (cases p rule: cprodE, simp)
lemmas surjective_pairing_Cprod2 = cpair_cfst_csnd
lemma less_cprod: "x \<sqsubseteq> y = (cfst·x \<sqsubseteq> cfst·y ∧ csnd·x \<sqsubseteq> csnd·y)"
by (simp add: less_cprod_def cfst_def csnd_def cont_fst cont_snd)
lemma eq_cprod: "(x = y) = (cfst·x = cfst·y ∧ csnd·x = csnd·y)"
by (auto simp add: po_eq_conv less_cprod)
lemma cfst_less_iff: "cfst·x \<sqsubseteq> y = x \<sqsubseteq> <y, csnd·x>"
by (simp add: less_cprod)
lemma csnd_less_iff: "csnd·x \<sqsubseteq> y = x \<sqsubseteq> <cfst·x, y>"
by (simp add: less_cprod)
lemma compact_cfst: "compact x ==> compact (cfst·x)"
by (rule compactI, simp add: cfst_less_iff)
lemma compact_csnd: "compact x ==> compact (csnd·x)"
by (rule compactI, simp add: csnd_less_iff)
lemma compact_cpair: "[|compact x; compact y|] ==> compact <x, y>"
by (simp add: cpair_eq_pair)
lemma compact_cpair_iff [simp]: "compact <x, y> = (compact x ∧ compact y)"
by (simp add: cpair_eq_pair)
lemma lub_cprod2:
"chain S ==> range S <<| <\<Squnion>i. cfst·(S i), \<Squnion>i. csnd·(S i)>"
apply (simp add: cpair_eq_pair cfst_def csnd_def cont_fst cont_snd)
apply (erule lub_cprod)
done
lemma thelub_cprod2:
"chain S ==> (\<Squnion>i. S i) = <\<Squnion>i. cfst·(S i), \<Squnion>i. csnd·(S i)>"
by (rule lub_cprod2 [THEN thelubI])
lemma csplit1 [simp]: "csplit·f·⊥ = f·⊥·⊥"
by (simp add: csplit_def)
lemma csplit2 [simp]: "csplit·f·<x,y> = f·x·y"
by (simp add: csplit_def)
lemma csplit3 [simp]: "csplit·cpair·z = z"
by (simp add: csplit_def cpair_cfst_csnd)
lemmas Cprod_rews = cfst_cpair csnd_cpair csplit2
subsection {* Product type is a bifinite domain *}
instantiation "*" :: (profinite, profinite) profinite
begin
definition
approx_cprod_def:
"approx = (λn. Λ〈x, y〉. 〈approx n·x, approx n·y〉)"
instance proof
fix i :: nat and x :: "'a × 'b"
show "chain (approx :: nat => 'a × 'b -> 'a × 'b)"
unfolding approx_cprod_def by simp
show "(\<Squnion>i. approx i·x) = x"
unfolding approx_cprod_def
by (simp add: lub_distribs eta_cfun)
show "approx i·(approx i·x) = approx i·x"
unfolding approx_cprod_def csplit_def by simp
have "{x::'a × 'b. approx i·x = x} ⊆
{x::'a. approx i·x = x} × {x::'b. approx i·x = x}"
unfolding approx_cprod_def
by (clarsimp simp add: pair_eq_cpair)
thus "finite {x::'a × 'b. approx i·x = x}"
by (rule finite_subset,
intro finite_cartesian_product finite_fixes_approx)
qed
end
instance "*" :: (bifinite, bifinite) bifinite ..
lemma approx_cpair [simp]:
"approx i·〈x, y〉 = 〈approx i·x, approx i·y〉"
unfolding approx_cprod_def by simp
lemma cfst_approx: "cfst·(approx i·p) = approx i·(cfst·p)"
by (cases p rule: cprodE, simp)
lemma csnd_approx: "csnd·(approx i·p) = approx i·(csnd·p)"
by (cases p rule: cprodE, simp)
end