1 (* Title: HOLCF/FunCpo.thy
2 Author: Franz Regensburger
5 header {* Class instances for the full function space *}
11 subsection {* Full function space is a partial order *}
13 instantiation "fun" :: (type, below) below
17 below_fun_def: "(op \<sqsubseteq>) \<equiv> (\<lambda>f g. \<forall>x. f x \<sqsubseteq> g x)"
22 instance "fun" :: (type, po) po
24 fix f :: "'a \<Rightarrow> 'b"
25 show "f \<sqsubseteq> f"
26 by (simp add: below_fun_def)
28 fix f g :: "'a \<Rightarrow> 'b"
29 assume "f \<sqsubseteq> g" and "g \<sqsubseteq> f" thus "f = g"
30 by (simp add: below_fun_def expand_fun_eq below_antisym)
32 fix f g h :: "'a \<Rightarrow> 'b"
33 assume "f \<sqsubseteq> g" and "g \<sqsubseteq> h" thus "f \<sqsubseteq> h"
34 unfolding below_fun_def by (fast elim: below_trans)
37 text {* make the symbol @{text "<<"} accessible for type fun *}
39 lemma expand_fun_below: "(f \<sqsubseteq> g) = (\<forall>x. f x \<sqsubseteq> g x)"
40 by (simp add: below_fun_def)
42 lemma below_fun_ext: "(\<And>x. f x \<sqsubseteq> g x) \<Longrightarrow> f \<sqsubseteq> g"
43 by (simp add: below_fun_def)
45 subsection {* Full function space is chain complete *}
47 text {* function application is monotone *}
49 lemma monofun_app: "monofun (\<lambda>f. f x)"
50 by (rule monofunI, simp add: below_fun_def)
52 text {* chains of functions yield chains in the po range *}
54 lemma ch2ch_fun: "chain S \<Longrightarrow> chain (\<lambda>i. S i x)"
55 by (simp add: chain_def below_fun_def)
57 lemma ch2ch_lambda: "(\<And>x. chain (\<lambda>i. S i x)) \<Longrightarrow> chain S"
58 by (simp add: chain_def below_fun_def)
60 text {* upper bounds of function chains yield upper bound in the po range *}
63 "range S <| u \<Longrightarrow> range (\<lambda>i. S i x) <| u x"
64 by (auto simp add: is_ub_def below_fun_def)
66 text {* Type @{typ "'a::type => 'b::cpo"} is chain complete *}
69 assumes f: "\<And>x. range (\<lambda>i. Y i x) <<| f x"
72 apply (rule ub_rangeI)
73 apply (rule below_fun_ext)
74 apply (rule is_ub_lub [OF f])
75 apply (rule below_fun_ext)
76 apply (rule is_lub_lub [OF f])
77 apply (erule ub2ub_fun)
81 "chain (S::nat \<Rightarrow> 'a::type \<Rightarrow> 'b::cpo)
82 \<Longrightarrow> range S <<| (\<lambda>x. \<Squnion>i. S i x)"
83 apply (rule is_lub_lambda)
85 apply (erule ch2ch_fun)
89 "chain (S::nat \<Rightarrow> 'a::type \<Rightarrow> 'b::cpo)
90 \<Longrightarrow> (\<Squnion>i. S i) = (\<lambda>x. \<Squnion>i. S i x)"
91 by (rule lub_fun [THEN thelubI])
94 "chain (S::nat \<Rightarrow> 'a::type \<Rightarrow> 'b::cpo) \<Longrightarrow> \<exists>x. range S <<| x"
95 by (rule exI, erule lub_fun)
97 instance "fun" :: (type, cpo) cpo
98 by intro_classes (rule cpo_fun)
100 instance "fun" :: (finite, finite_po) finite_po ..
102 instance "fun" :: (type, discrete_cpo) discrete_cpo
104 fix f g :: "'a \<Rightarrow> 'b"
105 show "f \<sqsubseteq> g \<longleftrightarrow> f = g"
106 unfolding expand_fun_below expand_fun_eq
110 text {* chain-finite function spaces *}
112 lemma maxinch2maxinch_lambda:
113 "(\<And>x. max_in_chain n (\<lambda>i. S i x)) \<Longrightarrow> max_in_chain n S"
114 unfolding max_in_chain_def expand_fun_eq by simp
117 "\<lbrakk>max_in_chain i Y; i \<le> j\<rbrakk> \<Longrightarrow> max_in_chain j Y"
118 unfolding max_in_chain_def
119 proof (intro allI impI)
121 assume Y: "\<forall>n\<ge>i. Y i = Y n"
122 assume ij: "i \<le> j"
123 assume jk: "j \<le> k"
124 from ij jk have ik: "i \<le> k" by simp
125 from Y ij have Yij: "Y i = Y j" by simp
126 from Y ik have Yik: "Y i = Y k" by simp
127 from Yij Yik show "Y j = Y k" by auto
130 instance "fun" :: (finite, chfin) chfin
132 fix Y :: "nat \<Rightarrow> 'a \<Rightarrow> 'b"
133 let ?n = "\<lambda>x. LEAST n. max_in_chain n (\<lambda>i. Y i x)"
135 hence "\<And>x. chain (\<lambda>i. Y i x)"
137 hence "\<And>x. \<exists>n. max_in_chain n (\<lambda>i. Y i x)"
139 hence "\<And>x. max_in_chain (?n x) (\<lambda>i. Y i x)"
141 hence "\<And>x. max_in_chain (Max (range ?n)) (\<lambda>i. Y i x)"
142 by (rule maxinch_mono [OF _ Max_ge], simp_all)
143 hence "max_in_chain (Max (range ?n)) Y"
144 by (rule maxinch2maxinch_lambda)
145 thus "\<exists>n. max_in_chain n Y" ..
148 subsection {* Full function space is pointed *}
150 lemma minimal_fun: "(\<lambda>x. \<bottom>) \<sqsubseteq> f"
151 by (simp add: below_fun_def)
153 lemma least_fun: "\<exists>x::'a::type \<Rightarrow> 'b::pcpo. \<forall>y. x \<sqsubseteq> y"
154 apply (rule_tac x = "\<lambda>x. \<bottom>" in exI)
155 apply (rule minimal_fun [THEN allI])
158 instance "fun" :: (type, pcpo) pcpo
159 by intro_classes (rule least_fun)
161 text {* for compatibility with old HOLCF-Version *}
162 lemma inst_fun_pcpo: "\<bottom> = (\<lambda>x. \<bottom>)"
163 by (rule minimal_fun [THEN UU_I, symmetric])
165 text {* function application is strict in the left argument *}
166 lemma app_strict [simp]: "\<bottom> x = \<bottom>"
167 by (simp add: inst_fun_pcpo)
170 The following results are about application for functions in @{typ "'a=>'b"}
173 lemma monofun_fun_fun: "f \<sqsubseteq> g \<Longrightarrow> f x \<sqsubseteq> g x"
174 by (simp add: below_fun_def)
176 lemma monofun_fun_arg: "\<lbrakk>monofun f; x \<sqsubseteq> y\<rbrakk> \<Longrightarrow> f x \<sqsubseteq> f y"
179 lemma monofun_fun: "\<lbrakk>monofun f; monofun g; f \<sqsubseteq> g; x \<sqsubseteq> y\<rbrakk> \<Longrightarrow> f x \<sqsubseteq> g y"
180 by (rule below_trans [OF monofun_fun_arg monofun_fun_fun])
182 subsection {* Propagation of monotonicity and continuity *}
184 text {* the lub of a chain of monotone functions is monotone *}
186 lemma monofun_lub_fun:
187 "\<lbrakk>chain (F::nat \<Rightarrow> 'a \<Rightarrow> 'b::cpo); \<forall>i. monofun (F i)\<rbrakk>
188 \<Longrightarrow> monofun (\<Squnion>i. F i)"
189 apply (rule monofunI)
190 apply (simp add: thelub_fun)
191 apply (rule lub_mono)
192 apply (erule ch2ch_fun)
193 apply (erule ch2ch_fun)
194 apply (simp add: monofunE)
197 text {* the lub of a chain of continuous functions is continuous *}
200 "\<lbrakk>chain F; \<forall>i. cont (F i)\<rbrakk> \<Longrightarrow> cont (\<Squnion>i. F i)"
202 apply (erule monofun_lub_fun)
203 apply (simp add: cont2mono)
204 apply (simp add: thelub_fun cont2contlubE)
205 apply (simp add: diag_lub ch2ch_fun ch2ch_cont)
209 "\<lbrakk>chain F; \<And>i. cont (F i)\<rbrakk> \<Longrightarrow> cont (\<lambda>x. \<Squnion>i. F i x)"
210 by (simp add: thelub_fun [symmetric] cont_lub_fun)
212 lemma mono2mono_fun: "monofun f \<Longrightarrow> monofun (\<lambda>x. f x y)"
213 apply (rule monofunI)
214 apply (erule (1) monofun_fun_arg [THEN monofun_fun_fun])
217 lemma cont2cont_fun: "cont f \<Longrightarrow> cont (\<lambda>x. f x y)"
219 apply (erule cont2mono [THEN mono2mono_fun])
220 apply (simp add: cont2contlubE)
221 apply (simp add: thelub_fun ch2ch_cont)
224 text {* Note @{text "(\<lambda>x. \<lambda>y. f x y) = f"} *}
226 lemma mono2mono_lambda:
227 assumes f: "\<And>y. monofun (\<lambda>x. f x y)" shows "monofun f"
228 apply (rule monofunI)
229 apply (rule below_fun_ext)
230 apply (erule monofunE [OF f])
233 lemma cont2cont_lambda [simp]:
234 assumes f: "\<And>y. cont (\<lambda>x. f x y)" shows "cont f"
236 apply (simp add: mono2mono_lambda cont2mono f)
237 apply (rule below_fun_ext)
238 apply (simp add: thelub_fun cont2contlubE [OF f])
241 text {* What D.A.Schmidt calls continuity of abstraction; never used here *}
243 lemma contlub_lambda:
244 "(\<And>x::'a::type. chain (\<lambda>i. S i x::'b::cpo))
245 \<Longrightarrow> (\<lambda>x. \<Squnion>i. S i x) = (\<Squnion>i. (\<lambda>x. S i x))"
246 by (simp add: thelub_fun ch2ch_lambda)
248 lemma contlub_abstraction:
249 "\<lbrakk>chain Y; \<forall>y. cont (\<lambda>x.(c::'a::cpo\<Rightarrow>'b::type\<Rightarrow>'c::cpo) x y)\<rbrakk> \<Longrightarrow>
250 (\<lambda>y. \<Squnion>i. c (Y i) y) = (\<Squnion>i. (\<lambda>y. c (Y i) y))"
251 apply (rule thelub_fun [symmetric])
252 apply (simp add: ch2ch_cont)
256 "\<lbrakk>monofun f; \<forall>x. monofun (f x); monofun t\<rbrakk> \<Longrightarrow> monofun (\<lambda>x. (f x) (t x))"
257 apply (rule monofunI)
258 apply (simp add: monofun_fun monofunE)
262 "\<lbrakk>cont f; \<forall>x. cont (f x); cont t\<rbrakk> \<Longrightarrow> cont (\<lambda>x. (f x) (t x))"
263 apply (erule cont_apply [where t=t])
265 apply (erule cont2cont_fun)
268 lemmas cont2cont_app2 = cont2cont_app [rule_format]
270 lemma cont2cont_app3: "\<lbrakk>cont f; cont t\<rbrakk> \<Longrightarrow> cont (\<lambda>x. f (t x))"
271 by (rule cont2cont_app2 [OF cont_const])