llist.ML
changeset 38 7ef6ba42914b
parent 26 5e3aa998e94e
child 44 64eda8afe2b4
equal deleted inserted replaced
37:65a546c2b8ed 38:7ef6ba42914b
    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 ****)