(* Title: HOLCF/Domain.thy ID: $Id: Domain.thy,v 1.15 2007/06/13 16:30:17 wenzelm Exp $ Author: Brian Huffman *) header {* Domain package *} theory Domain imports Ssum Sprod Up One Tr Fixrec begin defaultsort pcpo subsection {* Continuous isomorphisms *} text {* A locale for continuous isomorphisms *} locale iso = fixes abs :: "'a -> 'b" fixes rep :: "'b -> 'a" assumes abs_iso [simp]: "rep·(abs·x) = x" assumes rep_iso [simp]: "abs·(rep·y) = y" begin lemma swap: "iso rep abs" by (rule iso.intro [OF rep_iso abs_iso]) lemma abs_less: "(abs·x \<sqsubseteq> abs·y) = (x \<sqsubseteq> y)" proof assume "abs·x \<sqsubseteq> abs·y" then have "rep·(abs·x) \<sqsubseteq> rep·(abs·y)" by (rule monofun_cfun_arg) then show "x \<sqsubseteq> y" by simp next assume "x \<sqsubseteq> y" then show "abs·x \<sqsubseteq> abs·y" by (rule monofun_cfun_arg) qed lemma rep_less: "(rep·x \<sqsubseteq> rep·y) = (x \<sqsubseteq> y)" by (rule iso.abs_less [OF swap]) lemma abs_eq: "(abs·x = abs·y) = (x = y)" by (simp add: po_eq_conv abs_less) lemma rep_eq: "(rep·x = rep·y) = (x = y)" by (rule iso.abs_eq [OF swap]) lemma abs_strict: "abs·⊥ = ⊥" proof - have "⊥ \<sqsubseteq> rep·⊥" .. then have "abs·⊥ \<sqsubseteq> abs·(rep·⊥)" by (rule monofun_cfun_arg) then have "abs·⊥ \<sqsubseteq> ⊥" by simp then show ?thesis by (rule UU_I) qed lemma rep_strict: "rep·⊥ = ⊥" by (rule iso.abs_strict [OF swap]) lemma abs_defin': "abs·x = ⊥ ==> x = ⊥" proof - have "x = rep·(abs·x)" by simp also assume "abs·x = ⊥" also note rep_strict finally show "x = ⊥" . qed lemma rep_defin': "rep·z = ⊥ ==> z = ⊥" by (rule iso.abs_defin' [OF swap]) lemma abs_defined: "z ≠ ⊥ ==> abs·z ≠ ⊥" by (erule contrapos_nn, erule abs_defin') lemma rep_defined: "z ≠ ⊥ ==> rep·z ≠ ⊥" by (rule iso.abs_defined [OF iso.swap]) (rule iso_axioms) lemma abs_defined_iff: "(abs·x = ⊥) = (x = ⊥)" by (auto elim: abs_defin' intro: abs_strict) lemma rep_defined_iff: "(rep·x = ⊥) = (x = ⊥)" by (rule iso.abs_defined_iff [OF iso.swap]) (rule iso_axioms) lemma (in iso) compact_abs_rev: "compact (abs·x) ==> compact x" proof (unfold compact_def) assume "adm (λy. ¬ abs·x \<sqsubseteq> y)" with cont_Rep_CFun2 have "adm (λy. ¬ abs·x \<sqsubseteq> abs·y)" by (rule adm_subst) then show "adm (λy. ¬ x \<sqsubseteq> y)" using abs_less by simp qed lemma compact_rep_rev: "compact (rep·x) ==> compact x" by (rule iso.compact_abs_rev [OF iso.swap]) (rule iso_axioms) lemma compact_abs: "compact x ==> compact (abs·x)" by (rule compact_rep_rev) simp lemma compact_rep: "compact x ==> compact (rep·x)" by (rule iso.compact_abs [OF iso.swap]) (rule iso_axioms) lemma iso_swap: "(x = abs·y) = (rep·x = y)" proof assume "x = abs·y" then have "rep·x = rep·(abs·y)" by simp then show "rep·x = y" by simp next assume "rep·x = y" then have "abs·(rep·x) = abs·y" by simp then show "x = abs·y" by simp qed end subsection {* Casedist *} lemma ex_one_defined_iff: "(∃x. P x ∧ x ≠ ⊥) = P ONE" apply safe apply (rule_tac p=x in oneE) apply simp apply simp apply force done lemma ex_up_defined_iff: "(∃x. P x ∧ x ≠ ⊥) = (∃x. P (up·x))" apply safe apply (rule_tac p=x in upE) apply simp apply fast apply (force intro!: up_defined) done lemma ex_sprod_defined_iff: "(∃y. P y ∧ y ≠ ⊥) = (∃x y. (P (:x, y:) ∧ x ≠ ⊥) ∧ y ≠ ⊥)" apply safe apply (rule_tac p=y in sprodE) apply simp apply fast apply (force intro!: spair_defined) done lemma ex_sprod_up_defined_iff: "(∃y. P y ∧ y ≠ ⊥) = (∃x y. P (:up·x, y:) ∧ y ≠ ⊥)" apply safe apply (rule_tac p=y in sprodE) apply simp apply (rule_tac p=x in upE) apply simp apply fast apply (force intro!: spair_defined) done lemma ex_ssum_defined_iff: "(∃x. P x ∧ x ≠ ⊥) = ((∃x. P (sinl·x) ∧ x ≠ ⊥) ∨ (∃x. P (sinr·x) ∧ x ≠ ⊥))" apply (rule iffI) apply (erule exE) apply (erule conjE) apply (rule_tac p=x in ssumE) apply simp apply (rule disjI1, fast) apply (rule disjI2, fast) apply (erule disjE) apply force apply force done lemma exh_start: "p = ⊥ ∨ (∃x. p = x ∧ x ≠ ⊥)" by auto lemmas ex_defined_iffs = ex_ssum_defined_iff ex_sprod_up_defined_iff ex_sprod_defined_iff ex_up_defined_iff ex_one_defined_iff text {* Rules for turning exh into casedist *} lemma exh_casedist0: "[|R; R ==> P|] ==> P" (* like make_elim *) by auto lemma exh_casedist1: "((P ∨ Q ==> R) ==> S) ≡ ([|P ==> R; Q ==> R|] ==> S)" by rule auto lemma exh_casedist2: "(∃x. P x ==> Q) ≡ (!!x. P x ==> Q)" by rule auto lemma exh_casedist3: "(P ∧ Q ==> R) ≡ (P ==> Q ==> R)" by rule auto lemmas exh_casedists = exh_casedist1 exh_casedist2 exh_casedist3 subsection {* Setting up the package *} ML {* val iso_intro = thm "iso.intro"; val iso_abs_iso = thm "iso.abs_iso"; val iso_rep_iso = thm "iso.rep_iso"; val iso_abs_strict = thm "iso.abs_strict"; val iso_rep_strict = thm "iso.rep_strict"; val iso_abs_defin' = thm "iso.abs_defin'"; val iso_rep_defin' = thm "iso.rep_defin'"; val iso_abs_defined = thm "iso.abs_defined"; val iso_rep_defined = thm "iso.rep_defined"; val iso_compact_abs = thm "iso.compact_abs"; val iso_compact_rep = thm "iso.compact_rep"; val iso_iso_swap = thm "iso.iso_swap"; val exh_start = thm "exh_start"; val ex_defined_iffs = thms "ex_defined_iffs"; val exh_casedist0 = thm "exh_casedist0"; val exh_casedists = thms "exh_casedists"; *} end
lemma swap:
iso rep abs
lemma abs_less:
abs·x << abs·y = x << y
lemma rep_less:
rep·x << rep·y = x << y
lemma abs_eq:
(abs·x = abs·y) = (x = y)
lemma rep_eq:
(rep·x = rep·y) = (x = y)
lemma abs_strict:
abs·UU = UU
lemma rep_strict:
rep·UU = UU
lemma abs_defin':
abs·x = UU ==> x = UU
lemma rep_defin':
rep·z = UU ==> z = UU
lemma abs_defined:
z ≠ UU ==> abs·z ≠ UU
lemma rep_defined:
z ≠ UU ==> rep·z ≠ UU
lemma abs_defined_iff:
(abs·x = UU) = (x = UU)
lemma rep_defined_iff:
(rep·x = UU) = (x = UU)
lemma compact_abs_rev:
compact (abs·x) ==> compact x
lemma compact_rep_rev:
compact (rep·x) ==> compact x
lemma compact_abs:
compact x ==> compact (abs·x)
lemma compact_rep:
compact x ==> compact (rep·x)
lemma iso_swap:
(x = abs·y) = (rep·x = y)
lemma ex_one_defined_iff:
(∃x. P x ∧ x ≠ UU) = P ONE
lemma ex_up_defined_iff:
(∃x. P x ∧ x ≠ UU) = (∃x. P (up·x))
lemma ex_sprod_defined_iff:
(∃y. P y ∧ y ≠ UU) = (∃x y. (P (:x, y:) ∧ x ≠ UU) ∧ y ≠ UU)
lemma ex_sprod_up_defined_iff:
(∃y. P y ∧ y ≠ UU) = (∃x y. P (:up·x, y:) ∧ y ≠ UU)
lemma ex_ssum_defined_iff:
(∃x. P x ∧ x ≠ UU) = ((∃x. P (sinl·x) ∧ x ≠ UU) ∨ (∃x. P (sinr·x) ∧ x ≠ UU))
lemma exh_start:
p = UU ∨ (∃x. p = x ∧ x ≠ UU)
lemma ex_defined_iffs:
(∃x. P x ∧ x ≠ UU) = ((∃x. P (sinl·x) ∧ x ≠ UU) ∨ (∃x. P (sinr·x) ∧ x ≠ UU))
(∃y. P y ∧ y ≠ UU) = (∃x y. P (:up·x, y:) ∧ y ≠ UU)
(∃y. P y ∧ y ≠ UU) = (∃x y. (P (:x, y:) ∧ x ≠ UU) ∧ y ≠ UU)
(∃x. P x ∧ x ≠ UU) = (∃x. P (up·x))
(∃x. P x ∧ x ≠ UU) = P ONE
lemma exh_casedist0:
[| R; R ==> P |] ==> P
lemma exh_casedist1:
((P ∨ Q ==> R) ==> S) == ([| P ==> R; Q ==> R |] ==> S)
lemma exh_casedist2:
(∃x. P x ==> Q) == (!!x. P x ==> Q)
lemma exh_casedist3:
(P ∧ Q ==> R) == ([| P; Q |] ==> R)
lemma exh_casedists:
((P ∨ Q ==> R) ==> S) == ([| P ==> R; Q ==> R |] ==> S)
(∃x. P x ==> Q) == (!!x. P x ==> Q)
(P ∧ Q ==> R) == ([| P; Q |] ==> R)