12 |
12 |
13 open LList; |
13 open LList; |
14 |
14 |
15 (** Simplification **) |
15 (** Simplification **) |
16 |
16 |
17 val llist_simps = [case_Inl, case_Inr]; |
17 val llist_simps = [sum_case_Inl, sum_case_Inr]; |
18 val llist_ss = univ_ss delsimps [Pair_eq] |
18 val llist_ss = univ_ss delsimps [Pair_eq] |
19 addsimps llist_simps |
19 addsimps llist_simps |
20 addcongs [split_weak_cong, case_weak_cong] |
20 addcongs [split_weak_cong, sum_case_weak_cong] |
21 setloop (split_tac [expand_split, expand_case]); |
21 setloop (split_tac [expand_split, expand_sum_case]); |
22 |
22 |
23 (** the llist functional **) |
23 (** the llist functional **) |
24 |
24 |
25 val LList_unfold = rewrite_rule [List_Fun_def] |
25 val LList_unfold = rewrite_rule [List_Fun_def] |
26 (List_Fun_mono RS (LList_def RS def_gfp_Tarski)); |
26 (List_Fun_mono RS (LList_def RS def_gfp_Tarski)); |
78 val CONS_UN1 = result(); |
78 val CONS_UN1 = result(); |
79 |
79 |
80 goal Prod.thy "split(p, %x y.UN z.f(x,y,z)) = (UN z. split(p, %x y.f(x,y,z)))"; |
80 goal Prod.thy "split(p, %x y.UN z.f(x,y,z)) = (UN z. split(p, %x y.f(x,y,z)))"; |
81 by (simp_tac (pair_ss setloop (split_tac [expand_split])) 1); |
81 by (simp_tac (pair_ss setloop (split_tac [expand_split])) 1); |
82 val split_UN1 = result(); |
82 val split_UN1 = result(); |
83 |
83 (* Does not seem to be used |
84 goal Sum.thy "case(s, f, %y. UN z.g(y,z)) = (UN z. case(s, f, %y. g(y,z)))"; |
84 goal Sum.thy "sum_case(s,f,%y.UN z.g(y,z)) = (UN z.sum_case(s,f,%y. g(y,z)))"; |
85 by (simp_tac (sum_ss setloop (split_tac [expand_case])) 1); |
85 by (simp_tac (sum_ss setloop (split_tac [expand_sum_case])) 1); |
86 val case2_UN1 = result(); |
86 val sum_case2_UN1 = result(); |
87 |
87 *) |
88 val prems = goalw LList.thy [CONS_def] |
88 val prems = goalw LList.thy [CONS_def] |
89 "[| M<=M'; N<=N' |] ==> CONS(M,N) <= CONS(M',N')"; |
89 "[| M<=M'; N<=N' |] ==> CONS(M,N) <= CONS(M',N')"; |
90 by (REPEAT (resolve_tac ([In1_mono,Scons_mono]@prems) 1)); |
90 by (REPEAT (resolve_tac ([In1_mono,Scons_mono]@prems) 1)); |
91 val CONS_mono = result(); |
91 val CONS_mono = result(); |
92 |
92 |
95 val corec_fun_ss = llist_ss addsimps corec_fun_simps; |
95 val corec_fun_ss = llist_ss addsimps corec_fun_simps; |
96 |
96 |
97 (** The directions of the equality are proved separately **) |
97 (** The directions of the equality are proved separately **) |
98 |
98 |
99 goalw LList.thy [LList_corec_def] |
99 goalw LList.thy [LList_corec_def] |
100 "LList_corec(a,f) <= case(f(a), %u.NIL, \ |
100 "LList_corec(a,f) <= sum_case(f(a), %u.NIL, \ |
101 \ %v. split(v, %z w. CONS(z, LList_corec(w,f))))"; |
101 \ %v. split(v, %z w. CONS(z, LList_corec(w,f))))"; |
102 by (rtac UN1_least 1); |
102 by (rtac UN1_least 1); |
103 by (res_inst_tac [("n","k")] natE 1); |
103 by (res_inst_tac [("n","k")] natE 1); |
104 by (ALLGOALS (asm_simp_tac corec_fun_ss)); |
104 by (ALLGOALS (asm_simp_tac corec_fun_ss)); |
105 by (REPEAT (resolve_tac [allI, impI, subset_refl RS CONS_mono, UN1_upper] 1)); |
105 by (REPEAT (resolve_tac [allI, impI, subset_refl RS CONS_mono, UN1_upper] 1)); |
106 val LList_corec_subset1 = result(); |
106 val LList_corec_subset1 = result(); |
107 |
107 |
108 goalw LList.thy [LList_corec_def] |
108 goalw LList.thy [LList_corec_def] |
109 "case(f(a), %u.NIL, %v. split(v, %z w. CONS(z, LList_corec(w,f)))) <= \ |
109 "sum_case(f(a), %u.NIL, %v. split(v, %z w. CONS(z, LList_corec(w,f)))) <= \ |
110 \ LList_corec(a,f)"; |
110 \ LList_corec(a,f)"; |
111 by (simp_tac (corec_fun_ss addsimps [CONS_UN1]) 1); |
111 by (simp_tac (corec_fun_ss addsimps [CONS_UN1]) 1); |
112 by (safe_tac set_cs); |
112 by (safe_tac set_cs); |
113 by (ALLGOALS (res_inst_tac [("x","Suc(?k)")] UN1_I THEN' |
113 by (ALLGOALS (res_inst_tac [("x","Suc(?k)")] UN1_I THEN' |
114 asm_simp_tac corec_fun_ss)); |
114 asm_simp_tac corec_fun_ss)); |
115 val LList_corec_subset2 = result(); |
115 val LList_corec_subset2 = result(); |
116 |
116 |
117 (*the recursion equation for LList_corec -- NOT SUITABLE FOR REWRITING!*) |
117 (*the recursion equation for LList_corec -- NOT SUITABLE FOR REWRITING!*) |
118 goal LList.thy |
118 goal LList.thy |
119 "LList_corec(a,f) = case(f(a), %u. NIL, \ |
119 "LList_corec(a,f) = sum_case(f(a), %u. NIL, \ |
120 \ %v. split(v, %z w. CONS(z, LList_corec(w,f))))"; |
120 \ %v. split(v, %z w. CONS(z, LList_corec(w,f))))"; |
121 by (REPEAT (resolve_tac [equalityI, LList_corec_subset1, |
121 by (REPEAT (resolve_tac [equalityI, LList_corec_subset1, |
122 LList_corec_subset2] 1)); |
122 LList_corec_subset2] 1)); |
123 val LList_corec = result(); |
123 val LList_corec = result(); |
124 |
124 |
125 (*definitional version of same*) |
125 (*definitional version of same*) |
126 val [rew] = goal LList.thy |
126 val [rew] = goal LList.thy |
127 "[| !!x. h(x) == LList_corec(x,f) |] ==> \ |
127 "[| !!x. h(x) == LList_corec(x,f) |] ==> \ |
128 \ h(a) = case(f(a), %u.NIL, %v. split(v, %z w. CONS(z, h(w))))"; |
128 \ h(a) = sum_case(f(a), %u.NIL, %v. split(v, %z w. CONS(z, h(w))))"; |
129 by (rewtac rew); |
129 by (rewtac rew); |
130 by (rtac LList_corec 1); |
130 by (rtac LList_corec 1); |
131 val def_LList_corec = result(); |
131 val def_LList_corec = result(); |
132 |
132 |
133 (*A typical use of co-induction to show membership in the gfp. |
133 (*A typical use of co-induction to show membership in the gfp. |
145 *) |
145 *) |
146 val LList_corec_type = result(); |
146 val LList_corec_type = result(); |
147 |
147 |
148 (*Lemma for the proof of llist_corec*) |
148 (*Lemma for the proof of llist_corec*) |
149 goal LList.thy |
149 goal LList.thy |
150 "LList_corec(a, %z. case(f(z),Inl,%x. split(x,%v w. Inr(<Leaf(v),w>)))) : \ |
150 "LList_corec(a, %z.sum_case(f(z),Inl,%x.split(x,%v w.Inr(<Leaf(v),w>)))) : \ |
151 \ LList(range(Leaf))"; |
151 \ LList(range(Leaf))"; |
152 by (res_inst_tac [("X", "range(%x.LList_corec(x,?g))")] LList_coinduct 1); |
152 by (res_inst_tac [("X", "range(%x.LList_corec(x,?g))")] LList_coinduct 1); |
153 by (rtac rangeI 1); |
153 by (rtac rangeI 1); |
154 by (safe_tac set_cs); |
154 by (safe_tac set_cs); |
155 by (stac LList_corec 1); |
155 by (stac LList_corec 1); |
156 (*nested "case"; requires an explicit split*) |
156 (*nested "sum_case"; requires an explicit split*) |
157 by (res_inst_tac [("s", "f(xa)")] sumE 1); |
157 by (res_inst_tac [("s", "f(xa)")] sumE 1); |
158 by (asm_simp_tac (univ_ss addsimps (llist_simps@[List_Fun_NIL_I])) 1); |
158 by (asm_simp_tac (univ_ss addsimps (llist_simps@[List_Fun_NIL_I])) 1); |
159 by (asm_simp_tac (univ_ss addsimps (llist_simps@[List_Fun_CONS_I, range_eqI]) |
159 by (asm_simp_tac (univ_ss addsimps (llist_simps@[List_Fun_CONS_I, range_eqI]) |
160 setloop (split_tac [expand_split])) 1); |
160 setloop (split_tac [expand_split])) 1); |
161 (* FIXME: can the selection of the case split be automated? |
161 (* FIXME: can the selection of the case split be automated? |
256 |
256 |
257 (*** Finality of LList(A): Uniqueness of functions defined by corecursion ***) |
257 (*** Finality of LList(A): Uniqueness of functions defined by corecursion ***) |
258 |
258 |
259 (*abstract proof using a bisimulation*) |
259 (*abstract proof using a bisimulation*) |
260 val [prem1,prem2] = goal LList.thy |
260 val [prem1,prem2] = goal LList.thy |
261 "[| !!x. h1(x) = case(f(x), %u.NIL, %v. split(v, %z w. CONS(z,h1(w)))); \ |
261 "[| !!x. h1(x) = sum_case(f(x), %u.NIL, %v. split(v, %z w. CONS(z,h1(w)))); \ |
262 \ !!x. h2(x) = case(f(x), %u.NIL, %v. split(v, %z w. CONS(z,h2(w)))) |] \ |
262 \ !!x. h2(x) = sum_case(f(x), %u.NIL, %v. split(v, %z w. CONS(z,h2(w)))) |]\ |
263 \ ==> h1=h2"; |
263 \ ==> h1=h2"; |
264 by (rtac ext 1); |
264 by (rtac ext 1); |
265 (*next step avoids an unknown (and flexflex pair) in simplification*) |
265 (*next step avoids an unknown (and flexflex pair) in simplification*) |
266 by (res_inst_tac [("A", "{u.True}"), |
266 by (res_inst_tac [("A", "{u.True}"), |
267 ("r", "range(%u. <h1(u),h2(u)>)")] LList_equalityI 1); |
267 ("r", "range(%u. <h1(u),h2(u)>)")] LList_equalityI 1); |
275 by (ASM_SIMP_TAC (llist_ss addsimps [LListD_Fun_NIL_I, rangeI, |
275 by (ASM_SIMP_TAC (llist_ss addsimps [LListD_Fun_NIL_I, rangeI, |
276 CollectI RS LListD_Fun_CONS_I]) 1);*) |
276 CollectI RS LListD_Fun_CONS_I]) 1);*) |
277 val LList_corec_unique = result(); |
277 val LList_corec_unique = result(); |
278 |
278 |
279 val [prem] = goal LList.thy |
279 val [prem] = goal LList.thy |
280 "[| !!x. h(x) = case(f(x), %u.NIL, %v. split(v, %z w. CONS(z,h(w)))) |] \ |
280 "[| !!x. h(x) = sum_case(f(x), %u.NIL, %v. split(v, %z w. CONS(z,h(w)))) |] \ |
281 \ ==> h = (%x.LList_corec(x,f))"; |
281 \ ==> h = (%x.LList_corec(x,f))"; |
282 by (rtac (LList_corec RS (prem RS LList_corec_unique)) 1); |
282 by (rtac (LList_corec RS (prem RS LList_corec_unique)) 1); |
283 val equals_LList_corec = result(); |
283 val equals_LList_corec = result(); |
284 |
284 |
285 |
285 |
293 "ntrunc(Suc(Suc(k)), CONS(M,N)) = CONS (ntrunc(k,M), ntrunc(k,N))"; |
293 "ntrunc(Suc(Suc(k)), CONS(M,N)) = CONS (ntrunc(k,M), ntrunc(k,N))"; |
294 by (simp_tac (HOL_ss addsimps [ntrunc_Scons,ntrunc_In1]) 1); |
294 by (simp_tac (HOL_ss addsimps [ntrunc_Scons,ntrunc_In1]) 1); |
295 val ntrunc_CONS = result(); |
295 val ntrunc_CONS = result(); |
296 |
296 |
297 val [prem1,prem2] = goal LList.thy |
297 val [prem1,prem2] = goal LList.thy |
298 "[| !!x. h1(x) = case(f(x), %u.NIL, %v. split(v, %z w. CONS(z,h1(w)))); \ |
298 "[| !!x. h1(x) = sum_case(f(x), %u.NIL, %v. split(v, %z w. CONS(z,h1(w)))); \ |
299 \ !!x. h2(x) = case(f(x), %u.NIL, %v. split(v, %z w. CONS(z,h2(w)))) |] \ |
299 \ !!x. h2(x) = sum_case(f(x), %u.NIL, %v. split(v, %z w. CONS(z,h2(w)))) |]\ |
300 \ ==> h1=h2"; |
300 \ ==> h1=h2"; |
301 by (rtac (ntrunc_equality RS ext) 1); |
301 by (rtac (ntrunc_equality RS ext) 1); |
302 by (res_inst_tac [("x", "x")] spec 1); |
302 by (res_inst_tac [("x", "x")] spec 1); |
303 by (res_inst_tac [("n", "k")] less_induct 1); |
303 by (res_inst_tac [("n", "k")] less_induct 1); |
304 by (rtac allI 1); |
304 by (rtac allI 1); |
305 by (stac prem1 1); |
305 by (stac prem1 1); |
306 by (stac prem2 1); |
306 by (stac prem2 1); |
307 by (simp_tac (sum_ss setloop (split_tac [expand_split,expand_case])) 1); |
307 by (simp_tac (sum_ss setloop (split_tac [expand_split,expand_sum_case])) 1); |
308 by (strip_tac 1); |
308 by (strip_tac 1); |
309 by (res_inst_tac [("n", "n")] natE 1); |
309 by (res_inst_tac [("n", "n")] natE 1); |
310 by (res_inst_tac [("n", "xc")] natE 2); |
310 by (res_inst_tac [("n", "xc")] natE 2); |
311 by (ALLGOALS(asm_simp_tac(nat_ss addsimps |
311 by (ALLGOALS(asm_simp_tac(nat_ss addsimps |
312 [ntrunc_0,ntrunc_one_CONS,ntrunc_CONS]))); |
312 [ntrunc_0,ntrunc_one_CONS,ntrunc_CONS]))); |
614 val llistE = result(); |
614 val llistE = result(); |
615 |
615 |
616 (** llist_corec: corecursion for 'a llist **) |
616 (** llist_corec: corecursion for 'a llist **) |
617 |
617 |
618 goalw LList.thy [llist_corec_def,LNil_def,LCons_def] |
618 goalw LList.thy [llist_corec_def,LNil_def,LCons_def] |
619 "llist_corec(a,f) = case(f(a), %u. LNil, \ |
619 "llist_corec(a,f) = sum_case(f(a), %u. LNil, \ |
620 \ %v. split(v, %z w. LCons(z, llist_corec(w,f))))"; |
620 \ %v. split(v, %z w. LCons(z, llist_corec(w,f))))"; |
621 by (stac LList_corec 1); |
621 by (stac LList_corec 1); |
622 by (res_inst_tac [("s","f(a)")] sumE 1); |
622 by (res_inst_tac [("s","f(a)")] sumE 1); |
623 by (asm_simp_tac (llist_ss addsimps [LList_corec_type2,Abs_LList_inverse]) 1); |
623 by (asm_simp_tac (llist_ss addsimps [LList_corec_type2,Abs_LList_inverse]) 1); |
624 by (res_inst_tac [("p","y")] PairE 1); |
624 by (res_inst_tac [("p","y")] PairE 1); |
628 val llist_corec = result(); |
628 val llist_corec = result(); |
629 |
629 |
630 (*definitional version of same*) |
630 (*definitional version of same*) |
631 val [rew] = goal LList.thy |
631 val [rew] = goal LList.thy |
632 "[| !!x. h(x) == llist_corec(x,f) |] ==> \ |
632 "[| !!x. h(x) == llist_corec(x,f) |] ==> \ |
633 \ h(a) = case(f(a), %u.LNil, %v. split(v, %z w. LCons(z, h(w))))"; |
633 \ h(a) = sum_case(f(a), %u.LNil, %v. split(v, %z w. LCons(z, h(w))))"; |
634 by (rewtac rew); |
634 by (rewtac rew); |
635 by (rtac llist_corec 1); |
635 by (rtac llist_corec 1); |
636 val def_llist_corec = result(); |
636 val def_llist_corec = result(); |
637 |
637 |
638 (**** Proofs about type 'a llist functions ****) |
638 (**** Proofs about type 'a llist functions ****) |