1 (* Title: HOL/HOLCF/Up.thy |
1 (* Title: HOL/HOLCF/Up.thy |
2 Author: Franz Regensburger |
2 Author: Franz Regensburger |
3 Author: Brian Huffman |
3 Author: Brian Huffman |
4 *) |
4 *) |
5 |
5 |
6 section {* The type of lifted values *} |
6 section \<open>The type of lifted values\<close> |
7 |
7 |
8 theory Up |
8 theory Up |
9 imports Cfun |
9 imports Cfun |
10 begin |
10 begin |
11 |
11 |
12 default_sort cpo |
12 default_sort cpo |
13 |
13 |
14 subsection {* Definition of new type for lifting *} |
14 subsection \<open>Definition of new type for lifting\<close> |
15 |
15 |
16 datatype 'a u ("(_\<^sub>\<bottom>)" [1000] 999) = Ibottom | Iup 'a |
16 datatype 'a u ("(_\<^sub>\<bottom>)" [1000] 999) = Ibottom | Iup 'a |
17 |
17 |
18 primrec Ifup :: "('a \<rightarrow> 'b::pcpo) \<Rightarrow> 'a u \<Rightarrow> 'b" where |
18 primrec Ifup :: "('a \<rightarrow> 'b::pcpo) \<Rightarrow> 'a u \<Rightarrow> 'b" where |
19 "Ifup f Ibottom = \<bottom>" |
19 "Ifup f Ibottom = \<bottom>" |
20 | "Ifup f (Iup x) = f\<cdot>x" |
20 | "Ifup f (Iup x) = f\<cdot>x" |
21 |
21 |
22 subsection {* Ordering on lifted cpo *} |
22 subsection \<open>Ordering on lifted cpo\<close> |
23 |
23 |
24 instantiation u :: (cpo) below |
24 instantiation u :: (cpo) below |
25 begin |
25 begin |
26 |
26 |
27 definition |
27 definition |
39 by (simp add: below_up_def) |
39 by (simp add: below_up_def) |
40 |
40 |
41 lemma Iup_below [iff]: "(Iup x \<sqsubseteq> Iup y) = (x \<sqsubseteq> y)" |
41 lemma Iup_below [iff]: "(Iup x \<sqsubseteq> Iup y) = (x \<sqsubseteq> y)" |
42 by (simp add: below_up_def) |
42 by (simp add: below_up_def) |
43 |
43 |
44 subsection {* Lifted cpo is a partial order *} |
44 subsection \<open>Lifted cpo is a partial order\<close> |
45 |
45 |
46 instance u :: (cpo) po |
46 instance u :: (cpo) po |
47 proof |
47 proof |
48 fix x :: "'a u" |
48 fix x :: "'a u" |
49 show "x \<sqsubseteq> x" |
49 show "x \<sqsubseteq> x" |
58 assume "x \<sqsubseteq> y" "y \<sqsubseteq> z" thus "x \<sqsubseteq> z" |
58 assume "x \<sqsubseteq> y" "y \<sqsubseteq> z" thus "x \<sqsubseteq> z" |
59 unfolding below_up_def |
59 unfolding below_up_def |
60 by (auto split: u.split_asm intro: below_trans) |
60 by (auto split: u.split_asm intro: below_trans) |
61 qed |
61 qed |
62 |
62 |
63 subsection {* Lifted cpo is a cpo *} |
63 subsection \<open>Lifted cpo is a cpo\<close> |
64 |
64 |
65 lemma is_lub_Iup: |
65 lemma is_lub_Iup: |
66 "range S <<| x \<Longrightarrow> range (\<lambda>i. Iup (S i)) <<| Iup x" |
66 "range S <<| x \<Longrightarrow> range (\<lambda>i. Iup (S i)) <<| Iup x" |
67 unfolding is_lub_def is_ub_def ball_simps |
67 unfolding is_lub_def is_ub_def ball_simps |
68 by (auto simp add: below_up_def split: u.split) |
68 by (auto simp add: below_up_def split: u.split) |
115 assume "range S <<| Iup (\<Squnion>i. A i)" |
115 assume "range S <<| Iup (\<Squnion>i. A i)" |
116 thus ?thesis .. |
116 thus ?thesis .. |
117 qed |
117 qed |
118 qed |
118 qed |
119 |
119 |
120 subsection {* Lifted cpo is pointed *} |
120 subsection \<open>Lifted cpo is pointed\<close> |
121 |
121 |
122 instance u :: (cpo) pcpo |
122 instance u :: (cpo) pcpo |
123 by intro_classes fast |
123 by intro_classes fast |
124 |
124 |
125 text {* for compatibility with old HOLCF-Version *} |
125 text \<open>for compatibility with old HOLCF-Version\<close> |
126 lemma inst_up_pcpo: "\<bottom> = Ibottom" |
126 lemma inst_up_pcpo: "\<bottom> = Ibottom" |
127 by (rule minimal_up [THEN bottomI, symmetric]) |
127 by (rule minimal_up [THEN bottomI, symmetric]) |
128 |
128 |
129 subsection {* Continuity of \emph{Iup} and \emph{Ifup} *} |
129 subsection \<open>Continuity of \emph{Iup} and \emph{Ifup}\<close> |
130 |
130 |
131 text {* continuity for @{term Iup} *} |
131 text \<open>continuity for @{term Iup}\<close> |
132 |
132 |
133 lemma cont_Iup: "cont Iup" |
133 lemma cont_Iup: "cont Iup" |
134 apply (rule contI) |
134 apply (rule contI) |
135 apply (rule is_lub_Iup) |
135 apply (rule is_lub_Iup) |
136 apply (erule cpo_lubI) |
136 apply (erule cpo_lubI) |
137 done |
137 done |
138 |
138 |
139 text {* continuity for @{term Ifup} *} |
139 text \<open>continuity for @{term Ifup}\<close> |
140 |
140 |
141 lemma cont_Ifup1: "cont (\<lambda>f. Ifup f x)" |
141 lemma cont_Ifup1: "cont (\<lambda>f. Ifup f x)" |
142 by (induct x, simp_all) |
142 by (induct x, simp_all) |
143 |
143 |
144 lemma monofun_Ifup2: "monofun (\<lambda>x. Ifup f x)" |
144 lemma monofun_Ifup2: "monofun (\<lambda>x. Ifup f x)" |
164 using Y' by (rule lub_range_shift) |
164 using Y' by (rule lub_range_shift) |
165 finally show ?thesis by simp |
165 finally show ?thesis by simp |
166 qed simp |
166 qed simp |
167 qed (rule monofun_Ifup2) |
167 qed (rule monofun_Ifup2) |
168 |
168 |
169 subsection {* Continuous versions of constants *} |
169 subsection \<open>Continuous versions of constants\<close> |
170 |
170 |
171 definition |
171 definition |
172 up :: "'a \<rightarrow> 'a u" where |
172 up :: "'a \<rightarrow> 'a u" where |
173 "up = (\<Lambda> x. Iup x)" |
173 "up = (\<Lambda> x. Iup x)" |
174 |
174 |
179 translations |
179 translations |
180 "case l of XCONST up\<cdot>x \<Rightarrow> t" == "CONST fup\<cdot>(\<Lambda> x. t)\<cdot>l" |
180 "case l of XCONST up\<cdot>x \<Rightarrow> t" == "CONST fup\<cdot>(\<Lambda> x. t)\<cdot>l" |
181 "case l of (XCONST up :: 'a)\<cdot>x \<Rightarrow> t" => "CONST fup\<cdot>(\<Lambda> x. t)\<cdot>l" |
181 "case l of (XCONST up :: 'a)\<cdot>x \<Rightarrow> t" => "CONST fup\<cdot>(\<Lambda> x. t)\<cdot>l" |
182 "\<Lambda>(XCONST up\<cdot>x). t" == "CONST fup\<cdot>(\<Lambda> x. t)" |
182 "\<Lambda>(XCONST up\<cdot>x). t" == "CONST fup\<cdot>(\<Lambda> x. t)" |
183 |
183 |
184 text {* continuous versions of lemmas for @{typ "('a)u"} *} |
184 text \<open>continuous versions of lemmas for @{typ "('a)u"}\<close> |
185 |
185 |
186 lemma Exh_Up: "z = \<bottom> \<or> (\<exists>x. z = up\<cdot>x)" |
186 lemma Exh_Up: "z = \<bottom> \<or> (\<exists>x. z = up\<cdot>x)" |
187 apply (induct z) |
187 apply (induct z) |
188 apply (simp add: inst_up_pcpo) |
188 apply (simp add: inst_up_pcpo) |
189 apply (simp add: up_def cont_Iup) |
189 apply (simp add: up_def cont_Iup) |
213 |
213 |
214 lemma up_induct [case_names bottom up, induct type: u]: |
214 lemma up_induct [case_names bottom up, induct type: u]: |
215 "\<lbrakk>P \<bottom>; \<And>x. P (up\<cdot>x)\<rbrakk> \<Longrightarrow> P x" |
215 "\<lbrakk>P \<bottom>; \<And>x. P (up\<cdot>x)\<rbrakk> \<Longrightarrow> P x" |
216 by (cases x, simp_all) |
216 by (cases x, simp_all) |
217 |
217 |
218 text {* lifting preserves chain-finiteness *} |
218 text \<open>lifting preserves chain-finiteness\<close> |
219 |
219 |
220 lemma up_chain_cases: |
220 lemma up_chain_cases: |
221 assumes Y: "chain Y" obtains "\<forall>i. Y i = \<bottom>" |
221 assumes Y: "chain Y" obtains "\<forall>i. Y i = \<bottom>" |
222 | A k where "\<forall>i. up\<cdot>(A i) = Y (i + k)" and "chain A" and "(\<Squnion>i. Y i) = up\<cdot>(\<Squnion>i. A i)" |
222 | A k where "\<forall>i. up\<cdot>(A i) = Y (i + k)" and "chain A" and "(\<Squnion>i. Y i) = up\<cdot>(\<Squnion>i. A i)" |
223 apply (rule up_chain_lemma [OF Y]) |
223 apply (rule up_chain_lemma [OF Y]) |
245 apply intro_classes |
245 apply intro_classes |
246 apply (erule compact_imp_max_in_chain) |
246 apply (erule compact_imp_max_in_chain) |
247 apply (rule_tac p="\<Squnion>i. Y i" in upE, simp_all) |
247 apply (rule_tac p="\<Squnion>i. Y i" in upE, simp_all) |
248 done |
248 done |
249 |
249 |
250 text {* properties of fup *} |
250 text \<open>properties of fup\<close> |
251 |
251 |
252 lemma fup1 [simp]: "fup\<cdot>f\<cdot>\<bottom> = \<bottom>" |
252 lemma fup1 [simp]: "fup\<cdot>f\<cdot>\<bottom> = \<bottom>" |
253 by (simp add: fup_def cont_Ifup1 cont_Ifup2 inst_up_pcpo cont2cont_LAM) |
253 by (simp add: fup_def cont_Ifup1 cont_Ifup2 inst_up_pcpo cont2cont_LAM) |
254 |
254 |
255 lemma fup2 [simp]: "fup\<cdot>f\<cdot>(up\<cdot>x) = f\<cdot>x" |
255 lemma fup2 [simp]: "fup\<cdot>f\<cdot>(up\<cdot>x) = f\<cdot>x" |