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