48 by (cases xs, simp_all) |
48 by (cases xs, simp_all) |
49 |
49 |
50 lemma below_Nil_iff [simp]: "xs \<sqsubseteq> [] \<longleftrightarrow> xs = []" |
50 lemma below_Nil_iff [simp]: "xs \<sqsubseteq> [] \<longleftrightarrow> xs = []" |
51 by (cases xs, simp_all) |
51 by (cases xs, simp_all) |
52 |
52 |
|
53 lemma list_below_induct [consumes 1, case_names Nil Cons]: |
|
54 assumes "xs \<sqsubseteq> ys" |
|
55 assumes 1: "P [] []" |
|
56 assumes 2: "\<And>x y xs ys. \<lbrakk>x \<sqsubseteq> y; xs \<sqsubseteq> ys; P xs ys\<rbrakk> \<Longrightarrow> P (x # xs) (y # ys)" |
|
57 shows "P xs ys" |
|
58 using `xs \<sqsubseteq> ys` |
|
59 proof (induct xs arbitrary: ys) |
|
60 case Nil thus ?case by (simp add: 1) |
|
61 next |
|
62 case (Cons x xs) thus ?case by (cases ys, simp_all add: 2) |
|
63 qed |
|
64 |
|
65 lemma list_below_cases: |
|
66 assumes "xs \<sqsubseteq> ys" |
|
67 obtains "xs = []" and "ys = []" | |
|
68 x y xs' ys' where "xs = x # xs'" and "ys = y # ys'" |
|
69 using assms by (cases xs, simp, cases ys, auto) |
|
70 |
53 text "Thanks to Joachim Breitner" |
71 text "Thanks to Joachim Breitner" |
54 |
72 |
55 lemma list_Cons_below: |
73 lemma list_Cons_below: |
56 assumes "a # as \<sqsubseteq> xs" |
74 assumes "a # as \<sqsubseteq> xs" |
57 obtains b and bs where "a \<sqsubseteq> b" and "as \<sqsubseteq> bs" and "xs = b # bs" |
75 obtains b and bs where "a \<sqsubseteq> b" and "as \<sqsubseteq> bs" and "xs = b # bs" |
75 by (rule chainI, rule tl_mono, erule chainE) |
93 by (rule chainI, rule tl_mono, erule chainE) |
76 |
94 |
77 lemma below_same_length: "xs \<sqsubseteq> ys \<Longrightarrow> length xs = length ys" |
95 lemma below_same_length: "xs \<sqsubseteq> ys \<Longrightarrow> length xs = length ys" |
78 unfolding below_list_def by (rule list_all2_lengthD) |
96 unfolding below_list_def by (rule list_all2_lengthD) |
79 |
97 |
|
98 lemma list_chain_induct [consumes 1, case_names Nil Cons]: |
|
99 assumes "chain S" |
|
100 assumes 1: "P (\<lambda>i. [])" |
|
101 assumes 2: "\<And>A B. chain A \<Longrightarrow> chain B \<Longrightarrow> P B \<Longrightarrow> P (\<lambda>i. A i # B i)" |
|
102 shows "P S" |
|
103 using `chain S` |
|
104 proof (induct "S 0" arbitrary: S) |
|
105 case Nil |
|
106 have "\<forall>i. S 0 \<sqsubseteq> S i" by (simp add: chain_mono [OF `chain S`]) |
|
107 with Nil have "\<forall>i. S i = []" by simp |
|
108 thus ?case by (simp add: 1) |
|
109 next |
|
110 case (Cons x xs) |
|
111 have "\<forall>i. S 0 \<sqsubseteq> S i" by (simp add: chain_mono [OF `chain S`]) |
|
112 hence *: "\<forall>i. S i \<noteq> []" by (rule all_forward, insert Cons) auto |
|
113 have "chain (\<lambda>i. hd (S i))" and "chain (\<lambda>i. tl (S i))" |
|
114 using `chain S` by simp_all |
|
115 moreover have "P (\<lambda>i. tl (S i))" |
|
116 using `chain S` and `x # xs = S 0` [symmetric] |
|
117 by (simp add: Cons(1)) |
|
118 ultimately have "P (\<lambda>i. hd (S i) # tl (S i))" |
|
119 by (rule 2) |
|
120 thus "P S" by (simp add: *) |
|
121 qed |
|
122 |
80 lemma list_chain_cases: |
123 lemma list_chain_cases: |
81 assumes S: "chain S" |
124 assumes S: "chain S" |
82 obtains "\<forall>i. S i = []" | |
125 obtains "S = (\<lambda>i. [])" | |
83 A B where "chain A" and "chain B" and "\<forall>i. S i = A i # B i" |
126 A B where "chain A" and "chain B" and "S = (\<lambda>i. A i # B i)" |
84 proof (cases "S 0") |
127 using S by (induct rule: list_chain_induct) simp_all |
85 case Nil |
|
86 have "\<forall>i. S 0 \<sqsubseteq> S i" by (simp add: chain_mono [OF S]) |
|
87 with Nil have "\<forall>i. S i = []" by simp |
|
88 thus ?thesis .. |
|
89 next |
|
90 case (Cons x xs) |
|
91 have "\<forall>i. S 0 \<sqsubseteq> S i" by (simp add: chain_mono [OF S]) |
|
92 hence *: "\<forall>i. S i \<noteq> []" by (rule all_forward) (auto simp add: Cons) |
|
93 let ?A = "\<lambda>i. hd (S i)" |
|
94 let ?B = "\<lambda>i. tl (S i)" |
|
95 from S have "chain ?A" and "chain ?B" by simp_all |
|
96 moreover have "\<forall>i. S i = ?A i # ?B i" by (simp add: *) |
|
97 ultimately show ?thesis .. |
|
98 qed |
|
99 |
128 |
100 subsection {* Lists are a complete partial order *} |
129 subsection {* Lists are a complete partial order *} |
101 |
130 |
102 lemma is_lub_Cons: |
131 lemma is_lub_Cons: |
103 assumes A: "range A <<| x" |
132 assumes A: "range A <<| x" |
105 shows "range (\<lambda>i. A i # B i) <<| x # xs" |
134 shows "range (\<lambda>i. A i # B i) <<| x # xs" |
106 using assms |
135 using assms |
107 unfolding is_lub_def is_ub_def Ball_def [symmetric] |
136 unfolding is_lub_def is_ub_def Ball_def [symmetric] |
108 by (clarsimp, case_tac u, simp_all) |
137 by (clarsimp, case_tac u, simp_all) |
109 |
138 |
110 lemma list_cpo_lemma: |
|
111 fixes S :: "nat \<Rightarrow> 'a::cpo list" |
|
112 assumes "chain S" and "\<forall>i. length (S i) = n" |
|
113 shows "\<exists>x. range S <<| x" |
|
114 using assms |
|
115 apply (induct n arbitrary: S) |
|
116 apply (subgoal_tac "S = (\<lambda>i. [])") |
|
117 apply (fast intro: lub_const) |
|
118 apply (simp add: fun_eq_iff) |
|
119 apply (drule_tac x="\<lambda>i. tl (S i)" in meta_spec, clarsimp) |
|
120 apply (rule_tac x="(\<Squnion>i. hd (S i)) # x" in exI) |
|
121 apply (subgoal_tac "range (\<lambda>i. hd (S i) # tl (S i)) = range S") |
|
122 apply (erule subst) |
|
123 apply (rule is_lub_Cons) |
|
124 apply (rule thelubE [OF _ refl]) |
|
125 apply (erule ch2ch_hd) |
|
126 apply assumption |
|
127 apply (rule_tac f="\<lambda>S. range S" in arg_cong) |
|
128 apply (rule ext) |
|
129 apply (rule hd_Cons_tl) |
|
130 apply (drule_tac x=i in spec, auto) |
|
131 done |
|
132 |
|
133 instance list :: (cpo) cpo |
139 instance list :: (cpo) cpo |
134 proof |
140 proof |
135 fix S :: "nat \<Rightarrow> 'a list" |
141 fix S :: "nat \<Rightarrow> 'a list" |
136 assume "chain S" |
142 assume "chain S" thus "\<exists>x. range S <<| x" |
137 hence "\<forall>i. S 0 \<sqsubseteq> S i" by (simp add: chain_mono) |
143 proof (induct rule: list_chain_induct) |
138 hence "\<forall>i. length (S i) = length (S 0)" |
144 case Nil thus ?case by (auto intro: lub_const) |
139 by (fast intro: below_same_length [symmetric]) |
145 next |
140 with `chain S` show "\<exists>x. range S <<| x" |
146 case (Cons A B) thus ?case by (auto intro: is_lub_Cons cpo_lubI) |
141 by (rule list_cpo_lemma) |
147 qed |
142 qed |
148 qed |
143 |
149 |
144 subsection {* Continuity of list operations *} |
150 subsection {* Continuity of list operations *} |
145 |
151 |
146 lemma cont2cont_Cons [simp, cont2cont]: |
152 lemma cont2cont_Cons [simp, cont2cont]: |
194 assumes "cont (\<lambda>x. f1 x)" |
200 assumes "cont (\<lambda>x. f1 x)" |
195 assumes "\<And>y ys. cont (\<lambda>x. f2 x y ys)" |
201 assumes "\<And>y ys. cont (\<lambda>x. f2 x y ys)" |
196 shows "cont (\<lambda>x. case l of [] \<Rightarrow> f1 x | y # ys \<Rightarrow> f2 x y ys)" |
202 shows "cont (\<lambda>x. case l of [] \<Rightarrow> f1 x | y # ys \<Rightarrow> f2 x y ys)" |
197 using assms by (cases l) auto |
203 using assms by (cases l) auto |
198 |
204 |
|
205 text {* Lemma for proving continuity of recursive list functions: *} |
|
206 |
|
207 lemma list_contI: |
|
208 fixes f :: "'a::cpo list \<Rightarrow> 'b::cpo" |
|
209 assumes f: "\<And>x xs. f (x # xs) = g x xs (f xs)" |
|
210 assumes g1: "\<And>xs y. cont (\<lambda>x. g x xs y)" |
|
211 assumes g2: "\<And>x y. cont (\<lambda>xs. g x xs y)" |
|
212 assumes g3: "\<And>x xs. cont (\<lambda>y. g x xs y)" |
|
213 shows "cont f" |
|
214 proof (rule contI2) |
|
215 obtain h where h: "\<And>x xs y. g x xs y = h\<cdot>x\<cdot>xs\<cdot>y" |
|
216 proof |
|
217 fix x xs y show "g x xs y = (\<Lambda> x xs y. g x xs y)\<cdot>x\<cdot>xs\<cdot>y" |
|
218 by (simp add: cont2cont_LAM g1 g2 g3) |
|
219 qed |
|
220 show mono: "monofun f" |
|
221 apply (rule monofunI) |
|
222 apply (erule list_below_induct) |
|
223 apply simp |
|
224 apply (simp add: f h monofun_cfun) |
|
225 done |
|
226 fix Y :: "nat \<Rightarrow> 'a list" |
|
227 assume "chain Y" thus "f (\<Squnion>i. Y i) \<sqsubseteq> (\<Squnion>i. f (Y i))" |
|
228 apply (induct rule: list_chain_induct) |
|
229 apply simp |
|
230 apply (simp add: lub_Cons f h) |
|
231 apply (simp add: contlub_cfun [symmetric] ch2ch_monofun [OF mono]) |
|
232 apply (simp add: monofun_cfun) |
|
233 done |
|
234 qed |
|
235 |
199 text {* There are probably lots of other list operations that also |
236 text {* There are probably lots of other list operations that also |
200 deserve to have continuity lemmas. I'll add more as they are |
237 deserve to have continuity lemmas. I'll add more as they are |
201 needed. *} |
238 needed. *} |
202 |
239 |
203 subsection {* Using lists with fixrec *} |
240 subsection {* Using lists with fixrec *} |