converted ex with curried function application
authorclasohm
Wed Mar 22 12:42:34 1995 +0100 (1995-03-22)
changeset 969b051e2fc2e34
parent 968 3cdaa8724175
child 970 6d36fe1bb234
converted ex with curried function application
src/HOL/ex/Acc.ML
src/HOL/ex/Acc.thy
src/HOL/ex/InSort.ML
src/HOL/ex/InSort.thy
src/HOL/ex/LList.ML
src/HOL/ex/LList.thy
src/HOL/ex/LexProd.ML
src/HOL/ex/LexProd.thy
src/HOL/ex/MT.ML
src/HOL/ex/MT.thy
src/HOL/ex/NatSum.ML
src/HOL/ex/NatSum.thy
src/HOL/ex/PropLog.ML
src/HOL/ex/PropLog.thy
src/HOL/ex/Puzzle.ML
src/HOL/ex/Puzzle.thy
src/HOL/ex/Qsort.ML
src/HOL/ex/Qsort.thy
src/HOL/ex/ROOT.ML
src/HOL/ex/Rec.ML
src/HOL/ex/Rec.thy
src/HOL/ex/SList.ML
src/HOL/ex/SList.thy
src/HOL/ex/Simult.ML
src/HOL/ex/Simult.thy
src/HOL/ex/Sorting.ML
src/HOL/ex/Sorting.thy
src/HOL/ex/String.ML
src/HOL/ex/String.thy
src/HOL/ex/Term.ML
src/HOL/ex/Term.thy
src/HOL/ex/cla.ML
src/HOL/ex/meson.ML
src/HOL/ex/mesontest.ML
src/HOL/ex/rel.ML
src/HOL/ex/set.ML
src/HOL/ex/unsolved.ML
     1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/src/HOL/ex/Acc.ML	Wed Mar 22 12:42:34 1995 +0100
     1.3 @@ -0,0 +1,63 @@
     1.4 +(*  Title: 	HOL/ex/Acc
     1.5 +    ID:         $Id$
     1.6 +    Author: 	Lawrence C Paulson, Cambridge University Computer Laboratory
     1.7 +    Copyright   1994  University of Cambridge
     1.8 +
     1.9 +Inductive definition of acc(r)
    1.10 +
    1.11 +See Ch. Paulin-Mohring, Inductive Definitions in the System Coq.
    1.12 +Research Report 92-49, LIP, ENS Lyon.  Dec 1992.
    1.13 +*)
    1.14 +
    1.15 +open Acc;
    1.16 +
    1.17 +(*The intended introduction rule*)
    1.18 +val prems = goal Acc.thy
    1.19 +    "[| !!b. <b,a>:r ==> b: acc(r) |] ==> a: acc(r)";
    1.20 +by (fast_tac (set_cs addIs (prems @ 
    1.21 +			    map (rewrite_rule [pred_def]) acc.intrs)) 1);
    1.22 +qed "accI";
    1.23 +
    1.24 +goal Acc.thy "!!a b r. [| b: acc(r);  <a,b>: r |] ==> a: acc(r)";
    1.25 +by (etac acc.elim 1);
    1.26 +by (rewtac pred_def);
    1.27 +by (fast_tac set_cs 1);
    1.28 +qed "acc_downward";
    1.29 +
    1.30 +val [major,indhyp] = goal Acc.thy
    1.31 +    "[| a : acc(r);						\
    1.32 +\       !!x. [| x: acc(r);  ALL y. <y,x>:r --> P(y) |] ==> P(x)	\
    1.33 +\    |] ==> P(a)";
    1.34 +by (rtac (major RS acc.induct) 1);
    1.35 +by (rtac indhyp 1);
    1.36 +by (resolve_tac acc.intrs 1);
    1.37 +by (rewtac pred_def);
    1.38 +by (fast_tac set_cs 2);
    1.39 +be (Int_lower1 RS Pow_mono RS subsetD) 1;
    1.40 +qed "acc_induct";
    1.41 +
    1.42 +
    1.43 +val [major] = goal Acc.thy "r <= Sigma (acc r) (%u. acc(r)) ==> wf(r)";
    1.44 +by (rtac (major RS wfI) 1);
    1.45 +by (etac acc.induct 1);
    1.46 +by (rewtac pred_def);
    1.47 +by (fast_tac set_cs 1);
    1.48 +qed "acc_wfI";
    1.49 +
    1.50 +val [major] = goal Acc.thy "wf(r) ==> ALL x. <x,y>: r | <y,x>:r --> y: acc(r)";
    1.51 +by (rtac (major RS wf_induct) 1);
    1.52 +br (impI RS allI) 1;
    1.53 +br accI 1;
    1.54 +by (fast_tac set_cs 1);
    1.55 +qed "acc_wfD_lemma";
    1.56 +
    1.57 +val [major] = goal Acc.thy "wf(r) ==> r <= Sigma (acc r) (%u. acc(r))";
    1.58 +by (rtac subsetI 1);
    1.59 +by (res_inst_tac [("p", "x")] PairE 1);
    1.60 +by (fast_tac (set_cs addSIs [SigmaI,
    1.61 +			     major RS acc_wfD_lemma RS spec RS mp]) 1);
    1.62 +qed "acc_wfD";
    1.63 +
    1.64 +goal Acc.thy "wf(r)  =  (r <= Sigma (acc r) (%u. acc(r)))";
    1.65 +by (EVERY1 [rtac iffI, etac acc_wfD, etac acc_wfI]);
    1.66 +qed "wf_acc_iff";
     2.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     2.2 +++ b/src/HOL/ex/Acc.thy	Wed Mar 22 12:42:34 1995 +0100
     2.3 @@ -0,0 +1,26 @@
     2.4 +(*  Title: 	HOL/ex/Acc.thy
     2.5 +    ID:         $Id$
     2.6 +    Author: 	Lawrence C Paulson, Cambridge University Computer Laboratory
     2.7 +    Copyright   1994  University of Cambridge
     2.8 +
     2.9 +Inductive definition of acc(r)
    2.10 +
    2.11 +See Ch. Paulin-Mohring, Inductive Definitions in the System Coq.
    2.12 +Research Report 92-49, LIP, ENS Lyon.  Dec 1992.
    2.13 +*)
    2.14 +
    2.15 +Acc = WF + 
    2.16 +
    2.17 +consts
    2.18 +  pred :: "['b, ('a * 'b)set] => 'a set"	(*Set of predecessors*)
    2.19 +  acc  :: "('a * 'a)set => 'a set"		(*Accessible part*)
    2.20 +
    2.21 +defs
    2.22 +  pred_def     "pred x r == {y. <y,x>:r}"
    2.23 +
    2.24 +inductive "acc(r)"
    2.25 +  intrs
    2.26 +    pred    "pred a r: Pow(acc(r)) ==> a: acc(r)"
    2.27 +  monos     "[Pow_mono]"
    2.28 +
    2.29 +end
     3.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     3.2 +++ b/src/HOL/ex/InSort.ML	Wed Mar 22 12:42:34 1995 +0100
     3.3 @@ -0,0 +1,46 @@
     3.4 +(*  Title: 	HOL/ex/insort.ML
     3.5 +    ID:         $Id$
     3.6 +    Author: 	Tobias Nipkow
     3.7 +    Copyright   1994 TU Muenchen
     3.8 +
     3.9 +Correctness proof of insertion sort.
    3.10 +*)
    3.11 +
    3.12 +val insort_ss = sorting_ss addsimps
    3.13 + [InSort.ins_Nil,InSort.ins_Cons,InSort.insort_Nil,InSort.insort_Cons];
    3.14 +
    3.15 +goalw InSort.thy [Sorting.total_def]
    3.16 +  "!!f. [| total(f); ~f x y |] ==> f y x";
    3.17 +by(fast_tac HOL_cs 1);
    3.18 +qed "totalD";
    3.19 +
    3.20 +goalw InSort.thy [Sorting.transf_def]
    3.21 +  "!!f. [| transf(f); f b a |] ==> !x. f a x --> f b x";
    3.22 +by(fast_tac HOL_cs 1);
    3.23 +qed "transfD";
    3.24 +
    3.25 +goal InSort.thy "list_all p (ins f x xs) = (list_all p xs & p(x))";
    3.26 +by(list.induct_tac "xs" 1);
    3.27 +by(asm_simp_tac insort_ss 1);
    3.28 +by(asm_simp_tac (insort_ss setloop (split_tac [expand_if])) 1);
    3.29 +by(fast_tac HOL_cs 1);
    3.30 +val insort_ss = insort_ss addsimps [result()];
    3.31 +
    3.32 +goal InSort.thy "(!x. p(x) --> q(x)) --> list_all p xs --> list_all q xs";
    3.33 +by(list.induct_tac "xs" 1);
    3.34 +by(ALLGOALS(asm_simp_tac (insort_ss setloop (split_tac [expand_if]))));
    3.35 +qed "list_all_imp";
    3.36 +
    3.37 +val prems = goal InSort.thy
    3.38 +  "[| total(f); transf(f) |] ==>  sorted f (ins f x xs) = sorted f xs";
    3.39 +by(list.induct_tac "xs" 1);
    3.40 +by(ALLGOALS(asm_simp_tac (insort_ss setloop (split_tac [expand_if]))));
    3.41 +by(cut_facts_tac prems 1);
    3.42 +by(cut_inst_tac [("p","f(a)"),("q","f(x)")] list_all_imp 1);
    3.43 +by(fast_tac (HOL_cs addDs [totalD,transfD]) 1);
    3.44 +val insort_ss = insort_ss addsimps [result()];
    3.45 +
    3.46 +goal InSort.thy "!!f. [| total(f); transf(f) |] ==>  sorted f (insort f xs)";
    3.47 +by(list.induct_tac "xs" 1);
    3.48 +by(ALLGOALS(asm_simp_tac insort_ss));
    3.49 +result();
     4.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     4.2 +++ b/src/HOL/ex/InSort.thy	Wed Mar 22 12:42:34 1995 +0100
     4.3 @@ -0,0 +1,21 @@
     4.4 +(*  Title: 	HOL/ex/insort.thy
     4.5 +    ID:         $Id$
     4.6 +    Author: 	Tobias Nipkow
     4.7 +    Copyright   1994 TU Muenchen
     4.8 +
     4.9 +Insertion sort
    4.10 +*)
    4.11 +
    4.12 +InSort  =  Sorting +
    4.13 +
    4.14 +consts
    4.15 +  ins :: "[['a,'a]=>bool, 'a, 'a list] => 'a list"
    4.16 +  insort :: "[['a,'a]=>bool, 'a list] => 'a list"
    4.17 +
    4.18 +primrec ins List.list
    4.19 +  ins_Nil  "ins f x [] = [x]"
    4.20 +  ins_Cons "ins f x (y#ys) = (if f x y then (x#y#ys) else y#(ins f x ys))"
    4.21 +primrec insort List.list
    4.22 +  insort_Nil  "insort f [] = []"
    4.23 +  insort_Cons "insort f (x#xs) = ins f x (insort f xs)"
    4.24 +end
     5.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     5.2 +++ b/src/HOL/ex/LList.ML	Wed Mar 22 12:42:34 1995 +0100
     5.3 @@ -0,0 +1,880 @@
     5.4 +(*  Title: 	HOL/llist
     5.5 +    ID:         $Id$
     5.6 +    Author: 	Lawrence C Paulson, Cambridge University Computer Laboratory
     5.7 +    Copyright   1993  University of Cambridge
     5.8 +
     5.9 +SHOULD LListD_Fun_CONS_I, etc., be equations (for rewriting)?
    5.10 +*)
    5.11 +
    5.12 +open LList;
    5.13 +
    5.14 +(** Simplification **)
    5.15 +
    5.16 +val llist_ss = univ_ss addcongs [split_weak_cong, sum_case_weak_cong]
    5.17 +                       setloop  split_tac [expand_split, expand_sum_case];
    5.18 +
    5.19 +(*For adding _eqI rules to a simpset; we must remove Pair_eq because
    5.20 +  it may turn an instance of reflexivity into a conjunction!*)
    5.21 +fun add_eqI ss = ss addsimps [range_eqI, image_eqI] 
    5.22 +                    delsimps [Pair_eq];
    5.23 +
    5.24 +
    5.25 +(*This justifies using llist in other recursive type definitions*)
    5.26 +goalw LList.thy llist.defs "!!A B. A<=B ==> llist(A) <= llist(B)";
    5.27 +by (rtac gfp_mono 1);
    5.28 +by (REPEAT (ares_tac basic_monos 1));
    5.29 +qed "llist_mono";
    5.30 +
    5.31 +
    5.32 +goal LList.thy "llist(A) = {Numb(0)} <+> (A <*> llist(A))";
    5.33 +let val rew = rewrite_rule [NIL_def, CONS_def] in  
    5.34 +by (fast_tac (univ_cs addSIs (equalityI :: map rew llist.intrs)
    5.35 +                      addEs [rew llist.elim]) 1)
    5.36 +end;
    5.37 +qed "llist_unfold";
    5.38 +
    5.39 +
    5.40 +(*** Type checking by coinduction, using list_Fun 
    5.41 +     THE COINDUCTIVE DEFINITION PACKAGE COULD DO THIS!
    5.42 +***)
    5.43 +
    5.44 +goalw LList.thy [list_Fun_def]
    5.45 +    "!!M. [| M : X;  X <= list_Fun A (X Un llist(A)) |] ==>  M : llist(A)";
    5.46 +be llist.coinduct 1;
    5.47 +be (subsetD RS CollectD) 1;
    5.48 +ba 1;
    5.49 +qed "llist_coinduct";
    5.50 +
    5.51 +goalw LList.thy [list_Fun_def, NIL_def] "NIL: list_Fun A X";
    5.52 +by (fast_tac set_cs 1);
    5.53 +qed "list_Fun_NIL_I";
    5.54 +
    5.55 +goalw LList.thy [list_Fun_def,CONS_def]
    5.56 +    "!!M N. [| M: A;  N: X |] ==> CONS M N : list_Fun A X";
    5.57 +by (fast_tac set_cs 1);
    5.58 +qed "list_Fun_CONS_I";
    5.59 +
    5.60 +(*Utilise the "strong" part, i.e. gfp(f)*)
    5.61 +goalw LList.thy (llist.defs @ [list_Fun_def])
    5.62 +    "!!M N. M: llist(A) ==> M : list_Fun A (X Un llist(A))";
    5.63 +by (etac (llist.mono RS gfp_fun_UnI2) 1);
    5.64 +qed "list_Fun_llist_I";
    5.65 +
    5.66 +(*** LList_corec satisfies the desired recurion equation ***)
    5.67 +
    5.68 +(*A continuity result?*)
    5.69 +goalw LList.thy [CONS_def] "CONS M (UN x.f(x)) = (UN x. CONS M (f x))";
    5.70 +by (simp_tac (univ_ss addsimps [In1_UN1, Scons_UN1_y]) 1);
    5.71 +qed "CONS_UN1";
    5.72 +
    5.73 +(*UNUSED; obsolete?
    5.74 +goal Prod.thy "split p (%x y.UN z.f x y z) = (UN z. split p (%x y.f x y z))";
    5.75 +by (simp_tac (prod_ss setloop (split_tac [expand_split])) 1);
    5.76 +qed "split_UN1";
    5.77 +
    5.78 +goal Sum.thy "sum_case s f (%y.UN z.g y z) = (UN z.sum_case s f (%y.g y z))";
    5.79 +by (simp_tac (sum_ss setloop (split_tac [expand_sum_case])) 1);
    5.80 +qed "sum_case2_UN1";
    5.81 +*)
    5.82 +
    5.83 +val prems = goalw LList.thy [CONS_def]
    5.84 +    "[| M<=M';  N<=N' |] ==> CONS M N <= CONS M' N'";
    5.85 +by (REPEAT (resolve_tac ([In1_mono,Scons_mono]@prems) 1));
    5.86 +qed "CONS_mono";
    5.87 +
    5.88 +val corec_fun_simps = [LList_corec_fun_def RS def_nat_rec_0,
    5.89 +		       LList_corec_fun_def RS def_nat_rec_Suc];
    5.90 +val corec_fun_ss = llist_ss addsimps corec_fun_simps;
    5.91 +
    5.92 +(** The directions of the equality are proved separately **)
    5.93 +
    5.94 +goalw LList.thy [LList_corec_def]
    5.95 +    "LList_corec a f <= sum_case (%u.NIL) \
    5.96 +\			   (split(%z w. CONS z (LList_corec w f))) (f a)";
    5.97 +by (rtac UN1_least 1);
    5.98 +by (res_inst_tac [("n","k")] natE 1);
    5.99 +by (ALLGOALS (asm_simp_tac corec_fun_ss));
   5.100 +by (REPEAT (resolve_tac [allI, impI, subset_refl RS CONS_mono, UN1_upper] 1));
   5.101 +qed "LList_corec_subset1";
   5.102 +
   5.103 +goalw LList.thy [LList_corec_def]
   5.104 +    "sum_case (%u.NIL) (split(%z w. CONS z (LList_corec w f))) (f a) <= \
   5.105 +\    LList_corec a f";
   5.106 +by (simp_tac (corec_fun_ss addsimps [CONS_UN1]) 1);
   5.107 +by (safe_tac set_cs);
   5.108 +by (ALLGOALS (res_inst_tac [("x","Suc(?k)")] UN1_I THEN' 
   5.109 +	      asm_simp_tac corec_fun_ss));
   5.110 +qed "LList_corec_subset2";
   5.111 +
   5.112 +(*the recursion equation for LList_corec -- NOT SUITABLE FOR REWRITING!*)
   5.113 +goal LList.thy
   5.114 +    "LList_corec a f = sum_case (%u. NIL) \
   5.115 +\			    (split(%z w. CONS z (LList_corec w f))) (f a)";
   5.116 +by (REPEAT (resolve_tac [equalityI, LList_corec_subset1, 
   5.117 +			 LList_corec_subset2] 1));
   5.118 +qed "LList_corec";
   5.119 +
   5.120 +(*definitional version of same*)
   5.121 +val [rew] = goal LList.thy
   5.122 +    "[| !!x. h(x) == LList_corec x f |] ==>	\
   5.123 +\    h(a) = sum_case (%u.NIL) (split(%z w. CONS z (h w))) (f a)";
   5.124 +by (rewtac rew);
   5.125 +by (rtac LList_corec 1);
   5.126 +qed "def_LList_corec";
   5.127 +
   5.128 +(*A typical use of co-induction to show membership in the gfp. 
   5.129 +  Bisimulation is  range(%x. LList_corec x f) *)
   5.130 +goal LList.thy "LList_corec a f : llist({u.True})";
   5.131 +by (res_inst_tac [("X", "range(%x.LList_corec x ?g)")] llist_coinduct 1);
   5.132 +by (rtac rangeI 1);
   5.133 +by (safe_tac set_cs);
   5.134 +by (stac LList_corec 1);
   5.135 +by (simp_tac (llist_ss addsimps [list_Fun_NIL_I, list_Fun_CONS_I, CollectI]
   5.136 +                       |> add_eqI) 1);
   5.137 +qed "LList_corec_type";
   5.138 +
   5.139 +(*Lemma for the proof of llist_corec*)
   5.140 +goal LList.thy
   5.141 +   "LList_corec a (%z.sum_case Inl (split(%v w.Inr(<Leaf(v),w>))) (f z)) : \
   5.142 +\   llist(range(Leaf))";
   5.143 +by (res_inst_tac [("X", "range(%x.LList_corec x ?g)")] llist_coinduct 1);
   5.144 +by (rtac rangeI 1);
   5.145 +by (safe_tac set_cs);
   5.146 +by (stac LList_corec 1);
   5.147 +by (asm_simp_tac (llist_ss addsimps [list_Fun_NIL_I]) 1);
   5.148 +by (fast_tac (set_cs addSIs [list_Fun_CONS_I]) 1);
   5.149 +qed "LList_corec_type2";
   5.150 +
   5.151 +
   5.152 +(**** llist equality as a gfp; the bisimulation principle ****)
   5.153 +
   5.154 +(*This theorem is actually used, unlike the many similar ones in ZF*)
   5.155 +goal LList.thy "LListD(r) = diag({Numb(0)}) <++> (r <**> LListD(r))";
   5.156 +let val rew = rewrite_rule [NIL_def, CONS_def] in  
   5.157 +by (fast_tac (univ_cs addSIs (equalityI :: map rew LListD.intrs)
   5.158 +                      addEs [rew LListD.elim]) 1)
   5.159 +end;
   5.160 +qed "LListD_unfold";
   5.161 +
   5.162 +goal LList.thy "!M N. <M,N> : LListD(diag(A)) --> ntrunc k M = ntrunc k N";
   5.163 +by (res_inst_tac [("n", "k")] less_induct 1);
   5.164 +by (safe_tac set_cs);
   5.165 +by (etac LListD.elim 1);
   5.166 +by (safe_tac (prod_cs addSEs [diagE]));
   5.167 +by (res_inst_tac [("n", "n")] natE 1);
   5.168 +by (asm_simp_tac (univ_ss addsimps [ntrunc_0]) 1);
   5.169 +by (rename_tac "n'" 1);
   5.170 +by (res_inst_tac [("n", "n'")] natE 1);
   5.171 +by (asm_simp_tac (univ_ss addsimps [CONS_def, ntrunc_one_In1]) 1);
   5.172 +by (asm_simp_tac (univ_ss addsimps [CONS_def, ntrunc_In1, ntrunc_Scons]) 1);
   5.173 +qed "LListD_implies_ntrunc_equality";
   5.174 +
   5.175 +(*The domain of the LListD relation*)
   5.176 +goalw LList.thy (llist.defs @ [NIL_def, CONS_def])
   5.177 +    "fst``LListD(diag(A)) <= llist(A)";
   5.178 +by (rtac gfp_upperbound 1);
   5.179 +(*avoids unfolding LListD on the rhs*)
   5.180 +by (res_inst_tac [("P", "%x. fst``x <= ?B")] (LListD_unfold RS ssubst) 1);
   5.181 +by (simp_tac fst_image_ss 1);
   5.182 +by (fast_tac univ_cs 1);
   5.183 +qed "fst_image_LListD";
   5.184 +
   5.185 +(*This inclusion justifies the use of coinduction to show M=N*)
   5.186 +goal LList.thy "LListD(diag(A)) <= diag(llist(A))";
   5.187 +by (rtac subsetI 1);
   5.188 +by (res_inst_tac [("p","x")] PairE 1);
   5.189 +by (safe_tac HOL_cs);
   5.190 +by (rtac diag_eqI 1);
   5.191 +by (rtac (LListD_implies_ntrunc_equality RS spec RS spec RS mp RS 
   5.192 +	  ntrunc_equality) 1);
   5.193 +by (assume_tac 1);
   5.194 +by (etac (fst_imageI RS (fst_image_LListD RS subsetD)) 1);
   5.195 +qed "LListD_subset_diag";
   5.196 +
   5.197 +(** Coinduction, using LListD_Fun
   5.198 +    THE COINDUCTIVE DEFINITION PACKAGE COULD DO THIS!
   5.199 + **)
   5.200 +
   5.201 +goalw LList.thy [LListD_Fun_def]
   5.202 +    "!!M. [| M : X;  X <= LListD_Fun r (X Un LListD(r)) |] ==>  M : LListD(r)";
   5.203 +be LListD.coinduct 1;
   5.204 +be (subsetD RS CollectD) 1;
   5.205 +ba 1;
   5.206 +qed "LListD_coinduct";
   5.207 +
   5.208 +goalw LList.thy [LListD_Fun_def,NIL_def] "<NIL,NIL> : LListD_Fun r s";
   5.209 +by (fast_tac set_cs 1);
   5.210 +qed "LListD_Fun_NIL_I";
   5.211 +
   5.212 +goalw LList.thy [LListD_Fun_def,CONS_def]
   5.213 + "!!x. [| x:A;  <M,N>:s |] ==> <CONS x M, CONS x N> : LListD_Fun (diag A) s";
   5.214 +by (fast_tac univ_cs 1);
   5.215 +qed "LListD_Fun_CONS_I";
   5.216 +
   5.217 +(*Utilise the "strong" part, i.e. gfp(f)*)
   5.218 +goalw LList.thy (LListD.defs @ [LListD_Fun_def])
   5.219 +    "!!M N. M: LListD(r) ==> M : LListD_Fun r (X Un LListD(r))";
   5.220 +by (etac (LListD.mono RS gfp_fun_UnI2) 1);
   5.221 +qed "LListD_Fun_LListD_I";
   5.222 +
   5.223 +
   5.224 +(*This converse inclusion helps to strengthen LList_equalityI*)
   5.225 +goal LList.thy "diag(llist(A)) <= LListD(diag(A))";
   5.226 +by (rtac subsetI 1);
   5.227 +by (etac LListD_coinduct 1);
   5.228 +by (rtac subsetI 1);
   5.229 +by (eresolve_tac [diagE] 1);
   5.230 +by (eresolve_tac [ssubst] 1);
   5.231 +by (eresolve_tac [llist.elim] 1);
   5.232 +by (ALLGOALS
   5.233 +    (asm_simp_tac (llist_ss addsimps [diagI, LListD_Fun_NIL_I,
   5.234 +				      LListD_Fun_CONS_I])));
   5.235 +qed "diag_subset_LListD";
   5.236 +
   5.237 +goal LList.thy "LListD(diag(A)) = diag(llist(A))";
   5.238 +by (REPEAT (resolve_tac [equalityI, LListD_subset_diag, 
   5.239 +			 diag_subset_LListD] 1));
   5.240 +qed "LListD_eq_diag";
   5.241 +
   5.242 +goal LList.thy 
   5.243 +    "!!M N. M: llist(A) ==> <M,M> : LListD_Fun (diag A) (X Un diag(llist(A)))";
   5.244 +by (rtac (LListD_eq_diag RS subst) 1);
   5.245 +br LListD_Fun_LListD_I 1;
   5.246 +by (asm_simp_tac (HOL_ss addsimps [LListD_eq_diag, diagI]) 1);
   5.247 +qed "LListD_Fun_diag_I";
   5.248 +
   5.249 +
   5.250 +(** To show two LLists are equal, exhibit a bisimulation! 
   5.251 +      [also admits true equality]
   5.252 +   Replace "A" by some particular set, like {x.True}??? *)
   5.253 +goal LList.thy 
   5.254 +    "!!r. [| <M,N> : r;  r <= LListD_Fun (diag A) (r Un diag(llist(A))) \
   5.255 +\         |] ==>  M=N";
   5.256 +by (rtac (LListD_subset_diag RS subsetD RS diagE) 1);
   5.257 +by (etac LListD_coinduct 1);
   5.258 +by (asm_simp_tac (HOL_ss addsimps [LListD_eq_diag]) 1);
   5.259 +by (safe_tac prod_cs);
   5.260 +qed "LList_equalityI";
   5.261 +
   5.262 +
   5.263 +(*** Finality of llist(A): Uniqueness of functions defined by corecursion ***)
   5.264 +
   5.265 +(*abstract proof using a bisimulation*)
   5.266 +val [prem1,prem2] = goal LList.thy
   5.267 + "[| !!x. h1(x) = sum_case (%u.NIL) (split(%z w. CONS z (h1 w))) (f x);  \
   5.268 +\    !!x. h2(x) = sum_case (%u.NIL) (split(%z w. CONS z (h2 w))) (f x) |]\
   5.269 +\ ==> h1=h2";
   5.270 +by (rtac ext 1);
   5.271 +(*next step avoids an unknown (and flexflex pair) in simplification*)
   5.272 +by (res_inst_tac [("A", "{u.True}"),
   5.273 +		  ("r", "range(%u. <h1(u),h2(u)>)")] LList_equalityI 1);
   5.274 +by (rtac rangeI 1);
   5.275 +by (safe_tac set_cs);
   5.276 +by (stac prem1 1);
   5.277 +by (stac prem2 1);
   5.278 +by (simp_tac (llist_ss addsimps [LListD_Fun_NIL_I,
   5.279 +				 CollectI RS LListD_Fun_CONS_I]
   5.280 +	               |> add_eqI) 1);
   5.281 +qed "LList_corec_unique";
   5.282 +
   5.283 +val [prem] = goal LList.thy
   5.284 + "[| !!x. h(x) = sum_case (%u.NIL) (split(%z w. CONS z (h w))) (f x) |] \
   5.285 +\ ==> h = (%x.LList_corec x f)";
   5.286 +by (rtac (LList_corec RS (prem RS LList_corec_unique)) 1);
   5.287 +qed "equals_LList_corec";
   5.288 +
   5.289 +
   5.290 +(** Obsolete LList_corec_unique proof: complete induction, not coinduction **)
   5.291 +
   5.292 +goalw LList.thy [CONS_def] "ntrunc (Suc 0) (CONS M N) = {}";
   5.293 +by (rtac ntrunc_one_In1 1);
   5.294 +qed "ntrunc_one_CONS";
   5.295 +
   5.296 +goalw LList.thy [CONS_def]
   5.297 +    "ntrunc (Suc(Suc(k))) (CONS M N) = CONS (ntrunc k M) (ntrunc k N)";
   5.298 +by (simp_tac (HOL_ss addsimps [ntrunc_Scons,ntrunc_In1]) 1);
   5.299 +qed "ntrunc_CONS";
   5.300 +
   5.301 +val [prem1,prem2] = goal LList.thy
   5.302 + "[| !!x. h1(x) = sum_case (%u.NIL) (split(%z w. CONS z (h1 w))) (f x);  \
   5.303 +\    !!x. h2(x) = sum_case (%u.NIL) (split(%z w. CONS z (h2 w))) (f x) |]\
   5.304 +\ ==> h1=h2";
   5.305 +by (rtac (ntrunc_equality RS ext) 1);
   5.306 +by (res_inst_tac [("x", "x")] spec 1);
   5.307 +by (res_inst_tac [("n", "k")] less_induct 1);
   5.308 +by (rtac allI 1);
   5.309 +by (stac prem1 1);
   5.310 +by (stac prem2 1);
   5.311 +by (simp_tac (sum_ss setloop (split_tac [expand_split,expand_sum_case])) 1);
   5.312 +by (strip_tac 1);
   5.313 +by (res_inst_tac [("n", "n")] natE 1);
   5.314 +by (res_inst_tac [("n", "xc")] natE 2);
   5.315 +by (ALLGOALS(asm_simp_tac(nat_ss addsimps
   5.316 +            [ntrunc_0,ntrunc_one_CONS,ntrunc_CONS])));
   5.317 +result();
   5.318 +
   5.319 +
   5.320 +(*** Lconst -- defined directly using lfp, but equivalent to a LList_corec ***)
   5.321 +
   5.322 +goal LList.thy "mono(CONS(M))";
   5.323 +by (REPEAT (ares_tac [monoI, subset_refl, CONS_mono] 1));
   5.324 +qed "Lconst_fun_mono";
   5.325 +
   5.326 +(* Lconst(M) = CONS M (Lconst M) *)
   5.327 +bind_thm ("Lconst", (Lconst_fun_mono RS (Lconst_def RS def_lfp_Tarski)));
   5.328 +
   5.329 +(*A typical use of co-induction to show membership in the gfp.
   5.330 +  The containing set is simply the singleton {Lconst(M)}. *)
   5.331 +goal LList.thy "!!M A. M:A ==> Lconst(M): llist(A)";
   5.332 +by (rtac (singletonI RS llist_coinduct) 1);
   5.333 +by (safe_tac set_cs);
   5.334 +by (res_inst_tac [("P", "%u. u: ?A")] (Lconst RS ssubst) 1);
   5.335 +by (REPEAT (ares_tac [list_Fun_CONS_I, singletonI, UnI1] 1));
   5.336 +qed "Lconst_type";
   5.337 +
   5.338 +goal LList.thy "Lconst(M) = LList_corec M (%x.Inr(<x,x>))";
   5.339 +by (rtac (equals_LList_corec RS fun_cong) 1);
   5.340 +by (simp_tac sum_ss 1);
   5.341 +by (rtac Lconst 1);
   5.342 +qed "Lconst_eq_LList_corec";
   5.343 +
   5.344 +(*Thus we could have used gfp in the definition of Lconst*)
   5.345 +goal LList.thy "gfp(%N. CONS M N) = LList_corec M (%x.Inr(<x,x>))";
   5.346 +by (rtac (equals_LList_corec RS fun_cong) 1);
   5.347 +by (simp_tac sum_ss 1);
   5.348 +by (rtac (Lconst_fun_mono RS gfp_Tarski) 1);
   5.349 +qed "gfp_Lconst_eq_LList_corec";
   5.350 +
   5.351 +
   5.352 +(*** Isomorphisms ***)
   5.353 +
   5.354 +goal LList.thy "inj(Rep_llist)";
   5.355 +by (rtac inj_inverseI 1);
   5.356 +by (rtac Rep_llist_inverse 1);
   5.357 +qed "inj_Rep_llist";
   5.358 +
   5.359 +goal LList.thy "inj_onto Abs_llist (llist(range(Leaf)))";
   5.360 +by (rtac inj_onto_inverseI 1);
   5.361 +by (etac Abs_llist_inverse 1);
   5.362 +qed "inj_onto_Abs_llist";
   5.363 +
   5.364 +(** Distinctness of constructors **)
   5.365 +
   5.366 +goalw LList.thy [LNil_def,LCons_def] "~ LCons x xs = LNil";
   5.367 +by (rtac (CONS_not_NIL RS (inj_onto_Abs_llist RS inj_onto_contraD)) 1);
   5.368 +by (REPEAT (resolve_tac (llist.intrs @ [rangeI, Rep_llist]) 1));
   5.369 +qed "LCons_not_LNil";
   5.370 +
   5.371 +bind_thm ("LNil_not_LCons", (LCons_not_LNil RS not_sym));
   5.372 +
   5.373 +bind_thm ("LCons_neq_LNil", (LCons_not_LNil RS notE));
   5.374 +val LNil_neq_LCons = sym RS LCons_neq_LNil;
   5.375 +
   5.376 +(** llist constructors **)
   5.377 +
   5.378 +goalw LList.thy [LNil_def]
   5.379 +    "Rep_llist(LNil) = NIL";
   5.380 +by (rtac (llist.NIL_I RS Abs_llist_inverse) 1);
   5.381 +qed "Rep_llist_LNil";
   5.382 +
   5.383 +goalw LList.thy [LCons_def]
   5.384 +    "Rep_llist(LCons x l) = CONS (Leaf x) (Rep_llist l)";
   5.385 +by (REPEAT (resolve_tac [llist.CONS_I RS Abs_llist_inverse,
   5.386 +			 rangeI, Rep_llist] 1));
   5.387 +qed "Rep_llist_LCons";
   5.388 +
   5.389 +(** Injectiveness of CONS and LCons **)
   5.390 +
   5.391 +goalw LList.thy [CONS_def] "(CONS M N=CONS M' N') = (M=M' & N=N')";
   5.392 +by (fast_tac (HOL_cs addSEs [Scons_inject, make_elim In1_inject]) 1);
   5.393 +qed "CONS_CONS_eq";
   5.394 +
   5.395 +bind_thm ("CONS_inject", (CONS_CONS_eq RS iffD1 RS conjE));
   5.396 +
   5.397 +
   5.398 +(*For reasoning about abstract llist constructors*)
   5.399 +val llist_cs = set_cs addIs [Rep_llist]@llist.intrs
   5.400 +	              addSEs [CONS_neq_NIL,NIL_neq_CONS,CONS_inject]
   5.401 +		      addSDs [inj_onto_Abs_llist RS inj_ontoD,
   5.402 +			      inj_Rep_llist RS injD, Leaf_inject];
   5.403 +
   5.404 +goalw LList.thy [LCons_def] "(LCons x xs=LCons y ys) = (x=y & xs=ys)";
   5.405 +by (fast_tac llist_cs 1);
   5.406 +qed "LCons_LCons_eq";
   5.407 +bind_thm ("LCons_inject", (LCons_LCons_eq RS iffD1 RS conjE));
   5.408 +
   5.409 +val [major] = goal LList.thy "CONS M N: llist(A) ==> M: A & N: llist(A)";
   5.410 +by (rtac (major RS llist.elim) 1);
   5.411 +by (etac CONS_neq_NIL 1);
   5.412 +by (fast_tac llist_cs 1);
   5.413 +qed "CONS_D";
   5.414 +
   5.415 +
   5.416 +(****** Reasoning about llist(A) ******)
   5.417 +
   5.418 +(*Don't use llist_ss, as it does case splits!*)
   5.419 +val List_case_ss = univ_ss addsimps [List_case_NIL, List_case_CONS];
   5.420 +
   5.421 +(*A special case of list_equality for functions over lazy lists*)
   5.422 +val [Mlist,gMlist,NILcase,CONScase] = goal LList.thy
   5.423 + "[| M: llist(A); g(NIL): llist(A); 				\
   5.424 +\    f(NIL)=g(NIL);						\
   5.425 +\    !!x l. [| x:A;  l: llist(A) |] ==>				\
   5.426 +\	    <f(CONS x l),g(CONS x l)> :				\
   5.427 +\               LListD_Fun (diag A) ((%u.<f(u),g(u)>)``llist(A) Un  \
   5.428 +\                                   diag(llist(A)))		\
   5.429 +\ |] ==> f(M) = g(M)";
   5.430 +by (rtac LList_equalityI 1);
   5.431 +br (Mlist RS imageI) 1;
   5.432 +by (rtac subsetI 1);
   5.433 +by (etac imageE 1);
   5.434 +by (etac ssubst 1);
   5.435 +by (etac llist.elim 1);
   5.436 +by (etac ssubst 1);
   5.437 +by (stac NILcase 1);
   5.438 +br (gMlist RS LListD_Fun_diag_I) 1;
   5.439 +by (etac ssubst 1);
   5.440 +by (REPEAT (ares_tac [CONScase] 1));
   5.441 +qed "LList_fun_equalityI";
   5.442 +
   5.443 +
   5.444 +(*** The functional "Lmap" ***)
   5.445 +
   5.446 +goal LList.thy "Lmap f NIL = NIL";
   5.447 +by (rtac (Lmap_def RS def_LList_corec RS trans) 1);
   5.448 +by (simp_tac List_case_ss 1);
   5.449 +qed "Lmap_NIL";
   5.450 +
   5.451 +goal LList.thy "Lmap f (CONS M N) = CONS (f M) (Lmap f N)";
   5.452 +by (rtac (Lmap_def RS def_LList_corec RS trans) 1);
   5.453 +by (simp_tac List_case_ss 1);
   5.454 +qed "Lmap_CONS";
   5.455 +
   5.456 +(*Another type-checking proof by coinduction*)
   5.457 +val [major,minor] = goal LList.thy
   5.458 +    "[| M: llist(A);  !!x. x:A ==> f(x):B |] ==> Lmap f M: llist(B)";
   5.459 +by (rtac (major RS imageI RS llist_coinduct) 1);
   5.460 +by (safe_tac set_cs);
   5.461 +by (etac llist.elim 1);
   5.462 +by (ALLGOALS (asm_simp_tac (HOL_ss addsimps [Lmap_NIL,Lmap_CONS])));
   5.463 +by (REPEAT (ares_tac [list_Fun_NIL_I, list_Fun_CONS_I, 
   5.464 +		      minor, imageI, UnI1] 1));
   5.465 +qed "Lmap_type";
   5.466 +
   5.467 +(*This type checking rule synthesises a sufficiently large set for f*)
   5.468 +val [major] = goal LList.thy  "M: llist(A) ==> Lmap f M: llist(f``A)";
   5.469 +by (rtac (major RS Lmap_type) 1);
   5.470 +by (etac imageI 1);
   5.471 +qed "Lmap_type2";
   5.472 +
   5.473 +(** Two easy results about Lmap **)
   5.474 +
   5.475 +val [prem] = goalw LList.thy [o_def]
   5.476 +    "M: llist(A) ==> Lmap (f o g) M = Lmap f (Lmap g M)";
   5.477 +by (rtac (prem RS imageI RS LList_equalityI) 1);
   5.478 +by (safe_tac set_cs);
   5.479 +by (etac llist.elim 1);
   5.480 +by (ALLGOALS (asm_simp_tac (HOL_ss addsimps [Lmap_NIL,Lmap_CONS])));
   5.481 +by (REPEAT (ares_tac [LListD_Fun_NIL_I, imageI, UnI1,
   5.482 +		      rangeI RS LListD_Fun_CONS_I] 1));
   5.483 +qed "Lmap_compose";
   5.484 +
   5.485 +val [prem] = goal LList.thy "M: llist(A) ==> Lmap (%x.x) M = M";
   5.486 +by (rtac (prem RS imageI RS LList_equalityI) 1);
   5.487 +by (safe_tac set_cs);
   5.488 +by (etac llist.elim 1);
   5.489 +by (ALLGOALS (asm_simp_tac (HOL_ss addsimps [Lmap_NIL,Lmap_CONS])));
   5.490 +by (REPEAT (ares_tac [LListD_Fun_NIL_I, imageI RS UnI1,
   5.491 +		      rangeI RS LListD_Fun_CONS_I] 1));
   5.492 +qed "Lmap_ident";
   5.493 +
   5.494 +
   5.495 +(*** Lappend -- its two arguments cause some complications! ***)
   5.496 +
   5.497 +goalw LList.thy [Lappend_def] "Lappend NIL NIL = NIL";
   5.498 +by (rtac (LList_corec RS trans) 1);
   5.499 +by (simp_tac List_case_ss 1);
   5.500 +qed "Lappend_NIL_NIL";
   5.501 +
   5.502 +goalw LList.thy [Lappend_def]
   5.503 +    "Lappend NIL (CONS N N') = CONS N (Lappend NIL N')";
   5.504 +by (rtac (LList_corec RS trans) 1);
   5.505 +by (simp_tac List_case_ss 1);
   5.506 +qed "Lappend_NIL_CONS";
   5.507 +
   5.508 +goalw LList.thy [Lappend_def]
   5.509 +    "Lappend (CONS M M') N = CONS M (Lappend M' N)";
   5.510 +by (rtac (LList_corec RS trans) 1);
   5.511 +by (simp_tac List_case_ss 1);
   5.512 +qed "Lappend_CONS";
   5.513 +
   5.514 +val Lappend_ss = 
   5.515 +    List_case_ss addsimps [llist.NIL_I, Lappend_NIL_NIL, Lappend_NIL_CONS,
   5.516 +			   Lappend_CONS, LListD_Fun_CONS_I]
   5.517 +                 |> add_eqI;
   5.518 +
   5.519 +goal LList.thy "!!M. M: llist(A) ==> Lappend NIL M = M";
   5.520 +by (etac LList_fun_equalityI 1);
   5.521 +by (ALLGOALS (asm_simp_tac Lappend_ss));
   5.522 +qed "Lappend_NIL";
   5.523 +
   5.524 +goal LList.thy "!!M. M: llist(A) ==> Lappend M NIL = M";
   5.525 +by (etac LList_fun_equalityI 1);
   5.526 +by (ALLGOALS (asm_simp_tac Lappend_ss));
   5.527 +qed "Lappend_NIL2";
   5.528 +
   5.529 +(** Alternative type-checking proofs for Lappend **)
   5.530 +
   5.531 +(*weak co-induction: bisimulation and case analysis on both variables*)
   5.532 +goal LList.thy
   5.533 +    "!!M N. [| M: llist(A); N: llist(A) |] ==> Lappend M N: llist(A)";
   5.534 +by (res_inst_tac
   5.535 +    [("X", "UN u:llist(A). UN v: llist(A). {Lappend u v}")] llist_coinduct 1);
   5.536 +by (fast_tac set_cs 1);
   5.537 +by (safe_tac set_cs);
   5.538 +by (eres_inst_tac [("a", "u")] llist.elim 1);
   5.539 +by (eres_inst_tac [("a", "v")] llist.elim 1);
   5.540 +by (ALLGOALS
   5.541 +    (asm_simp_tac Lappend_ss THEN'
   5.542 +     fast_tac (set_cs addSIs [llist.NIL_I, list_Fun_NIL_I, list_Fun_CONS_I])));
   5.543 +qed "Lappend_type";
   5.544 +
   5.545 +(*strong co-induction: bisimulation and case analysis on one variable*)
   5.546 +goal LList.thy
   5.547 +    "!!M N. [| M: llist(A); N: llist(A) |] ==> Lappend M N: llist(A)";
   5.548 +by (res_inst_tac [("X", "(%u.Lappend u N)``llist(A)")] llist_coinduct 1);
   5.549 +be imageI 1;
   5.550 +br subsetI 1;
   5.551 +be imageE 1;
   5.552 +by (eres_inst_tac [("a", "u")] llist.elim 1);
   5.553 +by (asm_simp_tac (Lappend_ss addsimps [Lappend_NIL, list_Fun_llist_I]) 1);
   5.554 +by (asm_simp_tac Lappend_ss 1);
   5.555 +by (fast_tac (set_cs addSIs [list_Fun_CONS_I]) 1);
   5.556 +qed "Lappend_type";
   5.557 +
   5.558 +(**** Lazy lists as the type 'a llist -- strongly typed versions of above ****)
   5.559 +
   5.560 +(** llist_case: case analysis for 'a llist **)
   5.561 +
   5.562 +val Rep_llist_simps =
   5.563 +                [List_case_NIL, List_case_CONS, 
   5.564 +		 Abs_llist_inverse, Rep_llist_inverse,
   5.565 +		 Rep_llist, rangeI, inj_Leaf, Inv_f_f]
   5.566 +		@ llist.intrs;
   5.567 +val Rep_llist_ss = llist_ss addsimps Rep_llist_simps;
   5.568 +
   5.569 +goalw LList.thy [llist_case_def,LNil_def]  "llist_case c d LNil = c";
   5.570 +by (simp_tac Rep_llist_ss 1);
   5.571 +qed "llist_case_LNil";
   5.572 +
   5.573 +goalw LList.thy [llist_case_def,LCons_def]
   5.574 +    "llist_case c d (LCons M N) = d M N";
   5.575 +by (simp_tac Rep_llist_ss 1);
   5.576 +qed "llist_case_LCons";
   5.577 +
   5.578 +(*Elimination is case analysis, not induction.*)
   5.579 +val [prem1,prem2] = goalw LList.thy [NIL_def,CONS_def]
   5.580 +    "[| l=LNil ==> P;  !!x l'. l=LCons x l' ==> P \
   5.581 +\    |] ==> P";
   5.582 +by (rtac (Rep_llist RS llist.elim) 1);
   5.583 +by (rtac (inj_Rep_llist RS injD RS prem1) 1);
   5.584 +by (stac Rep_llist_LNil 1);
   5.585 +by (assume_tac 1);
   5.586 +by (etac rangeE 1);
   5.587 +by (rtac (inj_Rep_llist RS injD RS prem2) 1);
   5.588 +by (asm_simp_tac (HOL_ss addsimps [Rep_llist_LCons]) 1);
   5.589 +by (etac (Abs_llist_inverse RS ssubst) 1);
   5.590 +by (rtac refl 1);
   5.591 +qed "llistE";
   5.592 +
   5.593 +(** llist_corec: corecursion for 'a llist **)
   5.594 +
   5.595 +goalw LList.thy [llist_corec_def,LNil_def,LCons_def]
   5.596 +    "llist_corec a f = sum_case (%u. LNil) \
   5.597 +\			    (split(%z w. LCons z (llist_corec w f))) (f a)";
   5.598 +by (stac LList_corec 1);
   5.599 +by (res_inst_tac [("s","f(a)")] sumE 1);
   5.600 +by (asm_simp_tac (llist_ss addsimps [LList_corec_type2,Abs_llist_inverse]) 1);
   5.601 +by (res_inst_tac [("p","y")] PairE 1);
   5.602 +by (asm_simp_tac (llist_ss addsimps [LList_corec_type2,Abs_llist_inverse]) 1);
   5.603 +(*FIXME: correct case splits usd to be found automatically:
   5.604 +by (ASM_SIMP_TAC(llist_ss addsimps [LList_corec_type2,Abs_llist_inverse]) 1);*)
   5.605 +qed "llist_corec";
   5.606 +
   5.607 +(*definitional version of same*)
   5.608 +val [rew] = goal LList.thy
   5.609 +    "[| !!x. h(x) == llist_corec x f |] ==>	\
   5.610 +\    h(a) = sum_case (%u.LNil) (split(%z w. LCons z (h w))) (f a)";
   5.611 +by (rewtac rew);
   5.612 +by (rtac llist_corec 1);
   5.613 +qed "def_llist_corec";
   5.614 +
   5.615 +(**** Proofs about type 'a llist functions ****)
   5.616 +
   5.617 +(*** Deriving llist_equalityI -- llist equality is a bisimulation ***)
   5.618 +
   5.619 +goalw LList.thy [LListD_Fun_def]
   5.620 +    "!!r A. r <= Sigma (llist A) (%x.llist(A)) ==> \
   5.621 +\           LListD_Fun (diag A) r <= Sigma (llist A) (%x.llist(A))";
   5.622 +by (stac llist_unfold 1);
   5.623 +by (simp_tac (HOL_ss addsimps [NIL_def, CONS_def]) 1);
   5.624 +by (fast_tac univ_cs 1);
   5.625 +qed "LListD_Fun_subset_Sigma_llist";
   5.626 +
   5.627 +goal LList.thy
   5.628 +    "prod_fun Rep_llist Rep_llist `` r <= \
   5.629 +\    Sigma (llist(range(Leaf))) (%x.llist(range(Leaf)))";
   5.630 +by (fast_tac (prod_cs addIs [Rep_llist]) 1);
   5.631 +qed "subset_Sigma_llist";
   5.632 +
   5.633 +val [prem] = goal LList.thy
   5.634 +    "r <= Sigma (llist(range Leaf)) (%x.llist(range Leaf)) ==> \
   5.635 +\    prod_fun (Rep_llist o Abs_llist) (Rep_llist o Abs_llist) `` r <= r";
   5.636 +by (safe_tac prod_cs);
   5.637 +by (rtac (prem RS subsetD RS SigmaE2) 1);
   5.638 +by (assume_tac 1);
   5.639 +by (asm_simp_tac (HOL_ss addsimps [o_def,prod_fun,Abs_llist_inverse]) 1);
   5.640 +qed "prod_fun_lemma";
   5.641 +
   5.642 +goal LList.thy
   5.643 +    "prod_fun Rep_llist  Rep_llist `` range(%x. <x, x>) = \
   5.644 +\    diag(llist(range(Leaf)))";
   5.645 +br equalityI 1;
   5.646 +by (fast_tac (univ_cs addIs [Rep_llist]) 1);
   5.647 +by (fast_tac (univ_cs addSEs [Abs_llist_inverse RS subst]) 1);
   5.648 +qed "prod_fun_range_eq_diag";
   5.649 +
   5.650 +(** To show two llists are equal, exhibit a bisimulation! 
   5.651 +      [also admits true equality] **)
   5.652 +val [prem1,prem2] = goalw LList.thy [llistD_Fun_def]
   5.653 +    "[| <l1,l2> : r;  r <= llistD_Fun(r Un range(%x.<x,x>)) |] ==> l1=l2";
   5.654 +by (rtac (inj_Rep_llist RS injD) 1);
   5.655 +by (res_inst_tac [("r", "prod_fun Rep_llist Rep_llist ``r"),
   5.656 +		  ("A", "range(Leaf)")] 
   5.657 +	LList_equalityI 1);
   5.658 +by (rtac (prem1 RS prod_fun_imageI) 1);
   5.659 +by (rtac (prem2 RS image_mono RS subset_trans) 1);
   5.660 +by (rtac (image_compose RS subst) 1);
   5.661 +by (rtac (prod_fun_compose RS subst) 1);
   5.662 +by (rtac (image_Un RS ssubst) 1);
   5.663 +by (stac prod_fun_range_eq_diag 1);
   5.664 +by (rtac (LListD_Fun_subset_Sigma_llist RS prod_fun_lemma) 1);
   5.665 +by (rtac (subset_Sigma_llist RS Un_least) 1);
   5.666 +by (rtac diag_subset_Sigma 1);
   5.667 +qed "llist_equalityI";
   5.668 +
   5.669 +(** Rules to prove the 2nd premise of llist_equalityI **)
   5.670 +goalw LList.thy [llistD_Fun_def,LNil_def] "<LNil,LNil> : llistD_Fun(r)";
   5.671 +by (rtac (LListD_Fun_NIL_I RS prod_fun_imageI) 1);
   5.672 +qed "llistD_Fun_LNil_I";
   5.673 +
   5.674 +val [prem] = goalw LList.thy [llistD_Fun_def,LCons_def]
   5.675 +    "<l1,l2>:r ==> <LCons x l1, LCons x l2> : llistD_Fun(r)";
   5.676 +by (rtac (rangeI RS LListD_Fun_CONS_I RS prod_fun_imageI) 1);
   5.677 +by (rtac (prem RS prod_fun_imageI) 1);
   5.678 +qed "llistD_Fun_LCons_I";
   5.679 +
   5.680 +(*Utilise the "strong" part, i.e. gfp(f)*)
   5.681 +goalw LList.thy [llistD_Fun_def]
   5.682 +     "!!l. <l,l> : llistD_Fun(r Un range(%x.<x,x>))";
   5.683 +br (Rep_llist_inverse RS subst) 1;
   5.684 +br prod_fun_imageI 1;
   5.685 +by (rtac (image_Un RS ssubst) 1);
   5.686 +by (stac prod_fun_range_eq_diag 1);
   5.687 +br (Rep_llist RS LListD_Fun_diag_I) 1;
   5.688 +qed "llistD_Fun_range_I";
   5.689 +
   5.690 +(*A special case of list_equality for functions over lazy lists*)
   5.691 +val [prem1,prem2] = goal LList.thy
   5.692 +    "[| f(LNil)=g(LNil);						\
   5.693 +\       !!x l. <f(LCons x l),g(LCons x l)> :				\
   5.694 +\              llistD_Fun(range(%u. <f(u),g(u)>) Un range(%v. <v,v>))	\
   5.695 +\    |]	==> f(l) = (g(l :: 'a llist) :: 'b llist)";
   5.696 +by (res_inst_tac [("r", "range(%u. <f(u),g(u)>)")] llist_equalityI 1);
   5.697 +by (rtac rangeI 1);
   5.698 +by (rtac subsetI 1);
   5.699 +by (etac rangeE 1);
   5.700 +by (etac ssubst 1);
   5.701 +by (res_inst_tac [("l", "u")] llistE 1);
   5.702 +by (etac ssubst 1);
   5.703 +by (stac prem1 1);
   5.704 +by (rtac llistD_Fun_range_I 1);
   5.705 +by (etac ssubst 1);
   5.706 +by (rtac prem2 1);
   5.707 +qed "llist_fun_equalityI";
   5.708 +
   5.709 +(*simpset for llist bisimulations*)
   5.710 +val llistD_simps = [llist_case_LNil, llist_case_LCons, 
   5.711 +		    llistD_Fun_LNil_I, llistD_Fun_LCons_I];
   5.712 +(*Don't use llist_ss, as it does case splits!*)
   5.713 +val llistD_ss = univ_ss addsimps llistD_simps |> add_eqI;
   5.714 +
   5.715 +
   5.716 +(*** The functional "lmap" ***)
   5.717 +
   5.718 +goal LList.thy "lmap f LNil = LNil";
   5.719 +by (rtac (lmap_def RS def_llist_corec RS trans) 1);
   5.720 +by (simp_tac llistD_ss 1);
   5.721 +qed "lmap_LNil";
   5.722 +
   5.723 +goal LList.thy "lmap f (LCons M N) = LCons (f M) (lmap f N)";
   5.724 +by (rtac (lmap_def RS def_llist_corec RS trans) 1);
   5.725 +by (simp_tac llistD_ss 1);
   5.726 +qed "lmap_LCons";
   5.727 +
   5.728 +
   5.729 +(** Two easy results about lmap **)
   5.730 +
   5.731 +goal LList.thy "lmap (f o g) l = lmap f (lmap g l)";
   5.732 +by (res_inst_tac [("l","l")] llist_fun_equalityI 1);
   5.733 +by (ALLGOALS (simp_tac (llistD_ss addsimps [lmap_LNil, lmap_LCons])));
   5.734 +qed "lmap_compose";
   5.735 +
   5.736 +goal LList.thy "lmap (%x.x) l = l";
   5.737 +by (res_inst_tac [("l","l")] llist_fun_equalityI 1);
   5.738 +by (ALLGOALS (simp_tac (llistD_ss addsimps [lmap_LNil, lmap_LCons])));
   5.739 +qed "lmap_ident";
   5.740 +
   5.741 +
   5.742 +(*** iterates -- llist_fun_equalityI cannot be used! ***)
   5.743 +
   5.744 +goal LList.thy "iterates f x = LCons x (iterates f (f x))";
   5.745 +by (rtac (iterates_def RS def_llist_corec RS trans) 1);
   5.746 +by (simp_tac sum_ss 1);
   5.747 +qed "iterates";
   5.748 +
   5.749 +goal LList.thy "lmap f (iterates f x) = iterates f (f x)";
   5.750 +by (res_inst_tac [("r", "range(%u.<lmap f (iterates f u),iterates f (f u)>)")] 
   5.751 +    llist_equalityI 1);
   5.752 +by (rtac rangeI 1);
   5.753 +by (safe_tac set_cs);
   5.754 +by (res_inst_tac [("x1", "f(u)")] (iterates RS ssubst) 1);
   5.755 +by (res_inst_tac [("x1", "u")] (iterates RS ssubst) 1);
   5.756 +by (simp_tac (llistD_ss addsimps [lmap_LCons]) 1);
   5.757 +qed "lmap_iterates";
   5.758 +
   5.759 +goal LList.thy "iterates f x = LCons x (lmap f (iterates f x))";
   5.760 +br (lmap_iterates RS ssubst) 1;
   5.761 +br iterates 1;
   5.762 +qed "iterates_lmap";
   5.763 +
   5.764 +(*** A rather complex proof about iterates -- cf Andy Pitts ***)
   5.765 +
   5.766 +(** Two lemmas about natrec n x (%m.g), which is essentially (g^n)(x) **)
   5.767 +
   5.768 +goal LList.thy
   5.769 +    "nat_rec n (LCons b l) (%m. lmap(f)) =	\
   5.770 +\    LCons (nat_rec n b (%m. f)) (nat_rec n l (%m. lmap(f)))";
   5.771 +by (nat_ind_tac "n" 1);
   5.772 +by (ALLGOALS (asm_simp_tac (nat_ss addsimps [lmap_LCons])));
   5.773 +qed "fun_power_lmap";
   5.774 +
   5.775 +goal Nat.thy "nat_rec n (g x) (%m. g) = nat_rec (Suc n) x (%m. g)";
   5.776 +by (nat_ind_tac "n" 1);
   5.777 +by (ALLGOALS (asm_simp_tac nat_ss));
   5.778 +qed "fun_power_Suc";
   5.779 +
   5.780 +val Pair_cong = read_instantiate_sg (sign_of Prod.thy)
   5.781 + [("f","Pair")] (standard(refl RS cong RS cong));
   5.782 +
   5.783 +(*The bisimulation consists of {<lmap(f)^n (h(u)), lmap(f)^n (iterates(f,u))>}
   5.784 +  for all u and all n::nat.*)
   5.785 +val [prem] = goal LList.thy
   5.786 +    "(!!x. h(x) = LCons x (lmap f (h x))) ==> h = iterates(f)";
   5.787 +br ext 1;
   5.788 +by (res_inst_tac [("r", 
   5.789 +   "UN u. range(%n. <nat_rec n (h u) (%m y.lmap f y), \
   5.790 +\                    nat_rec n (iterates f u) (%m y.lmap f y)>)")] 
   5.791 +    llist_equalityI 1);
   5.792 +by (REPEAT (resolve_tac [UN1_I, range_eqI, Pair_cong, nat_rec_0 RS sym] 1));
   5.793 +by (safe_tac set_cs);
   5.794 +by (stac iterates 1);
   5.795 +by (stac prem 1);
   5.796 +by (stac fun_power_lmap 1);
   5.797 +by (stac fun_power_lmap 1);
   5.798 +br llistD_Fun_LCons_I 1;
   5.799 +by (rtac (lmap_iterates RS subst) 1);
   5.800 +by (stac fun_power_Suc 1);
   5.801 +by (stac fun_power_Suc 1);
   5.802 +br (UN1_I RS UnI1) 1;
   5.803 +br rangeI 1;
   5.804 +qed "iterates_equality";
   5.805 +
   5.806 +
   5.807 +(*** lappend -- its two arguments cause some complications! ***)
   5.808 +
   5.809 +goalw LList.thy [lappend_def] "lappend LNil LNil = LNil";
   5.810 +by (rtac (llist_corec RS trans) 1);
   5.811 +by (simp_tac llistD_ss 1);
   5.812 +qed "lappend_LNil_LNil";
   5.813 +
   5.814 +goalw LList.thy [lappend_def]
   5.815 +    "lappend LNil (LCons l l') = LCons l (lappend LNil l')";
   5.816 +by (rtac (llist_corec RS trans) 1);
   5.817 +by (simp_tac llistD_ss 1);
   5.818 +qed "lappend_LNil_LCons";
   5.819 +
   5.820 +goalw LList.thy [lappend_def]
   5.821 +    "lappend (LCons l l') N = LCons l (lappend l' N)";
   5.822 +by (rtac (llist_corec RS trans) 1);
   5.823 +by (simp_tac llistD_ss 1);
   5.824 +qed "lappend_LCons";
   5.825 +
   5.826 +goal LList.thy "lappend LNil l = l";
   5.827 +by (res_inst_tac [("l","l")] llist_fun_equalityI 1);
   5.828 +by (ALLGOALS 
   5.829 +    (simp_tac (llistD_ss addsimps [lappend_LNil_LNil, lappend_LNil_LCons])));
   5.830 +qed "lappend_LNil";
   5.831 +
   5.832 +goal LList.thy "lappend l LNil = l";
   5.833 +by (res_inst_tac [("l","l")] llist_fun_equalityI 1);
   5.834 +by (ALLGOALS 
   5.835 +    (simp_tac (llistD_ss addsimps [lappend_LNil_LNil, lappend_LCons])));
   5.836 +qed "lappend_LNil2";
   5.837 +
   5.838 +(*The infinite first argument blocks the second*)
   5.839 +goal LList.thy "lappend (iterates f x) N = iterates f x";
   5.840 +by (res_inst_tac [("r", "range(%u.<lappend (iterates f u) N,iterates f u>)")] 
   5.841 +    llist_equalityI 1);
   5.842 +by (rtac rangeI 1);
   5.843 +by (safe_tac set_cs);
   5.844 +by (stac iterates 1);
   5.845 +by (simp_tac (llistD_ss addsimps [lappend_LCons]) 1);
   5.846 +qed "lappend_iterates";
   5.847 +
   5.848 +(** Two proofs that lmap distributes over lappend **)
   5.849 +
   5.850 +(*Long proof requiring case analysis on both both arguments*)
   5.851 +goal LList.thy "lmap f (lappend l n) = lappend (lmap f l) (lmap f n)";
   5.852 +by (res_inst_tac 
   5.853 +    [("r",  
   5.854 +      "UN n. range(%l.<lmap f (lappend l n),lappend (lmap f l) (lmap f n)>)")] 
   5.855 +    llist_equalityI 1);
   5.856 +by (rtac UN1_I 1);
   5.857 +by (rtac rangeI 1);
   5.858 +by (safe_tac set_cs);
   5.859 +by (res_inst_tac [("l", "l")] llistE 1);
   5.860 +by (res_inst_tac [("l", "n")] llistE 1);
   5.861 +by (ALLGOALS (asm_simp_tac (llistD_ss addsimps
   5.862 +      [lappend_LNil_LNil,lappend_LCons,lappend_LNil_LCons,
   5.863 +       lmap_LNil,lmap_LCons])));
   5.864 +by (REPEAT_SOME (ares_tac [llistD_Fun_LCons_I, UN1_I RS UnI1, rangeI]));
   5.865 +by (rtac range_eqI 1);
   5.866 +by (rtac (refl RS Pair_cong) 1);
   5.867 +by (stac lmap_LNil 1);
   5.868 +by (rtac refl 1);
   5.869 +qed "lmap_lappend_distrib";
   5.870 +
   5.871 +(*Shorter proof of theorem above using llist_equalityI as strong coinduction*)
   5.872 +goal LList.thy "lmap f (lappend l n) = lappend (lmap f l) (lmap f n)";
   5.873 +by (res_inst_tac [("l","l")] llist_fun_equalityI 1);
   5.874 +by (simp_tac (llistD_ss addsimps [lappend_LNil, lmap_LNil])1);
   5.875 +by (simp_tac (llistD_ss addsimps [lappend_LCons, lmap_LCons]) 1);
   5.876 +qed "lmap_lappend_distrib";
   5.877 +
   5.878 +(*Without strong coinduction, three case analyses might be needed*)
   5.879 +goal LList.thy "lappend (lappend l1 l2) l3 = lappend l1 (lappend l2 l3)";
   5.880 +by (res_inst_tac [("l","l1")] llist_fun_equalityI 1);
   5.881 +by (simp_tac (llistD_ss addsimps [lappend_LNil])1);
   5.882 +by (simp_tac (llistD_ss addsimps [lappend_LCons]) 1);
   5.883 +qed "lappend_assoc";
     6.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     6.2 +++ b/src/HOL/ex/LList.thy	Wed Mar 22 12:42:34 1995 +0100
     6.3 @@ -0,0 +1,145 @@
     6.4 +(*  Title: 	HOL/LList.thy
     6.5 +    ID:         $Id$
     6.6 +    Author: 	Lawrence C Paulson, Cambridge University Computer Laboratory
     6.7 +    Copyright   1994  University of Cambridge
     6.8 +
     6.9 +Definition of type 'a llist by a greatest fixed point
    6.10 +
    6.11 +Shares NIL, CONS, List_case with List.thy
    6.12 +
    6.13 +Still needs filter and flatten functions -- hard because they need
    6.14 +bounds on the amount of lookahead required.
    6.15 +
    6.16 +Could try (but would it work for the gfp analogue of term?)
    6.17 +  LListD_Fun_def "LListD_Fun(A) == (%Z.diag({Numb(0)}) <++> diag(A) <**> Z)"
    6.18 +
    6.19 +A nice but complex example would be [ML for the Working Programmer, page 176]
    6.20 +  from(1) = enumerate (Lmap (Lmap(pack), makeqq(from(1),from(1))))
    6.21 +
    6.22 +Previous definition of llistD_Fun was explicit:
    6.23 +  llistD_Fun_def
    6.24 +   "llistD_Fun(r) == 	\
    6.25 +\       {<LNil,LNil>}  Un  	\
    6.26 +\       (UN x. (split(%l1 l2.<LCons(x,l1),LCons(x,l2)>))``r)"
    6.27 +*)
    6.28 +
    6.29 +LList = Gfp + SList +
    6.30 +
    6.31 +types
    6.32 +  'a llist
    6.33 +
    6.34 +arities
    6.35 +   llist :: (term)term
    6.36 +
    6.37 +consts
    6.38 +  list_Fun   :: "['a item set, 'a item set] => 'a item set"
    6.39 +  LListD_Fun :: 
    6.40 +      "[('a item * 'a item)set, ('a item * 'a item)set] => \
    6.41 +\      ('a item * 'a item)set"
    6.42 +
    6.43 +  llist      :: "'a item set => 'a item set"
    6.44 +  LListD     :: "('a item * 'a item)set => ('a item * 'a item)set"
    6.45 +  llistD_Fun :: "('a llist * 'a llist)set => ('a llist * 'a llist)set"
    6.46 +
    6.47 +  Rep_llist  :: "'a llist => 'a item"
    6.48 +  Abs_llist  :: "'a item => 'a llist"
    6.49 +  LNil       :: "'a llist"
    6.50 +  LCons      :: "['a, 'a llist] => 'a llist"
    6.51 +  
    6.52 +  llist_case :: "['b, ['a, 'a llist]=>'b, 'a llist] => 'b"
    6.53 +
    6.54 +  LList_corec_fun :: "[nat, 'a=>unit+('b item * 'a), 'a] => 'b item"
    6.55 +  LList_corec     :: "['a, 'a => unit + ('b item * 'a)] => 'b item"
    6.56 +  llist_corec     :: "['a, 'a => unit + ('b * 'a)] => 'b llist"
    6.57 +
    6.58 +  Lmap	     :: "('a item => 'b item) => ('a item => 'b item)"
    6.59 +  lmap	     :: "('a=>'b) => ('a llist => 'b llist)"
    6.60 +
    6.61 +  iterates   :: "['a => 'a, 'a] => 'a llist"
    6.62 +
    6.63 +  Lconst     :: "'a item => 'a item"
    6.64 +  Lappend    :: "['a item, 'a item] => 'a item"
    6.65 +  lappend    :: "['a llist, 'a llist] => 'a llist"
    6.66 +
    6.67 +
    6.68 +coinductive "llist(A)"
    6.69 +  intrs
    6.70 +    NIL_I  "NIL: llist(A)"
    6.71 +    CONS_I "[| a: A;  M: llist(A) |] ==> CONS a M : llist(A)"
    6.72 +
    6.73 +coinductive "LListD(r)"
    6.74 +  intrs
    6.75 +    NIL_I  "<NIL, NIL> : LListD(r)"
    6.76 +    CONS_I "[| <a,b>: r;  <M,N> : LListD(r)   \
    6.77 +\	    |] ==> <CONS a M, CONS b N> : LListD(r)"
    6.78 +
    6.79 +defs
    6.80 +  (*Now used exclusively for abbreviating the coinduction rule*)
    6.81 +  list_Fun_def   "list_Fun A X ==   \
    6.82 +\		  {z. z = NIL | (? M a. z = CONS a M & a : A & M : X)}"
    6.83 +
    6.84 +  LListD_Fun_def "LListD_Fun r X ==   \
    6.85 +\		  {z. z = <NIL, NIL> |   \
    6.86 +\		      (? M N a b. z = <CONS a M, CONS b N> &   \
    6.87 +\		                  <a, b> : r & <M, N> : X)}"
    6.88 +
    6.89 +  (*defining the abstract constructors*)
    6.90 +  LNil_def  	"LNil == Abs_llist(NIL)"
    6.91 +  LCons_def 	"LCons x xs == Abs_llist(CONS (Leaf x) (Rep_llist xs))"
    6.92 +
    6.93 +  llist_case_def
    6.94 +   "llist_case c d l == \
    6.95 +\       List_case c (%x y. d (Inv Leaf x) (Abs_llist y)) (Rep_llist l)"
    6.96 +
    6.97 +  LList_corec_fun_def
    6.98 +    "LList_corec_fun k f == \
    6.99 +\     nat_rec k (%x. {}) 			\
   6.100 +\	      (%j r x. sum_case (%u.NIL) (split(%z w. CONS z (r w))) (f x))"
   6.101 +
   6.102 +  LList_corec_def
   6.103 +    "LList_corec a f == UN k. LList_corec_fun k f a"
   6.104 +
   6.105 +  llist_corec_def
   6.106 +   "llist_corec a f == \
   6.107 +\       Abs_llist(LList_corec a (%z.sum_case (%x.Inl(x)) \
   6.108 +\                                    (split(%v w. Inr(<Leaf(v), w>))) (f z)))"
   6.109 +
   6.110 +  llistD_Fun_def
   6.111 +   "llistD_Fun(r) == 	\
   6.112 +\	prod_fun Abs_llist Abs_llist ``  	\
   6.113 +\                LListD_Fun (diag(range Leaf))	\
   6.114 +\		            (prod_fun Rep_llist Rep_llist `` r)"
   6.115 +
   6.116 +  Lconst_def	"Lconst(M) == lfp(%N. CONS M N)"     
   6.117 +
   6.118 +  Lmap_def
   6.119 +   "Lmap f M == LList_corec M (List_case (Inl Unity) (%x M'. Inr(<f(x), M'>)))"
   6.120 +
   6.121 +  lmap_def
   6.122 +   "lmap f l == llist_corec l (llist_case (Inl Unity) (%y z. Inr(<f(y), z>)))"
   6.123 +
   6.124 +  iterates_def	"iterates f a == llist_corec a (%x. Inr(<x, f(x)>))"     
   6.125 +
   6.126 +(*Append generates its result by applying f, where
   6.127 +    f(<NIL,NIL>) = Inl(Unity)
   6.128 +    f(<NIL, CONS N1 N2>) = Inr(<N1, <NIL,N2>)
   6.129 +    f(<CONS M1 M2, N>)    = Inr(<M1, <M2,N>)
   6.130 +*)
   6.131 +
   6.132 +  Lappend_def
   6.133 +   "Lappend M N == LList_corec <M,N>	   				     \
   6.134 +\     (split(List_case (List_case (Inl Unity) (%N1 N2. Inr(<N1, <NIL,N2>>))) \
   6.135 +\                      (%M1 M2 N. Inr(<M1, <M2,N>>))))"
   6.136 +
   6.137 +  lappend_def
   6.138 +   "lappend l n == llist_corec <l,n>	   				     \
   6.139 +\   (split(llist_case (llist_case (Inl Unity) (%n1 n2. Inr(<n1, <LNil,n2>>))) \
   6.140 +\                     (%l1 l2 n. Inr(<l1, <l2,n>>))))"
   6.141 +
   6.142 +rules
   6.143 +    (*faking a type definition...*)
   6.144 +  Rep_llist 	    "Rep_llist(xs): llist(range(Leaf))"
   6.145 +  Rep_llist_inverse "Abs_llist(Rep_llist(xs)) = xs"
   6.146 +  Abs_llist_inverse "M: llist(range(Leaf)) ==> Rep_llist(Abs_llist(M)) = M"
   6.147 +
   6.148 +end
     7.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     7.2 +++ b/src/HOL/ex/LexProd.ML	Wed Mar 22 12:42:34 1995 +0100
     7.3 @@ -0,0 +1,24 @@
     7.4 +(*  Title: 	HOL/ex/lex-prod.ML
     7.5 +    ID:         $Id$
     7.6 +    Author: 	Tobias Nipkow, TU Munich
     7.7 +    Copyright   1993  TU Munich
     7.8 +
     7.9 +For lex-prod.thy.
    7.10 +The lexicographic product of two wellfounded relations is again wellfounded.
    7.11 +*)
    7.12 +
    7.13 +val prems = goal Prod.thy "!a b. P(<a,b>) ==> !p.P(p)";
    7.14 +by (cut_facts_tac prems 1);
    7.15 +by (rtac allI 1);
    7.16 +by (rtac (surjective_pairing RS ssubst) 1);
    7.17 +by (fast_tac HOL_cs 1);
    7.18 +qed "split_all_pair";
    7.19 +
    7.20 +val [wfa,wfb] = goalw LexProd.thy [wf_def,LexProd.lex_prod_def]
    7.21 + "[| wf(ra); wf(rb) |] ==> wf(ra**rb)";
    7.22 +by (EVERY1 [rtac allI,rtac impI, rtac split_all_pair]);
    7.23 +by (rtac (wfa RS spec RS mp) 1);
    7.24 +by (EVERY1 [rtac allI,rtac impI]);
    7.25 +by (rtac (wfb RS spec RS mp) 1);
    7.26 +by (fast_tac (set_cs addSEs [Pair_inject]) 1);
    7.27 +qed "wf_lex_prod";
     8.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     8.2 +++ b/src/HOL/ex/LexProd.thy	Wed Mar 22 12:42:34 1995 +0100
     8.3 @@ -0,0 +1,15 @@
     8.4 +(*  Title: 	HOL/ex/lex-prod.thy
     8.5 +    ID:         $Id$
     8.6 +    Author: 	Tobias Nipkow, TU Munich
     8.7 +    Copyright   1993  TU Munich
     8.8 +
     8.9 +The lexicographic product of two relations.
    8.10 +*)
    8.11 +
    8.12 +LexProd = WF + Prod +
    8.13 +consts "**" :: "[('a*'a)set, ('b*'b)set] => (('a*'b)*('a*'b))set" (infixl 70)
    8.14 +rules
    8.15 +lex_prod_def "ra**rb == {p. ? a a' b b'. \
    8.16 +\	p = <<a,b>,<a',b'>> & (<a,a'> : ra | a=a' & <b,b'> : rb)}"
    8.17 +end
    8.18 +
     9.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     9.2 +++ b/src/HOL/ex/MT.ML	Wed Mar 22 12:42:34 1995 +0100
     9.3 @@ -0,0 +1,826 @@
     9.4 +(*  Title: 	HOL/ex/mt.ML
     9.5 +    ID:         $Id$
     9.6 +    Author: 	Jacob Frost, Cambridge University Computer Laboratory
     9.7 +    Copyright   1993  University of Cambridge
     9.8 +
     9.9 +Based upon the article
    9.10 +    Robin Milner and Mads Tofte,
    9.11 +    Co-induction in Relational Semantics,
    9.12 +    Theoretical Computer Science 87 (1991), pages 209-220.
    9.13 +
    9.14 +Written up as
    9.15 +    Jacob Frost, A Case Study of Co-induction in Isabelle/HOL
    9.16 +    Report 308, Computer Lab, University of Cambridge (1993).
    9.17 +*)
    9.18 +
    9.19 +open MT;
    9.20 +
    9.21 +val prems = goal MT.thy "~a:{b} ==> ~a=b";
    9.22 +by (cut_facts_tac prems 1);
    9.23 +by (rtac notI 1);
    9.24 +by (dtac notE 1);
    9.25 +by (hyp_subst_tac 1);
    9.26 +by (rtac singletonI 1);
    9.27 +by (assume_tac 1);
    9.28 +qed "notsingletonI";
    9.29 +
    9.30 +val prems = goalw MT.thy [Un_def]
    9.31 +  "[| c : A Un B; c : A & ~c : B ==> P; c : B ==> P |] ==> P";
    9.32 +by (cut_facts_tac prems 1);bd CollectD 1;be disjE 1;
    9.33 +by (cut_facts_tac [excluded_middle] 1);be disjE 1;
    9.34 +by (resolve_tac prems 1);br conjI 1;ba 1;ba 1;
    9.35 +by (eresolve_tac prems 1);
    9.36 +by (eresolve_tac prems 1);
    9.37 +qed "UnSE";
    9.38 +
    9.39 +(* ############################################################ *)
    9.40 +(* Inference systems                                            *)
    9.41 +(* ############################################################ *)
    9.42 +
    9.43 +val infsys_mono_tac =
    9.44 +  (rewtac subset_def) THEN (safe_tac HOL_cs) THEN (rtac ballI 1) THEN
    9.45 +  (rtac CollectI 1) THEN (dtac CollectD 1) THEN
    9.46 +  REPEAT 
    9.47 +    ( (TRY ((etac disjE 1) THEN (rtac disjI2 2) THEN (rtac disjI1 1))) THEN
    9.48 +      (REPEAT (etac exE 1)) THEN (REPEAT (rtac exI 1)) THEN (fast_tac set_cs 1)
    9.49 +    );
    9.50 +
    9.51 +val prems = goal MT.thy "P a b ==> P (fst <a,b>) (snd <a,b>)";
    9.52 +by (rtac (fst_conv RS ssubst) 1);
    9.53 +by (rtac (snd_conv RS ssubst) 1);
    9.54 +by (resolve_tac prems 1);
    9.55 +qed "infsys_p1";
    9.56 +
    9.57 +val prems = goal MT.thy "P (fst <a,b>) (snd <a,b>) ==> P a b";
    9.58 +by (cut_facts_tac prems 1);
    9.59 +by (dtac (fst_conv RS subst) 1);
    9.60 +by (dtac (snd_conv RS subst) 1);
    9.61 +by (assume_tac 1);
    9.62 +qed "infsys_p2";
    9.63 +
    9.64 +val prems = goal MT.thy 
    9.65 +  "P a b c ==> P (fst(fst <<a,b>,c>)) (snd(fst <<a,b>,c>)) (snd <<a,b>,c>)";
    9.66 +by (rtac (fst_conv RS ssubst) 1);
    9.67 +by (rtac (fst_conv RS ssubst) 1);
    9.68 +by (rtac (snd_conv RS ssubst) 1);
    9.69 +by (rtac (snd_conv RS ssubst) 1);
    9.70 +by (resolve_tac prems 1);
    9.71 +qed "infsys_pp1";
    9.72 +
    9.73 +val prems = goal MT.thy 
    9.74 +  "P (fst(fst <<a,b>,c>)) (snd(fst <<a,b>,c>)) (snd <<a,b>,c>) ==> P a b c";
    9.75 +by (cut_facts_tac prems 1);
    9.76 +by (dtac (fst_conv RS subst) 1);
    9.77 +by (dtac (fst_conv RS subst) 1);
    9.78 +by (dtac (snd_conv RS subst) 1);
    9.79 +by (dtac (snd_conv RS subst) 1);
    9.80 +by (assume_tac 1);
    9.81 +qed "infsys_pp2";
    9.82 +
    9.83 +(* ############################################################ *)
    9.84 +(* Fixpoints                                                    *)
    9.85 +(* ############################################################ *)
    9.86 +
    9.87 +(* Least fixpoints *)
    9.88 +
    9.89 +val prems = goal MT.thy "[| mono(f); x:f(lfp(f)) |] ==> x:lfp(f)";
    9.90 +by (rtac subsetD 1);
    9.91 +by (rtac lfp_lemma2 1);
    9.92 +by (resolve_tac prems 1);brs prems 1;
    9.93 +qed "lfp_intro2";
    9.94 +
    9.95 +val prems = goal MT.thy
    9.96 +  " [| x:lfp(f); mono(f); !!y. y:f(lfp(f)) ==> P(y) |] ==> \
    9.97 +\   P(x)";
    9.98 +by (cut_facts_tac prems 1);
    9.99 +by (resolve_tac prems 1);br subsetD 1;
   9.100 +by (rtac lfp_lemma3 1);ba 1;ba 1;
   9.101 +qed "lfp_elim2";
   9.102 +
   9.103 +val prems = goal MT.thy
   9.104 +  " [| x:lfp(f); mono(f); !!y. y:f(lfp(f) Int {x.P(x)}) ==> P(y) |] ==> \
   9.105 +\   P(x)";
   9.106 +by (cut_facts_tac prems 1);
   9.107 +by (etac induct 1);ba 1;
   9.108 +by (eresolve_tac prems 1);
   9.109 +qed "lfp_ind2";
   9.110 +
   9.111 +(* Greatest fixpoints *)
   9.112 +
   9.113 +(* Note : "[| x:S; S <= f(S Un gfp(f)); mono(f) |] ==> x:gfp(f)" *)
   9.114 +
   9.115 +val [cih,monoh] = goal MT.thy "[| x:f({x} Un gfp(f)); mono(f) |] ==> x:gfp(f)";
   9.116 +by (rtac (cih RSN (2,gfp_upperbound RS subsetD)) 1);
   9.117 +by (rtac (monoh RS monoD) 1);
   9.118 +by (rtac (UnE RS subsetI) 1);ba 1;
   9.119 +by (fast_tac (set_cs addSIs [cih]) 1);
   9.120 +by (rtac (monoh RS monoD RS subsetD) 1);
   9.121 +by (rtac Un_upper2 1);
   9.122 +by (etac (monoh RS gfp_lemma2 RS subsetD) 1);
   9.123 +qed "gfp_coind2";
   9.124 +
   9.125 +val [gfph,monoh,caseh] = goal MT.thy 
   9.126 +  "[| x:gfp(f); mono(f); !! y. y:f(gfp(f)) ==> P(y) |] ==> P(x)";
   9.127 +by (rtac caseh 1);br subsetD 1;br gfp_lemma2 1;br monoh 1;br gfph 1;
   9.128 +qed "gfp_elim2";
   9.129 +
   9.130 +(* ############################################################ *)
   9.131 +(* Expressions                                                  *)
   9.132 +(* ############################################################ *)
   9.133 +
   9.134 +val e_injs = [e_const_inj, e_var_inj, e_fn_inj, e_fix_inj, e_app_inj];
   9.135 +
   9.136 +val e_disjs = 
   9.137 +  [ e_disj_const_var, 
   9.138 +    e_disj_const_fn, 
   9.139 +    e_disj_const_fix, 
   9.140 +    e_disj_const_app,
   9.141 +    e_disj_var_fn, 
   9.142 +    e_disj_var_fix, 
   9.143 +    e_disj_var_app, 
   9.144 +    e_disj_fn_fix, 
   9.145 +    e_disj_fn_app, 
   9.146 +    e_disj_fix_app
   9.147 +  ];
   9.148 +
   9.149 +val e_disj_si = e_disjs @ (e_disjs RL [not_sym]);
   9.150 +val e_disj_se = (e_disj_si RL [notE]);
   9.151 +
   9.152 +fun e_ext_cs cs = cs addSIs e_disj_si addSEs e_disj_se addSDs e_injs;
   9.153 +
   9.154 +(* ############################################################ *)
   9.155 +(* Values                                                      *)
   9.156 +(* ############################################################ *)
   9.157 +
   9.158 +val v_disjs = [v_disj_const_clos];
   9.159 +val v_disj_si = v_disjs @ (v_disjs RL [not_sym]);
   9.160 +val v_disj_se = (v_disj_si RL [notE]);
   9.161 +
   9.162 +val v_injs = [v_const_inj, v_clos_inj];
   9.163 +
   9.164 +fun v_ext_cs cs  = cs addSIs v_disj_si addSEs v_disj_se addSDs v_injs;
   9.165 +
   9.166 +(* ############################################################ *)
   9.167 +(* Evaluations                                                  *)
   9.168 +(* ############################################################ *)
   9.169 +
   9.170 +(* Monotonicity of eval_fun *)
   9.171 +
   9.172 +goalw MT.thy [mono_def, eval_fun_def] "mono(eval_fun)";
   9.173 +by infsys_mono_tac;
   9.174 +qed "eval_fun_mono";
   9.175 +
   9.176 +(* Introduction rules *)
   9.177 +
   9.178 +goalw MT.thy [eval_def, eval_rel_def] "ve |- e_const(c) ---> v_const(c)";
   9.179 +by (rtac lfp_intro2 1);
   9.180 +by (rtac eval_fun_mono 1);
   9.181 +by (rewtac eval_fun_def);
   9.182 +by (rtac CollectI 1);br disjI1 1;
   9.183 +by (fast_tac HOL_cs 1);
   9.184 +qed "eval_const";
   9.185 +
   9.186 +val prems = goalw MT.thy [eval_def, eval_rel_def] 
   9.187 +  "ev:ve_dom(ve) ==> ve |- e_var(ev) ---> ve_app ve ev";
   9.188 +by (cut_facts_tac prems 1);
   9.189 +by (rtac lfp_intro2 1);
   9.190 +by (rtac eval_fun_mono 1);
   9.191 +by (rewtac eval_fun_def);
   9.192 +by (rtac CollectI 1);br disjI2 1;br disjI1 1;
   9.193 +by (fast_tac HOL_cs 1);
   9.194 +qed "eval_var";
   9.195 +
   9.196 +val prems = goalw MT.thy [eval_def, eval_rel_def] 
   9.197 +  "ve |- fn ev => e ---> v_clos(<|ev,e,ve|>)";
   9.198 +by (cut_facts_tac prems 1);
   9.199 +by (rtac lfp_intro2 1);
   9.200 +by (rtac eval_fun_mono 1);
   9.201 +by (rewtac eval_fun_def);
   9.202 +by (rtac CollectI 1);br disjI2 1;br disjI2 1;br disjI1 1;
   9.203 +by (fast_tac HOL_cs 1);
   9.204 +qed "eval_fn";
   9.205 +
   9.206 +val prems = goalw MT.thy [eval_def, eval_rel_def] 
   9.207 +  " cl = <| ev1, e, ve + {ev2 |-> v_clos(cl)} |> ==> \
   9.208 +\   ve |- fix ev2(ev1) = e ---> v_clos(cl)";
   9.209 +by (cut_facts_tac prems 1);
   9.210 +by (rtac lfp_intro2 1);
   9.211 +by (rtac eval_fun_mono 1);
   9.212 +by (rewtac eval_fun_def);
   9.213 +by (rtac CollectI 1);br disjI2 1;br disjI2 1;br disjI2 1;br disjI1 1;
   9.214 +by (fast_tac HOL_cs 1);
   9.215 +qed "eval_fix";
   9.216 +
   9.217 +val prems = goalw MT.thy [eval_def, eval_rel_def]
   9.218 +  " [| ve |- e1 ---> v_const(c1); ve |- e2 ---> v_const(c2) |] ==> \
   9.219 +\   ve |- e1 @ e2 ---> v_const(c_app c1 c2)";
   9.220 +by (cut_facts_tac prems 1);
   9.221 +by (rtac lfp_intro2 1);
   9.222 +by (rtac eval_fun_mono 1);
   9.223 +by (rewtac eval_fun_def);
   9.224 +by (rtac CollectI 1);br disjI2 1;br disjI2 1;br disjI2 1;br disjI2 1;br disjI1 1;
   9.225 +by (fast_tac HOL_cs 1);
   9.226 +qed "eval_app1";
   9.227 +
   9.228 +val prems = goalw MT.thy [eval_def, eval_rel_def] 
   9.229 +  " [|  ve |- e1 ---> v_clos(<|xm,em,vem|>); \
   9.230 +\       ve |- e2 ---> v2; \
   9.231 +\       vem + {xm |-> v2} |- em ---> v \
   9.232 +\   |] ==> \
   9.233 +\   ve |- e1 @ e2 ---> v";
   9.234 +by (cut_facts_tac prems 1);
   9.235 +by (rtac lfp_intro2 1);
   9.236 +by (rtac eval_fun_mono 1);
   9.237 +by (rewtac eval_fun_def);
   9.238 +by (rtac CollectI 1);br disjI2 1;br disjI2 1;br disjI2 1;br disjI2 1;br disjI2 1;
   9.239 +by (fast_tac HOL_cs 1);
   9.240 +qed "eval_app2";
   9.241 +
   9.242 +(* Strong elimination, induction on evaluations *)
   9.243 +
   9.244 +val prems = goalw MT.thy [eval_def, eval_rel_def]
   9.245 +  " [| ve |- e ---> v; \
   9.246 +\      !!ve c. P(<<ve,e_const(c)>,v_const(c)>); \
   9.247 +\      !!ev ve. ev:ve_dom(ve) ==> P(<<ve,e_var(ev)>,ve_app ve ev>); \
   9.248 +\      !!ev ve e. P(<<ve,fn ev => e>,v_clos(<|ev,e,ve|>)>); \
   9.249 +\      !!ev1 ev2 ve cl e. \
   9.250 +\        cl = <| ev1, e, ve + {ev2 |-> v_clos(cl)} |> ==> \
   9.251 +\        P(<<ve,fix ev2(ev1) = e>,v_clos(cl)>); \
   9.252 +\      !!ve c1 c2 e1 e2. \
   9.253 +\        [| P(<<ve,e1>,v_const(c1)>); P(<<ve,e2>,v_const(c2)>) |] ==> \
   9.254 +\        P(<<ve,e1 @ e2>,v_const(c_app c1 c2)>); \
   9.255 +\      !!ve vem xm e1 e2 em v v2. \
   9.256 +\        [|  P(<<ve,e1>,v_clos(<|xm,em,vem|>)>); \
   9.257 +\            P(<<ve,e2>,v2>); \
   9.258 +\            P(<<vem + {xm |-> v2},em>,v>) \
   9.259 +\        |] ==> \
   9.260 +\        P(<<ve,e1 @ e2>,v>) \
   9.261 +\   |] ==> \
   9.262 +\   P(<<ve,e>,v>)";
   9.263 +by (resolve_tac (prems RL [lfp_ind2]) 1);
   9.264 +by (rtac eval_fun_mono 1);
   9.265 +by (rewtac eval_fun_def);
   9.266 +by (dtac CollectD 1);
   9.267 +by (safe_tac HOL_cs);
   9.268 +by (ALLGOALS (resolve_tac prems));
   9.269 +by (ALLGOALS (fast_tac set_cs));
   9.270 +qed "eval_ind0";
   9.271 +
   9.272 +val prems = goal MT.thy 
   9.273 +  " [| ve |- e ---> v; \
   9.274 +\      !!ve c. P ve (e_const c) (v_const c); \
   9.275 +\      !!ev ve. ev:ve_dom(ve) ==> P ve (e_var ev) (ve_app ve ev); \
   9.276 +\      !!ev ve e. P ve (fn ev => e) (v_clos <|ev,e,ve|>); \
   9.277 +\      !!ev1 ev2 ve cl e. \
   9.278 +\        cl = <| ev1, e, ve + {ev2 |-> v_clos(cl)} |> ==> \
   9.279 +\        P ve (fix ev2(ev1) = e) (v_clos cl); \
   9.280 +\      !!ve c1 c2 e1 e2. \
   9.281 +\        [| P ve e1 (v_const c1); P ve e2 (v_const c2) |] ==> \
   9.282 +\        P ve (e1 @ e2) (v_const(c_app c1 c2)); \
   9.283 +\      !!ve vem evm e1 e2 em v v2. \
   9.284 +\        [|  P ve e1 (v_clos <|evm,em,vem|>); \
   9.285 +\            P ve e2 v2; \
   9.286 +\            P (vem + {evm |-> v2}) em v \
   9.287 +\        |] ==> P ve (e1 @ e2) v \
   9.288 +\   |] ==> P ve e v";
   9.289 +by (res_inst_tac [("P","P")] infsys_pp2 1);
   9.290 +by (rtac eval_ind0 1);
   9.291 +by (ALLGOALS (rtac infsys_pp1));
   9.292 +by (ALLGOALS (resolve_tac prems));
   9.293 +by (REPEAT ((assume_tac 1) ORELSE (dtac infsys_pp2 1)));
   9.294 +qed "eval_ind";
   9.295 +
   9.296 +(* ############################################################ *)
   9.297 +(* Elaborations                                                 *)
   9.298 +(* ############################################################ *)
   9.299 +
   9.300 +goalw MT.thy [mono_def, elab_fun_def] "mono(elab_fun)";
   9.301 +by infsys_mono_tac;
   9.302 +qed "elab_fun_mono";
   9.303 +
   9.304 +(* Introduction rules *)
   9.305 +
   9.306 +val prems = goalw MT.thy [elab_def, elab_rel_def] 
   9.307 +  "c isof ty ==> te |- e_const(c) ===> ty";
   9.308 +by (cut_facts_tac prems 1);
   9.309 +by (rtac lfp_intro2 1);
   9.310 +by (rtac elab_fun_mono 1);
   9.311 +by (rewtac elab_fun_def);
   9.312 +by (rtac CollectI 1);br disjI1 1;
   9.313 +by (fast_tac HOL_cs 1);
   9.314 +qed "elab_const";
   9.315 +
   9.316 +val prems = goalw MT.thy [elab_def, elab_rel_def] 
   9.317 +  "x:te_dom(te) ==> te |- e_var(x) ===> te_app te x";
   9.318 +by (cut_facts_tac prems 1);
   9.319 +by (rtac lfp_intro2 1);
   9.320 +by (rtac elab_fun_mono 1);
   9.321 +by (rewtac elab_fun_def);
   9.322 +by (rtac CollectI 1);br disjI2 1;br disjI1 1;
   9.323 +by (fast_tac HOL_cs 1);
   9.324 +qed "elab_var";
   9.325 +
   9.326 +val prems = goalw MT.thy [elab_def, elab_rel_def] 
   9.327 +  "te + {x |=> ty1} |- e ===> ty2 ==> te |- fn x => e ===> ty1->ty2";
   9.328 +by (cut_facts_tac prems 1);
   9.329 +by (rtac lfp_intro2 1);
   9.330 +by (rtac elab_fun_mono 1);
   9.331 +by (rewtac elab_fun_def);
   9.332 +by (rtac CollectI 1);br disjI2 1;br disjI2 1;br disjI1 1;
   9.333 +by (fast_tac HOL_cs 1);
   9.334 +qed "elab_fn";
   9.335 +
   9.336 +val prems = goalw MT.thy [elab_def, elab_rel_def]
   9.337 +  " te + {f |=> ty1->ty2} + {x |=> ty1} |- e ===> ty2 ==> \
   9.338 +\   te |- fix f(x) = e ===> ty1->ty2";
   9.339 +by (cut_facts_tac prems 1);
   9.340 +by (rtac lfp_intro2 1);
   9.341 +by (rtac elab_fun_mono 1);
   9.342 +by (rewtac elab_fun_def);
   9.343 +by (rtac CollectI 1);br disjI2 1;br disjI2 1;br disjI2 1;br disjI1 1;
   9.344 +by (fast_tac HOL_cs 1);
   9.345 +qed "elab_fix";
   9.346 +
   9.347 +val prems = goalw MT.thy [elab_def, elab_rel_def] 
   9.348 +  " [| te |- e1 ===> ty1->ty2; te |- e2 ===> ty1 |] ==> \
   9.349 +\   te |- e1 @ e2 ===> ty2";
   9.350 +by (cut_facts_tac prems 1);
   9.351 +by (rtac lfp_intro2 1);
   9.352 +by (rtac elab_fun_mono 1);
   9.353 +by (rewtac elab_fun_def);
   9.354 +by (rtac CollectI 1);br disjI2 1;br disjI2 1;br disjI2 1;br disjI2 1;
   9.355 +by (fast_tac HOL_cs 1);
   9.356 +qed "elab_app";
   9.357 +
   9.358 +(* Strong elimination, induction on elaborations *)
   9.359 +
   9.360 +val prems = goalw MT.thy [elab_def, elab_rel_def]
   9.361 +  " [| te |- e ===> t; \
   9.362 +\      !!te c t. c isof t ==> P(<<te,e_const(c)>,t>); \
   9.363 +\      !!te x. x:te_dom(te) ==> P(<<te,e_var(x)>,te_app te x>); \
   9.364 +\      !!te x e t1 t2. \
   9.365 +\        [| te + {x |=> t1} |- e ===> t2; P(<<te + {x |=> t1},e>,t2>) |] ==> \
   9.366 +\        P(<<te,fn x => e>,t1->t2>); \
   9.367 +\      !!te f x e t1 t2. \
   9.368 +\        [| te + {f |=> t1->t2} + {x |=> t1} |- e ===> t2; \
   9.369 +\           P(<<te + {f |=> t1->t2} + {x |=> t1},e>,t2>) \
   9.370 +\        |] ==> \
   9.371 +\        P(<<te,fix f(x) = e>,t1->t2>); \
   9.372 +\      !!te e1 e2 t1 t2. \
   9.373 +\        [| te |- e1 ===> t1->t2; P(<<te,e1>,t1->t2>); \
   9.374 +\           te |- e2 ===> t1; P(<<te,e2>,t1>) \
   9.375 +\        |] ==> \
   9.376 +\        P(<<te,e1 @ e2>,t2>) \
   9.377 +\   |] ==> \
   9.378 +\   P(<<te,e>,t>)";
   9.379 +by (resolve_tac (prems RL [lfp_ind2]) 1);
   9.380 +by (rtac elab_fun_mono 1);
   9.381 +by (rewtac elab_fun_def);
   9.382 +by (dtac CollectD 1);
   9.383 +by (safe_tac HOL_cs);
   9.384 +by (ALLGOALS (resolve_tac prems));
   9.385 +by (ALLGOALS (fast_tac set_cs));
   9.386 +qed "elab_ind0";
   9.387 +
   9.388 +val prems = goal MT.thy
   9.389 +  " [| te |- e ===> t; \
   9.390 +\       !!te c t. c isof t ==> P te (e_const c) t; \
   9.391 +\      !!te x. x:te_dom(te) ==> P te (e_var x) (te_app te x); \
   9.392 +\      !!te x e t1 t2. \
   9.393 +\        [| te + {x |=> t1} |- e ===> t2; P (te + {x |=> t1}) e t2 |] ==> \
   9.394 +\        P te (fn x => e) (t1->t2); \
   9.395 +\      !!te f x e t1 t2. \
   9.396 +\        [| te + {f |=> t1->t2} + {x |=> t1} |- e ===> t2; \
   9.397 +\           P (te + {f |=> t1->t2} + {x |=> t1}) e t2 \
   9.398 +\        |] ==> \
   9.399 +\        P te (fix f(x) = e) (t1->t2); \
   9.400 +\      !!te e1 e2 t1 t2. \
   9.401 +\        [| te |- e1 ===> t1->t2; P te e1 (t1->t2); \
   9.402 +\           te |- e2 ===> t1; P te e2 t1 \
   9.403 +\        |] ==> \
   9.404 +\        P te (e1 @ e2) t2 \ 
   9.405 +\   |] ==> \
   9.406 +\   P te e t";
   9.407 +by (res_inst_tac [("P","P")] infsys_pp2 1);
   9.408 +by (rtac elab_ind0 1);
   9.409 +by (ALLGOALS (rtac infsys_pp1));
   9.410 +by (ALLGOALS (resolve_tac prems));
   9.411 +by (REPEAT ((assume_tac 1) ORELSE (dtac infsys_pp2 1)));
   9.412 +qed "elab_ind";
   9.413 +
   9.414 +(* Weak elimination, case analysis on elaborations *)
   9.415 +
   9.416 +val prems = goalw MT.thy [elab_def, elab_rel_def]
   9.417 +  " [| te |- e ===> t; \
   9.418 +\      !!te c t. c isof t ==> P(<<te,e_const(c)>,t>); \
   9.419 +\      !!te x. x:te_dom(te) ==> P(<<te,e_var(x)>,te_app te x>); \
   9.420 +\      !!te x e t1 t2. \
   9.421 +\        te + {x |=> t1} |- e ===> t2 ==> P(<<te,fn x => e>,t1->t2>); \
   9.422 +\      !!te f x e t1 t2. \
   9.423 +\        te + {f |=> t1->t2} + {x |=> t1} |- e ===> t2 ==> \
   9.424 +\        P(<<te,fix f(x) = e>,t1->t2>); \
   9.425 +\      !!te e1 e2 t1 t2. \
   9.426 +\        [| te |- e1 ===> t1->t2; te |- e2 ===> t1 |] ==> \
   9.427 +\        P(<<te,e1 @ e2>,t2>) \
   9.428 +\   |] ==> \
   9.429 +\   P(<<te,e>,t>)";
   9.430 +by (resolve_tac (prems RL [lfp_elim2]) 1);
   9.431 +by (rtac elab_fun_mono 1);
   9.432 +by (rewtac elab_fun_def);
   9.433 +by (dtac CollectD 1);
   9.434 +by (safe_tac HOL_cs);
   9.435 +by (ALLGOALS (resolve_tac prems));
   9.436 +by (ALLGOALS (fast_tac set_cs));
   9.437 +qed "elab_elim0";
   9.438 +
   9.439 +val prems = goal MT.thy
   9.440 +  " [| te |- e ===> t; \
   9.441 +\       !!te c t. c isof t ==> P te (e_const c) t; \
   9.442 +\      !!te x. x:te_dom(te) ==> P te (e_var x) (te_app te x); \
   9.443 +\      !!te x e t1 t2. \
   9.444 +\        te + {x |=> t1} |- e ===> t2 ==> P te (fn x => e) (t1->t2); \
   9.445 +\      !!te f x e t1 t2. \
   9.446 +\        te + {f |=> t1->t2} + {x |=> t1} |- e ===> t2 ==> \
   9.447 +\        P te (fix f(x) = e) (t1->t2); \
   9.448 +\      !!te e1 e2 t1 t2. \
   9.449 +\        [| te |- e1 ===> t1->t2; te |- e2 ===> t1 |] ==> \
   9.450 +\        P te (e1 @ e2) t2 \ 
   9.451 +\   |] ==> \
   9.452 +\   P te e t";
   9.453 +by (res_inst_tac [("P","P")] infsys_pp2 1);
   9.454 +by (rtac elab_elim0 1);
   9.455 +by (ALLGOALS (rtac infsys_pp1));
   9.456 +by (ALLGOALS (resolve_tac prems));
   9.457 +by (REPEAT ((assume_tac 1) ORELSE (dtac infsys_pp2 1)));
   9.458 +qed "elab_elim";
   9.459 +
   9.460 +(* Elimination rules for each expression *)
   9.461 +
   9.462 +fun elab_e_elim_tac p = 
   9.463 +  ( (rtac elab_elim 1) THEN 
   9.464 +    (resolve_tac p 1) THEN 
   9.465 +    (REPEAT (fast_tac (e_ext_cs HOL_cs) 1))
   9.466 +  );
   9.467 +
   9.468 +val prems = goal MT.thy "te |- e ===> t ==> (e = e_const(c) --> c isof t)";
   9.469 +by (elab_e_elim_tac prems);
   9.470 +qed "elab_const_elim_lem";
   9.471 +
   9.472 +val prems = goal MT.thy "te |- e_const(c) ===> t ==> c isof t";
   9.473 +by (cut_facts_tac prems 1);
   9.474 +by (dtac elab_const_elim_lem 1);
   9.475 +by (fast_tac prop_cs 1);
   9.476 +qed "elab_const_elim";
   9.477 +
   9.478 +val prems = goal MT.thy 
   9.479 +  "te |- e ===> t ==> (e = e_var(x) --> t=te_app te x & x:te_dom(te))";
   9.480 +by (elab_e_elim_tac prems);
   9.481 +qed "elab_var_elim_lem";
   9.482 +
   9.483 +val prems = goal MT.thy 
   9.484 +  "te |- e_var(ev) ===> t ==> t=te_app te ev & ev : te_dom(te)";
   9.485 +by (cut_facts_tac prems 1);
   9.486 +by (dtac elab_var_elim_lem 1);
   9.487 +by (fast_tac prop_cs 1);
   9.488 +qed "elab_var_elim";
   9.489 +
   9.490 +val prems = goal MT.thy 
   9.491 +  " te |- e ===> t ==> \
   9.492 +\   ( e = fn x1 => e1 --> \
   9.493 +\     (? t1 t2.t=t_fun t1 t2 & te + {x1 |=> t1} |- e1 ===> t2) \
   9.494 +\   )";
   9.495 +by (elab_e_elim_tac prems);
   9.496 +qed "elab_fn_elim_lem";
   9.497 +
   9.498 +val prems = goal MT.thy 
   9.499 +  " te |- fn x1 => e1 ===> t ==> \
   9.500 +\   (? t1 t2. t=t1->t2 & te + {x1 |=> t1} |- e1 ===> t2)";
   9.501 +by (cut_facts_tac prems 1);
   9.502 +by (dtac elab_fn_elim_lem 1);
   9.503 +by (fast_tac prop_cs 1);
   9.504 +qed "elab_fn_elim";
   9.505 +
   9.506 +val prems = goal MT.thy 
   9.507 +  " te |- e ===> t ==> \
   9.508 +\   (e = fix f(x) = e1 --> \
   9.509 +\   (? t1 t2. t=t1->t2 & te + {f |=> t1->t2} + {x |=> t1} |- e1 ===> t2))"; 
   9.510 +by (elab_e_elim_tac prems);
   9.511 +qed "elab_fix_elim_lem";
   9.512 +
   9.513 +val prems = goal MT.thy 
   9.514 +  " te |- fix ev1(ev2) = e1 ===> t ==> \
   9.515 +\   (? t1 t2. t=t1->t2 & te + {ev1 |=> t1->t2} + {ev2 |=> t1} |- e1 ===> t2)";
   9.516 +by (cut_facts_tac prems 1);
   9.517 +by (dtac elab_fix_elim_lem 1);
   9.518 +by (fast_tac prop_cs 1);
   9.519 +qed "elab_fix_elim";
   9.520 +
   9.521 +val prems = goal MT.thy 
   9.522 +  " te |- e ===> t2 ==> \
   9.523 +\   (e = e1 @ e2 --> (? t1 . te |- e1 ===> t1->t2 & te |- e2 ===> t1))"; 
   9.524 +by (elab_e_elim_tac prems);
   9.525 +qed "elab_app_elim_lem";
   9.526 +
   9.527 +val prems = goal MT.thy 
   9.528 +  "te |- e1 @ e2 ===> t2 ==> (? t1 . te |- e1 ===> t1->t2 & te |- e2 ===> t1)"; 
   9.529 +by (cut_facts_tac prems 1);
   9.530 +by (dtac elab_app_elim_lem 1);
   9.531 +by (fast_tac prop_cs 1);
   9.532 +qed "elab_app_elim";
   9.533 +
   9.534 +(* ############################################################ *)
   9.535 +(* The extended correspondence relation                       *)
   9.536 +(* ############################################################ *)
   9.537 +
   9.538 +(* Monotonicity of hasty_fun *)
   9.539 +
   9.540 +goalw MT.thy [mono_def,MT.hasty_fun_def] "mono(hasty_fun)";
   9.541 +by infsys_mono_tac;
   9.542 +bind_thm("mono_hasty_fun",  result());
   9.543 +
   9.544 +(* 
   9.545 +  Because hasty_rel has been defined as the greatest fixpoint of hasty_fun it 
   9.546 +  enjoys two strong indtroduction (co-induction) rules and an elimination rule.
   9.547 +*)
   9.548 +
   9.549 +(* First strong indtroduction (co-induction) rule for hasty_rel *)
   9.550 +
   9.551 +val prems = goalw MT.thy [hasty_rel_def] "c isof t ==> <v_const(c),t> : hasty_rel";
   9.552 +by (cut_facts_tac prems 1);
   9.553 +by (rtac gfp_coind2 1);
   9.554 +by (rewtac MT.hasty_fun_def);
   9.555 +by (rtac CollectI 1);br disjI1 1;
   9.556 +by (fast_tac HOL_cs 1);
   9.557 +by (rtac mono_hasty_fun 1);
   9.558 +qed "hasty_rel_const_coind";
   9.559 +
   9.560 +(* Second strong introduction (co-induction) rule for hasty_rel *)
   9.561 +
   9.562 +val prems = goalw MT.thy [hasty_rel_def]
   9.563 +  " [|  te |- fn ev => e ===> t; \
   9.564 +\       ve_dom(ve) = te_dom(te); \
   9.565 +\       ! ev1. \
   9.566 +\         ev1:ve_dom(ve) --> \
   9.567 +\         <ve_app ve ev1,te_app te ev1> : {<v_clos(<|ev,e,ve|>),t>} Un hasty_rel \
   9.568 +\   |] ==> \
   9.569 +\   <v_clos(<|ev,e,ve|>),t> : hasty_rel";
   9.570 +by (cut_facts_tac prems 1);
   9.571 +by (rtac gfp_coind2 1);
   9.572 +by (rewtac hasty_fun_def);
   9.573 +by (rtac CollectI 1);br disjI2 1;
   9.574 +by (fast_tac HOL_cs 1);
   9.575 +by (rtac mono_hasty_fun 1);
   9.576 +qed "hasty_rel_clos_coind";
   9.577 +
   9.578 +(* Elimination rule for hasty_rel *)
   9.579 +
   9.580 +val prems = goalw MT.thy [hasty_rel_def]
   9.581 +  " [| !! c t.c isof t ==> P(<v_const(c),t>); \
   9.582 +\      !! te ev e t ve. \
   9.583 +\        [| te |- fn ev => e ===> t; \
   9.584 +\           ve_dom(ve) = te_dom(te); \
   9.585 +\           !ev1.ev1:ve_dom(ve) --> <ve_app ve ev1,te_app te ev1> : hasty_rel \
   9.586 +\        |] ==> P(<v_clos(<|ev,e,ve|>),t>); \
   9.587 +\      <v,t> : hasty_rel \
   9.588 +\   |] ==> P(<v,t>)";
   9.589 +by (cut_facts_tac prems 1);
   9.590 +by (etac gfp_elim2 1);
   9.591 +by (rtac mono_hasty_fun 1);
   9.592 +by (rewtac hasty_fun_def);
   9.593 +by (dtac CollectD 1);
   9.594 +by (fold_goals_tac [hasty_fun_def]);
   9.595 +by (safe_tac HOL_cs);
   9.596 +by (ALLGOALS (resolve_tac prems));
   9.597 +by (ALLGOALS (fast_tac set_cs));
   9.598 +qed "hasty_rel_elim0";
   9.599 +
   9.600 +val prems = goal MT.thy 
   9.601 +  " [| <v,t> : hasty_rel; \
   9.602 +\      !! c t.c isof t ==> P (v_const c) t; \
   9.603 +\      !! te ev e t ve. \
   9.604 +\        [| te |- fn ev => e ===> t; \
   9.605 +\           ve_dom(ve) = te_dom(te); \
   9.606 +\           !ev1.ev1:ve_dom(ve) --> <ve_app ve ev1,te_app te ev1> : hasty_rel \
   9.607 +\        |] ==> P (v_clos <|ev,e,ve|>) t \
   9.608 +\   |] ==> P v t";
   9.609 +by (res_inst_tac [("P","P")] infsys_p2 1);
   9.610 +by (rtac hasty_rel_elim0 1);
   9.611 +by (ALLGOALS (rtac infsys_p1));
   9.612 +by (ALLGOALS (resolve_tac prems));
   9.613 +by (REPEAT ((assume_tac 1) ORELSE (dtac infsys_p2 1)));
   9.614 +qed "hasty_rel_elim";
   9.615 +
   9.616 +(* Introduction rules for hasty *)
   9.617 +
   9.618 +val prems = goalw MT.thy [hasty_def] "c isof t ==> v_const(c) hasty t";
   9.619 +by (resolve_tac (prems RL [hasty_rel_const_coind]) 1);
   9.620 +qed "hasty_const";
   9.621 +
   9.622 +val prems = goalw MT.thy [hasty_def,hasty_env_def] 
   9.623 +  "te |- fn ev => e ===> t & ve hastyenv te ==> v_clos(<|ev,e,ve|>) hasty t";
   9.624 +by (cut_facts_tac prems 1);
   9.625 +by (rtac hasty_rel_clos_coind 1);
   9.626 +by (ALLGOALS (fast_tac set_cs));
   9.627 +qed "hasty_clos";
   9.628 +
   9.629 +(* Elimination on constants for hasty *)
   9.630 +
   9.631 +val prems = goalw MT.thy [hasty_def] 
   9.632 +  "v hasty t ==> (!c.(v = v_const(c) --> c isof t))";  
   9.633 +by (cut_facts_tac prems 1);
   9.634 +by (rtac hasty_rel_elim 1);
   9.635 +by (ALLGOALS (fast_tac (v_ext_cs HOL_cs)));
   9.636 +qed "hasty_elim_const_lem";
   9.637 +
   9.638 +val prems = goal MT.thy "v_const(c) hasty t ==> c isof t";
   9.639 +by (cut_facts_tac (prems RL [hasty_elim_const_lem]) 1);
   9.640 +by (fast_tac HOL_cs 1);
   9.641 +qed "hasty_elim_const";
   9.642 +
   9.643 +(* Elimination on closures for hasty *)
   9.644 +
   9.645 +val prems = goalw MT.thy [hasty_env_def,hasty_def] 
   9.646 +  " v hasty t ==> \
   9.647 +\   ! x e ve. \
   9.648 +\     v=v_clos(<|x,e,ve|>) --> (? te.te |- fn x => e ===> t & ve hastyenv te)";
   9.649 +by (cut_facts_tac prems 1);
   9.650 +by (rtac hasty_rel_elim 1);
   9.651 +by (ALLGOALS (fast_tac (v_ext_cs HOL_cs)));
   9.652 +qed "hasty_elim_clos_lem";
   9.653 +
   9.654 +val prems = goal MT.thy 
   9.655 +  "v_clos(<|ev,e,ve|>) hasty t ==> ? te.te |- fn ev => e ===> t & ve hastyenv te ";
   9.656 +by (cut_facts_tac (prems RL [hasty_elim_clos_lem]) 1);
   9.657 +by (fast_tac HOL_cs 1);
   9.658 +qed "hasty_elim_clos";
   9.659 +
   9.660 +(* ############################################################ *)
   9.661 +(* The pointwise extension of hasty to environments             *)
   9.662 +(* ############################################################ *)
   9.663 +
   9.664 +val prems = goal MT.thy
   9.665 +  "[| ve hastyenv te; v hasty t |] ==> \
   9.666 +\  ve + {ev |-> v} hastyenv te + {ev |=> t}";
   9.667 +by (cut_facts_tac prems 1);
   9.668 +by (SELECT_GOAL (rewtac hasty_env_def) 1);
   9.669 +by (safe_tac HOL_cs);
   9.670 +by (rtac (ve_dom_owr RS ssubst) 1);
   9.671 +by (rtac (te_dom_owr RS ssubst) 1);
   9.672 +by (etac subst 1);br refl 1;
   9.673 +
   9.674 +by (dtac (ve_dom_owr RS subst) 1);back();back();back();
   9.675 +by (etac UnSE 1);be conjE 1;
   9.676 +by (dtac notsingletonI 1);bd not_sym 1;
   9.677 +by (rtac (ve_app_owr2 RS ssubst) 1);ba 1;
   9.678 +by (rtac (te_app_owr2 RS ssubst) 1);ba 1;
   9.679 +by (fast_tac HOL_cs 1);
   9.680 +by (dtac singletonD 1);by (hyp_subst_tac 1);
   9.681 +
   9.682 +by (rtac (ve_app_owr1 RS ssubst) 1);
   9.683 +by (rtac (te_app_owr1 RS ssubst) 1);
   9.684 +by (assume_tac 1);
   9.685 +qed "hasty_env1";
   9.686 +
   9.687 +(* ############################################################ *)
   9.688 +(* The Consistency theorem                                      *)
   9.689 +(* ############################################################ *)
   9.690 +
   9.691 +val prems = goal MT.thy 
   9.692 +  "[| ve hastyenv te ; te |- e_const(c) ===> t |] ==> v_const(c) hasty t";
   9.693 +by (cut_facts_tac prems 1);
   9.694 +by (dtac elab_const_elim 1);
   9.695 +by (etac hasty_const 1);
   9.696 +qed "consistency_const";
   9.697 +
   9.698 +val prems = goalw MT.thy [hasty_env_def]
   9.699 +  " [| ev : ve_dom(ve); ve hastyenv te ; te |- e_var(ev) ===> t |] ==> \
   9.700 +\   ve_app ve ev hasty t";
   9.701 +by (cut_facts_tac prems 1);
   9.702 +by (dtac elab_var_elim 1);
   9.703 +by (fast_tac HOL_cs 1);
   9.704 +qed "consistency_var";
   9.705 +
   9.706 +val prems = goal MT.thy
   9.707 +  " [| ve hastyenv te ; te |- fn ev => e ===> t |] ==> \
   9.708 +\   v_clos(<| ev, e, ve |>) hasty t";
   9.709 +by (cut_facts_tac prems 1);
   9.710 +by (rtac hasty_clos 1);
   9.711 +by (fast_tac prop_cs 1);
   9.712 +qed "consistency_fn";
   9.713 +
   9.714 +val prems = goalw MT.thy [hasty_env_def,hasty_def]
   9.715 +  " [| cl = <| ev1, e, ve + { ev2 |-> v_clos(cl) } |>; \
   9.716 +\      ve hastyenv te ; \
   9.717 +\      te |- fix ev2  ev1  = e ===> t \
   9.718 +\   |] ==> \
   9.719 +\   v_clos(cl) hasty t";
   9.720 +by (cut_facts_tac prems 1);
   9.721 +by (dtac elab_fix_elim 1);
   9.722 +by (safe_tac HOL_cs);
   9.723 +by ((forward_tac [ssubst] 1) THEN (assume_tac 2) THEN 
   9.724 +    (rtac hasty_rel_clos_coind 1));
   9.725 +by (etac elab_fn 1);
   9.726 +
   9.727 +by (rtac (ve_dom_owr RS ssubst) 1);
   9.728 +by (rtac (te_dom_owr RS ssubst) 1);
   9.729 +by ((etac subst 1) THEN (rtac refl 1));
   9.730 +
   9.731 +by (rtac (ve_dom_owr RS ssubst) 1);
   9.732 +by (safe_tac HOL_cs);
   9.733 +by (dtac (Un_commute RS subst) 1);
   9.734 +by (etac UnSE 1);
   9.735 +
   9.736 +by (safe_tac HOL_cs);
   9.737 +by (dtac notsingletonI 1);bd not_sym 1;
   9.738 +by (rtac (ve_app_owr2 RS ssubst) 1);ba 1;
   9.739 +by (rtac (te_app_owr2 RS ssubst) 1);ba 1;
   9.740 +by (fast_tac set_cs 1);
   9.741 +
   9.742 +by (etac singletonE 1);
   9.743 +by (hyp_subst_tac 1);
   9.744 +by (rtac (ve_app_owr1 RS ssubst) 1);
   9.745 +by (rtac (te_app_owr1 RS ssubst) 1);
   9.746 +by (etac subst 1);
   9.747 +by (fast_tac set_cs 1);
   9.748 +qed "consistency_fix";
   9.749 +
   9.750 +val prems = goal MT.thy 
   9.751 +  " [| ! t te. ve hastyenv te  --> te |- e1 ===> t --> v_const(c1) hasty t; \
   9.752 +\      ! t te. ve hastyenv te  --> te |- e2 ===> t --> v_const(c2) hasty t; \
   9.753 +\      ve hastyenv te ; te |- e1 @ e2 ===> t \
   9.754 +\   |] ==> \
   9.755 +\   v_const(c_app c1 c2) hasty t";
   9.756 +by (cut_facts_tac prems 1);
   9.757 +by (dtac elab_app_elim 1);
   9.758 +by (safe_tac HOL_cs);
   9.759 +by (rtac hasty_const 1);
   9.760 +by (rtac isof_app 1);
   9.761 +by (rtac hasty_elim_const 1);
   9.762 +by (fast_tac HOL_cs 1);
   9.763 +by (rtac hasty_elim_const 1);
   9.764 +by (fast_tac HOL_cs 1);
   9.765 +qed "consistency_app1";
   9.766 +
   9.767 +val prems = goal MT.thy 
   9.768 +  " [| ! t te. \
   9.769 +\        ve hastyenv te  --> \
   9.770 +\        te |- e1 ===> t --> v_clos(<|evm, em, vem|>) hasty t; \
   9.771 +\      ! t te. ve hastyenv te  --> te |- e2 ===> t --> v2 hasty t; \
   9.772 +\      ! t te. \
   9.773 +\        vem + { evm |-> v2 } hastyenv te  --> te |- em ===> t --> v hasty t; \
   9.774 +\      ve hastyenv te ; \
   9.775 +\      te |- e1 @ e2 ===> t \
   9.776 +\   |] ==> \
   9.777 +\   v hasty t";
   9.778 +by (cut_facts_tac prems 1);
   9.779 +by (dtac elab_app_elim 1);
   9.780 +by (safe_tac HOL_cs);
   9.781 +by ((etac allE 1) THEN (etac allE 1) THEN (etac impE 1));ba 1;be impE 1;ba 1;
   9.782 +by ((etac allE 1) THEN (etac allE 1) THEN (etac impE 1));ba 1;be impE 1;ba 1;
   9.783 +by (dtac hasty_elim_clos 1);
   9.784 +by (safe_tac HOL_cs);
   9.785 +by (dtac elab_fn_elim 1);
   9.786 +by (safe_tac HOL_cs);
   9.787 +by (dtac t_fun_inj 1);
   9.788 +by (safe_tac prop_cs);
   9.789 +by ((dtac hasty_env1 1) THEN (assume_tac 1) THEN (fast_tac HOL_cs 1));
   9.790 +qed "consistency_app2";
   9.791 +
   9.792 +val prems = goal MT.thy 
   9.793 +  "ve |- e ---> v ==> (! t te. ve hastyenv te --> te |- e ===> t --> v hasty t)";
   9.794 +
   9.795 +(* Proof by induction on the structure of evaluations *)
   9.796 +
   9.797 +by (resolve_tac (prems RL [eval_ind]) 1);
   9.798 +by (safe_tac HOL_cs);
   9.799 +
   9.800 +by (rtac consistency_const 1);ba 1;ba 1;
   9.801 +by (rtac consistency_var 1);ba 1;ba 1;ba 1;
   9.802 +by (rtac consistency_fn 1);ba 1;ba 1;
   9.803 +by (rtac consistency_fix 1);ba 1;ba 1;ba 1;
   9.804 +by (rtac consistency_app1 1);ba 1;ba 1;ba 1;ba 1;
   9.805 +by (rtac consistency_app2 1);ba 5;ba 4;ba 3;ba 2;ba 1;
   9.806 +qed "consistency";
   9.807 +
   9.808 +(* ############################################################ *)
   9.809 +(* The Basic Consistency theorem                                *)
   9.810 +(* ############################################################ *)
   9.811 +
   9.812 +val prems = goalw MT.thy [isof_env_def,hasty_env_def] 
   9.813 +  "ve isofenv te ==> ve hastyenv te";
   9.814 +by (cut_facts_tac prems 1);
   9.815 +by (safe_tac HOL_cs);
   9.816 +by (etac allE 1);be impE 1;ba 1;be exE 1;be conjE 1;
   9.817 +by (dtac hasty_const 1);
   9.818 +by ((rtac ssubst 1) THEN (assume_tac 1) THEN (assume_tac 1));
   9.819 +qed "basic_consistency_lem";
   9.820 +
   9.821 +val prems = goal MT.thy
   9.822 +  "[| ve isofenv te; ve |- e ---> v_const(c); te |- e ===> t |] ==> c isof t";
   9.823 +by (cut_facts_tac prems 1);
   9.824 +by (rtac hasty_elim_const 1);
   9.825 +by (dtac consistency 1);
   9.826 +by (fast_tac (HOL_cs addSIs [basic_consistency_lem]) 1);
   9.827 +qed "basic_consistency";
   9.828 +
   9.829 +
    10.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    10.2 +++ b/src/HOL/ex/MT.thy	Wed Mar 22 12:42:34 1995 +0100
    10.3 @@ -0,0 +1,278 @@
    10.4 +(*  Title: 	HOL/ex/mt.thy
    10.5 +    ID:         $Id$
    10.6 +    Author: 	Jacob Frost, Cambridge University Computer Laboratory
    10.7 +    Copyright   1993  University of Cambridge
    10.8 +
    10.9 +Based upon the article
   10.10 +    Robin Milner and Mads Tofte,
   10.11 +    Co-induction in Relational Semantics,
   10.12 +    Theoretical Computer Science 87 (1991), pages 209-220.
   10.13 +
   10.14 +Written up as
   10.15 +    Jacob Frost, A Case Study of Co_induction in Isabelle/HOL
   10.16 +    Report 308, Computer Lab, University of Cambridge (1993).
   10.17 +*)
   10.18 +
   10.19 +MT = Gfp + Sum + 
   10.20 +
   10.21 +types 
   10.22 +  Const
   10.23 +
   10.24 +  ExVar
   10.25 +  Ex
   10.26 +
   10.27 +  TyConst
   10.28 +  Ty
   10.29 +
   10.30 +  Clos
   10.31 +  Val
   10.32 +
   10.33 +  ValEnv
   10.34 +  TyEnv
   10.35 +
   10.36 +arities 
   10.37 +  Const :: term
   10.38 +
   10.39 +  ExVar :: term
   10.40 +  Ex :: term
   10.41 +
   10.42 +  TyConst :: term
   10.43 +  Ty :: term
   10.44 +
   10.45 +  Clos :: term
   10.46 +  Val :: term
   10.47 +
   10.48 +  ValEnv :: term
   10.49 +  TyEnv :: term
   10.50 +
   10.51 +consts
   10.52 +  c_app :: "[Const, Const] => Const"
   10.53 +
   10.54 +  e_const :: "Const => Ex"
   10.55 +  e_var :: "ExVar => Ex"
   10.56 +  e_fn :: "[ExVar, Ex] => Ex" ("fn _ => _" [0,51] 1000)
   10.57 +  e_fix :: "[ExVar, ExVar, Ex] => Ex" ("fix _ ( _ ) = _" [0,51,51] 1000)
   10.58 +  e_app :: "[Ex, Ex] => Ex" ("_ @ _" [51,51] 1000)
   10.59 +  e_const_fst :: "Ex => Const"
   10.60 +
   10.61 +  t_const :: "TyConst => Ty"
   10.62 +  t_fun :: "[Ty, Ty] => Ty" ("_ -> _" [51,51] 1000)
   10.63 +
   10.64 +  v_const :: "Const => Val"
   10.65 +  v_clos :: "Clos => Val"
   10.66 +  
   10.67 +  ve_emp :: "ValEnv"
   10.68 +  ve_owr :: "[ValEnv, ExVar, Val] => ValEnv" ("_ + { _ |-> _ }" [36,0,0] 50)
   10.69 +  ve_dom :: "ValEnv => ExVar set"
   10.70 +  ve_app :: "[ValEnv, ExVar] => Val"
   10.71 +
   10.72 +  clos_mk :: "[ExVar, Ex, ValEnv] => Clos" ("<| _  , _ , _ |>" [0,0,0] 1000)
   10.73 +
   10.74 +  te_emp :: "TyEnv"
   10.75 +  te_owr :: "[TyEnv, ExVar, Ty] => TyEnv" ("_ + { _ |=> _ }" [36,0,0] 50)
   10.76 +  te_app :: "[TyEnv, ExVar] => Ty"
   10.77 +  te_dom :: "TyEnv => ExVar set"
   10.78 +
   10.79 +  eval_fun :: "((ValEnv * Ex) * Val) set => ((ValEnv * Ex) * Val) set"
   10.80 +  eval_rel :: "((ValEnv * Ex) * Val) set"
   10.81 +  eval :: "[ValEnv, Ex, Val] => bool" ("_ |- _ ---> _" [36,0,36] 50)
   10.82 +
   10.83 +  elab_fun :: "((TyEnv * Ex) * Ty) set => ((TyEnv * Ex) * Ty) set"
   10.84 +  elab_rel :: "((TyEnv * Ex) * Ty) set"
   10.85 +  elab :: "[TyEnv, Ex, Ty] => bool" ("_ |- _ ===> _" [36,0,36] 50)
   10.86 +  
   10.87 +  isof :: "[Const, Ty] => bool" ("_ isof _" [36,36] 50)
   10.88 +  isof_env :: "[ValEnv,TyEnv] => bool" ("_ isofenv _")
   10.89 +
   10.90 +  hasty_fun :: "(Val * Ty) set => (Val * Ty) set"
   10.91 +  hasty_rel :: "(Val * Ty) set"
   10.92 +  hasty :: "[Val, Ty] => bool" ("_ hasty _" [36,36] 50)
   10.93 +  hasty_env :: "[ValEnv,TyEnv] => bool" ("_ hastyenv _ " [36,36] 35)
   10.94 +
   10.95 +rules
   10.96 +
   10.97 +(* 
   10.98 +  Expression constructors must be injective, distinct and it must be possible
   10.99 +  to do induction over expressions.
  10.100 +*)
  10.101 +
  10.102 +(* All the constructors are injective *)
  10.103 +
  10.104 +  e_const_inj "e_const(c1) = e_const(c2) ==> c1 = c2"
  10.105 +  e_var_inj "e_var(ev1) = e_var(ev2) ==> ev1 = ev2"
  10.106 +  e_fn_inj "fn ev1 => e1 = fn ev2 => e2 ==> ev1 = ev2 & e1 = e2"
  10.107 +  e_fix_inj 
  10.108 +    " fix ev11e(v12) = e1 = fix ev21(ev22) = e2 ==> \
  10.109 +\     ev11 = ev21 & ev12 = ev22 & e1 = e2 \
  10.110 +\   "
  10.111 +  e_app_inj "e11 @ e12 = e21 @ e22 ==> e11 = e21 & e12 = e22"
  10.112 +
  10.113 +(* All constructors are distinct *)
  10.114 +
  10.115 +  e_disj_const_var "~e_const(c) = e_var(ev)"
  10.116 +  e_disj_const_fn "~e_const(c) = fn ev => e"
  10.117 +  e_disj_const_fix "~e_const(c) = fix ev1(ev2) = e"
  10.118 +  e_disj_const_app "~e_const(c) = e1 @ e2"
  10.119 +  e_disj_var_fn "~e_var(ev1) = fn ev2 => e"
  10.120 +  e_disj_var_fix "~e_var(ev) = fix ev1(ev2) = e"
  10.121 +  e_disj_var_app "~e_var(ev) = e1 @ e2"
  10.122 +  e_disj_fn_fix "~fn ev1 => e1 = fix ev21(ev22) = e2"
  10.123 +  e_disj_fn_app "~fn ev1 => e1 = e21 @ e22"
  10.124 +  e_disj_fix_app "~fix ev11(ev12) = e1 = e21 @ e22"
  10.125 +
  10.126 +(* Strong elimination, induction on expressions  *)
  10.127 +
  10.128 +  e_ind 
  10.129 +    " [|  !!ev. P(e_var(ev)); \
  10.130 +\         !!c. P(e_const(c)); \
  10.131 +\         !!ev e. P(e) ==> P(fn ev => e); \
  10.132 +\         !!ev1 ev2 e. P(e) ==> P(fix ev1(ev2) = e); \
  10.133 +\         !!e1 e2. P(e1) ==> P(e2) ==> P(e1 @ e2) \
  10.134 +\     |] ==> \
  10.135 +\   P(e) \
  10.136 +\   "
  10.137 +
  10.138 +(* Types - same scheme as for expressions *)
  10.139 +
  10.140 +(* All constructors are injective *) 
  10.141 +
  10.142 +  t_const_inj "t_const(c1) = t_const(c2) ==> c1 = c2"
  10.143 +  t_fun_inj "t11 -> t12 = t21 -> t22 ==> t11 = t21 & t12 = t22"
  10.144 +
  10.145 +(* All constructors are distinct, not needed so far ... *)
  10.146 +
  10.147 +(* Strong elimination, induction on types *)
  10.148 +
  10.149 + t_ind 
  10.150 +    "[| !!p. P(t_const p); !!t1 t2. P(t1) ==> P(t2) ==> P(t_fun t1 t2) |] \
  10.151 +\    ==> P(t)"
  10.152 +
  10.153 +
  10.154 +(* Values - same scheme again *)
  10.155 +
  10.156 +(* All constructors are injective *) 
  10.157 +
  10.158 +  v_const_inj "v_const(c1) = v_const(c2) ==> c1 = c2"
  10.159 +  v_clos_inj 
  10.160 +    " v_clos(<|ev1,e1,ve1|>) = v_clos(<|ev2,e2,ve2|>) ==> \
  10.161 +\     ev1 = ev2 & e1 = e2 & ve1 = ve2"
  10.162 +  
  10.163 +(* All constructors are distinct *)
  10.164 +
  10.165 +  v_disj_const_clos "~v_const(c) = v_clos(cl)"
  10.166 +
  10.167 +(* Strong elimination, induction on values, not needed yet ... *)
  10.168 +
  10.169 +
  10.170 +(* 
  10.171 +  Value environments bind variables to values. Only the following trivial
  10.172 +  properties are needed.
  10.173 +*)
  10.174 +
  10.175 +  ve_dom_owr "ve_dom(ve + {ev |-> v}) = ve_dom(ve) Un {ev}"
  10.176 + 
  10.177 +  ve_app_owr1 "ve_app (ve + {ev |-> v}) ev=v"
  10.178 +  ve_app_owr2 "~ev1=ev2 ==> ve_app (ve+{ev1 |-> v}) ev2=ve_app ve ev2"
  10.179 +
  10.180 +
  10.181 +(* Type Environments bind variables to types. The following trivial
  10.182 +properties are needed.  *)
  10.183 +
  10.184 +  te_dom_owr "te_dom(te + {ev |=> t}) = te_dom(te) Un {ev}"
  10.185 + 
  10.186 +  te_app_owr1 "te_app (te + {ev |=> t}) ev=t"
  10.187 +  te_app_owr2 "~ev1=ev2 ==> te_app (te+{ev1 |=> t}) ev2=te_app te ev2"
  10.188 +
  10.189 +
  10.190 +(* The dynamic semantics is defined inductively by a set of inference
  10.191 +rules.  These inference rules allows one to draw conclusions of the form ve
  10.192 +|- e ---> v, read the expression e evaluates to the value v in the value
  10.193 +environment ve.  Therefore the relation _ |- _ ---> _ is defined in Isabelle
  10.194 +as the least fixpoint of the functor eval_fun below.  From this definition
  10.195 +introduction rules and a strong elimination (induction) rule can be
  10.196 +derived.  
  10.197 +*)
  10.198 +
  10.199 +  eval_fun_def 
  10.200 +    " eval_fun(s) == \
  10.201 +\     { pp. \
  10.202 +\       (? ve c. pp=<<ve,e_const(c)>,v_const(c)>) | \
  10.203 +\       (? ve x. pp=<<ve,e_var(x)>,ve_app ve x> & x:ve_dom(ve)) |\
  10.204 +\       (? ve e x. pp=<<ve,fn x => e>,v_clos(<|x,e,ve|>)>)| \
  10.205 +\       ( ? ve e x f cl. \
  10.206 +\           pp=<<ve,fix f(x) = e>,v_clos(cl)> & \
  10.207 +\           cl=<|x, e, ve+{f |-> v_clos(cl)} |>  \
  10.208 +\       ) | \
  10.209 +\       ( ? ve e1 e2 c1 c2. \
  10.210 +\           pp=<<ve,e1 @ e2>,v_const(c_app c1 c2)> & \
  10.211 +\           <<ve,e1>,v_const(c1)>:s & <<ve,e2>,v_const(c2)>:s \
  10.212 +\       ) | \
  10.213 +\       ( ? ve vem e1 e2 em xm v v2. \
  10.214 +\           pp=<<ve,e1 @ e2>,v> & \
  10.215 +\           <<ve,e1>,v_clos(<|xm,em,vem|>)>:s & \
  10.216 +\           <<ve,e2>,v2>:s & \
  10.217 +\           <<vem+{xm |-> v2},em>,v>:s \
  10.218 +\       ) \
  10.219 +\     }"
  10.220 +
  10.221 +  eval_rel_def "eval_rel == lfp(eval_fun)"
  10.222 +  eval_def "ve |- e ---> v == <<ve,e>,v>:eval_rel"
  10.223 +
  10.224 +(* The static semantics is defined in the same way as the dynamic
  10.225 +semantics.  The relation te |- e ===> t express the expression e has the
  10.226 +type t in the type environment te.
  10.227 +*)
  10.228 +
  10.229 +  elab_fun_def 
  10.230 +  "elab_fun(s) == \
  10.231 +\  { pp. \
  10.232 +\    (? te c t. pp=<<te,e_const(c)>,t> & c isof t) | \
  10.233 +\    (? te x. pp=<<te,e_var(x)>,te_app te x> & x:te_dom(te)) | \
  10.234 +\    (? te x e t1 t2. pp=<<te,fn x => e>,t1->t2> & <<te+{x |=> t1},e>,t2>:s) | \
  10.235 +\    (? te f x e t1 t2. \
  10.236 +\       pp=<<te,fix f(x)=e>,t1->t2> & <<te+{f |=> t1->t2}+{x |=> t1},e>,t2>:s \
  10.237 +\    ) | \
  10.238 +\    (? te e1 e2 t1 t2. \
  10.239 +\       pp=<<te,e1 @ e2>,t2> & <<te,e1>,t1->t2>:s & <<te,e2>,t1>:s \
  10.240 +\    ) \
  10.241 +\  }"
  10.242 +
  10.243 +  elab_rel_def "elab_rel == lfp(elab_fun)"
  10.244 +  elab_def "te |- e ===> t == <<te,e>,t>:elab_rel"
  10.245 +
  10.246 +(* The original correspondence relation *)
  10.247 +
  10.248 +  isof_env_def 
  10.249 +    " ve isofenv te == \
  10.250 +\     ve_dom(ve) = te_dom(te) & \
  10.251 +\     ( ! x. \
  10.252 +\         x:ve_dom(ve) --> \
  10.253 +\         (? c.ve_app ve x = v_const(c) & c isof te_app te x) \
  10.254 +\     ) \
  10.255 +\   "
  10.256 +
  10.257 +  isof_app "[| c1 isof t1->t2; c2 isof t1 |] ==> c_app c1 c2 isof t2"
  10.258 +
  10.259 +(* The extented correspondence relation *)
  10.260 +
  10.261 +  hasty_fun_def
  10.262 +    " hasty_fun(r) == \
  10.263 +\     { p. \
  10.264 +\       ( ? c t. p = <v_const(c),t> & c isof t) | \
  10.265 +\       ( ? ev e ve t te. \
  10.266 +\           p = <v_clos(<|ev,e,ve|>),t> & \
  10.267 +\           te |- fn ev => e ===> t & \
  10.268 +\           ve_dom(ve) = te_dom(te) & \
  10.269 +\           (! ev1.ev1:ve_dom(ve) --> <ve_app ve ev1,te_app te ev1> : r) \
  10.270 +\       ) \
  10.271 +\     } \
  10.272 +\   "
  10.273 +
  10.274 +  hasty_rel_def "hasty_rel == gfp(hasty_fun)"
  10.275 +  hasty_def "v hasty t == <v,t> : hasty_rel"
  10.276 +  hasty_env_def 
  10.277 +    " ve hastyenv te == \
  10.278 +\     ve_dom(ve) = te_dom(te) & \
  10.279 +\     (! x. x: ve_dom(ve) --> ve_app ve x hasty te_app te x)"
  10.280 +
  10.281 +end
    11.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    11.2 +++ b/src/HOL/ex/NatSum.ML	Wed Mar 22 12:42:34 1995 +0100
    11.3 @@ -0,0 +1,43 @@
    11.4 +(*  Title: 	HOL/ex/natsum.ML
    11.5 +    ID:         $Id$
    11.6 +    Author: 	Tobias Nipkow
    11.7 +    Copyright   1994 TU Muenchen
    11.8 +
    11.9 +Summing natural numbers, squares and cubes. Could be continued...
   11.10 +*)
   11.11 +
   11.12 +val natsum_ss = arith_ss addsimps
   11.13 +  ([NatSum.sum_0,NatSum.sum_Suc] @ add_ac);
   11.14 +
   11.15 +(*The sum of the first n positive integers equals n(n+1)/2.*)
   11.16 +goal NatSum.thy "Suc(Suc(0))*sum (%i.i) (Suc n) = n*Suc(n)";
   11.17 +by (simp_tac natsum_ss 1);
   11.18 +by (nat_ind_tac "n" 1);
   11.19 +by (simp_tac natsum_ss 1);
   11.20 +by (asm_simp_tac natsum_ss 1);
   11.21 +qed "sum_of_naturals";
   11.22 +
   11.23 +goal NatSum.thy
   11.24 +  "Suc(Suc(Suc(Suc(Suc(Suc(0))))))*sum (%i.i*i) (Suc n) = \
   11.25 +\  n*Suc(n)*Suc(Suc(Suc(0))*n)";
   11.26 +by (simp_tac natsum_ss 1);
   11.27 +by (nat_ind_tac "n" 1);
   11.28 +by (simp_tac natsum_ss 1);
   11.29 +by (asm_simp_tac natsum_ss 1);
   11.30 +qed "sum_of_squares";
   11.31 +
   11.32 +goal NatSum.thy
   11.33 +  "Suc(Suc(Suc(Suc(0))))*sum (%i.i*i*i) (Suc n) = n*n*Suc(n)*Suc(n)";
   11.34 +by (simp_tac natsum_ss 1);
   11.35 +by (nat_ind_tac "n" 1);
   11.36 +by (simp_tac natsum_ss 1);
   11.37 +by (asm_simp_tac natsum_ss 1);
   11.38 +qed "sum_of_cubes";
   11.39 +
   11.40 +(*The sum of the first n odd numbers equals n squared.*)
   11.41 +goal NatSum.thy "sum (%i.Suc(i+i)) n = n*n";
   11.42 +by (nat_ind_tac "n" 1);
   11.43 +by (simp_tac natsum_ss 1);
   11.44 +by (asm_simp_tac natsum_ss 1);
   11.45 +qed "sum_of_odds";
   11.46 +
    12.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    12.2 +++ b/src/HOL/ex/NatSum.thy	Wed Mar 22 12:42:34 1995 +0100
    12.3 @@ -0,0 +1,13 @@
    12.4 +(*  Title: 	HOL/ex/natsum.thy
    12.5 +    ID:         $Id$
    12.6 +    Author: 	Tobias Nipkow
    12.7 +    Copyright   1994 TU Muenchen
    12.8 +
    12.9 +A summation operator. sum(f,n+1) is the sum of all f(i), i=0...n.
   12.10 +*)
   12.11 +
   12.12 +NatSum = Arith +
   12.13 +consts sum     :: "[nat=>nat, nat] => nat"
   12.14 +rules  sum_0      "sum f 0 = 0"
   12.15 +       sum_Suc    "sum f (Suc n) = f(n) + sum f n"
   12.16 +end
    13.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    13.2 +++ b/src/HOL/ex/PropLog.ML	Wed Mar 22 12:42:34 1995 +0100
    13.3 @@ -0,0 +1,234 @@
    13.4 +(*  Title: 	HOL/ex/pl.ML
    13.5 +    ID:         $Id$
    13.6 +    Author: 	Tobias Nipkow & Lawrence C Paulson
    13.7 +    Copyright   1994  TU Muenchen & University of Cambridge
    13.8 +
    13.9 +Soundness and completeness of propositional logic w.r.t. truth-tables.
   13.10 +
   13.11 +Prove: If H|=p then G|=p where G:Fin(H)
   13.12 +*)
   13.13 +
   13.14 +open PropLog;
   13.15 +
   13.16 +(** Monotonicity **)
   13.17 +goalw PropLog.thy thms.defs "!!G H. G<=H ==> thms(G) <= thms(H)";
   13.18 +by (rtac lfp_mono 1);
   13.19 +by (REPEAT (ares_tac basic_monos 1));
   13.20 +qed "thms_mono";
   13.21 +
   13.22 +(*Rule is called I for Identity Combinator, not for Introduction*)
   13.23 +goal PropLog.thy "H |- p->p";
   13.24 +by(best_tac (HOL_cs addIs [thms.K,thms.S,thms.MP]) 1);
   13.25 +qed "thms_I";
   13.26 +
   13.27 +(** Weakening, left and right **)
   13.28 +
   13.29 +(* "[| G<=H;  G |- p |] ==> H |- p"
   13.30 +   This order of premises is convenient with RS
   13.31 +*)
   13.32 +bind_thm ("weaken_left", (thms_mono RS subsetD));
   13.33 +
   13.34 +(* H |- p ==> insert(a,H) |- p *)
   13.35 +val weaken_left_insert = subset_insertI RS weaken_left;
   13.36 +
   13.37 +val weaken_left_Un1  =    Un_upper1 RS weaken_left;
   13.38 +val weaken_left_Un2  =    Un_upper2 RS weaken_left;
   13.39 +
   13.40 +goal PropLog.thy "!!H. H |- q ==> H |- p->q";
   13.41 +by(fast_tac (HOL_cs addIs [thms.K,thms.MP]) 1);
   13.42 +qed "weaken_right";
   13.43 +
   13.44 +(*The deduction theorem*)
   13.45 +goal PropLog.thy "!!H. insert p H |- q  ==>  H |- p->q";
   13.46 +by (etac thms.induct 1);
   13.47 +by (fast_tac (set_cs addIs [thms_I, thms.H RS weaken_right]) 1);
   13.48 +by (fast_tac (set_cs addIs [thms.K RS weaken_right]) 1);
   13.49 +by (fast_tac (set_cs addIs [thms.S RS weaken_right]) 1);
   13.50 +by (fast_tac (set_cs addIs [thms.DN RS weaken_right]) 1);
   13.51 +by (fast_tac (set_cs addIs [thms.S RS thms.MP RS thms.MP]) 1);
   13.52 +qed "deduction";
   13.53 +
   13.54 +
   13.55 +(* "[| insert p H |- q; H |- p |] ==> H |- q"
   13.56 +    The cut rule - not used
   13.57 +*)
   13.58 +val cut = deduction RS thms.MP;
   13.59 +
   13.60 +(* H |- false ==> H |- p *)
   13.61 +val thms_falseE = weaken_right RS (thms.DN RS thms.MP);
   13.62 +
   13.63 +(* [| H |- p->false;  H |- p;  q: pl |] ==> H |- q *)
   13.64 +bind_thm ("thms_notE", (thms.MP RS thms_falseE));
   13.65 +
   13.66 +(** The function eval **)
   13.67 +
   13.68 +val pl_ss = set_ss addsimps
   13.69 +  (PropLog.pl.simps @ [eval2_false, eval2_var, eval2_imp]
   13.70 +               @ [hyps_false, hyps_var, hyps_imp]);
   13.71 +
   13.72 +goalw PropLog.thy [eval_def] "tt[false] = False";
   13.73 +by (simp_tac pl_ss 1);
   13.74 +qed "eval_false";
   13.75 +
   13.76 +goalw PropLog.thy [eval_def] "tt[#v] = (v:tt)";
   13.77 +by (simp_tac pl_ss 1);
   13.78 +qed "eval_var";
   13.79 +
   13.80 +goalw PropLog.thy [eval_def] "tt[p->q] = (tt[p]-->tt[q])";
   13.81 +by (simp_tac pl_ss 1);
   13.82 +qed "eval_imp";
   13.83 +
   13.84 +val pl_ss = pl_ss addsimps [eval_false, eval_var, eval_imp];
   13.85 +
   13.86 +(*Soundness of the rules wrt truth-table semantics*)
   13.87 +goalw PropLog.thy [sat_def] "!!H. H |- p ==> H |= p";
   13.88 +by (etac thms.induct 1);
   13.89 +by (fast_tac (set_cs addSDs [eval_imp RS iffD1 RS mp]) 5);
   13.90 +by (ALLGOALS (asm_simp_tac pl_ss));
   13.91 +qed "soundness";
   13.92 +
   13.93 +(*** Towards the completeness proof ***)
   13.94 +
   13.95 +goal PropLog.thy "!!H. H |- p->false ==> H |- p->q";
   13.96 +by (rtac deduction 1);
   13.97 +by (etac (weaken_left_insert RS thms_notE) 1);
   13.98 +by (rtac thms.H 1);
   13.99 +by (rtac insertI1 1);
  13.100 +qed "false_imp";
  13.101 +
  13.102 +val [premp,premq] = goal PropLog.thy
  13.103 +    "[| H |- p;  H |- q->false |] ==> H |- (p->q)->false";
  13.104 +by (rtac deduction 1);
  13.105 +by (rtac (premq RS weaken_left_insert RS thms.MP) 1);
  13.106 +by (rtac (thms.H RS thms.MP) 1);
  13.107 +by (rtac insertI1 1);
  13.108 +by (rtac (premp RS weaken_left_insert) 1);
  13.109 +qed "imp_false";
  13.110 +
  13.111 +(*This formulation is required for strong induction hypotheses*)
  13.112 +goal PropLog.thy "hyps p tt |- (if tt[p] then p else p->false)";
  13.113 +by (rtac (expand_if RS iffD2) 1);
  13.114 +by(PropLog.pl.induct_tac "p" 1);
  13.115 +by (ALLGOALS (simp_tac (pl_ss addsimps [thms_I, thms.H])));
  13.116 +by (fast_tac (set_cs addIs [weaken_left_Un1, weaken_left_Un2, 
  13.117 +			   weaken_right, imp_false]
  13.118 +                    addSEs [false_imp]) 1);
  13.119 +qed "hyps_thms_if";
  13.120 +
  13.121 +(*Key lemma for completeness; yields a set of assumptions satisfying p*)
  13.122 +val [sat] = goalw PropLog.thy [sat_def] "{} |= p ==> hyps p tt |- p";
  13.123 +by (rtac (sat RS spec RS mp RS if_P RS subst) 1 THEN
  13.124 +    rtac hyps_thms_if 2);
  13.125 +by (fast_tac set_cs 1);
  13.126 +qed "sat_thms_p";
  13.127 +
  13.128 +(*For proving certain theorems in our new propositional logic*)
  13.129 +val thms_cs = 
  13.130 +    set_cs addSIs [deduction] addIs [thms.H, thms.H RS thms.MP];
  13.131 +
  13.132 +(*The excluded middle in the form of an elimination rule*)
  13.133 +goal PropLog.thy "H |- (p->q) -> ((p->false)->q) -> q";
  13.134 +by (rtac (deduction RS deduction) 1);
  13.135 +by (rtac (thms.DN RS thms.MP) 1);
  13.136 +by (ALLGOALS (best_tac (thms_cs addSIs prems)));
  13.137 +qed "thms_excluded_middle";
  13.138 +
  13.139 +(*Hard to prove directly because it requires cuts*)
  13.140 +val prems = goal PropLog.thy
  13.141 +    "[| insert p H |- q;  insert (p->false) H |- q |] ==> H |- q";
  13.142 +by (rtac (thms_excluded_middle RS thms.MP RS thms.MP) 1);
  13.143 +by (REPEAT (resolve_tac (prems@[deduction]) 1));
  13.144 +qed "thms_excluded_middle_rule";
  13.145 +
  13.146 +(*** Completeness -- lemmas for reducing the set of assumptions ***)
  13.147 +
  13.148 +(*For the case hyps(p,t)-insert(#v,Y) |- p;
  13.149 +  we also have hyps(p,t)-{#v} <= hyps(p, t-{v}) *)
  13.150 +goal PropLog.thy "hyps p (t-{v}) <= insert (#v->false) ((hyps p t)-{#v})";
  13.151 +by (PropLog.pl.induct_tac "p" 1);
  13.152 +by (simp_tac pl_ss 1);
  13.153 +by (simp_tac (pl_ss setloop (split_tac [expand_if])) 1);
  13.154 +by (simp_tac pl_ss 1);
  13.155 +by (fast_tac set_cs 1);
  13.156 +qed "hyps_Diff";
  13.157 +
  13.158 +(*For the case hyps(p,t)-insert(#v -> false,Y) |- p;
  13.159 +  we also have hyps(p,t)-{#v->false} <= hyps(p, insert(v,t)) *)
  13.160 +goal PropLog.thy "hyps p (insert v t) <= insert (#v) (hyps p t-{#v->false})";
  13.161 +by (PropLog.pl.induct_tac "p" 1);
  13.162 +by (simp_tac pl_ss 1);
  13.163 +by (simp_tac (pl_ss setloop (split_tac [expand_if])) 1);
  13.164 +by (simp_tac pl_ss 1);
  13.165 +by (fast_tac set_cs 1);
  13.166 +qed "hyps_insert";
  13.167 +
  13.168 +(** Two lemmas for use with weaken_left **)
  13.169 +
  13.170 +goal Set.thy "B-C <= insert a (B-insert a C)";
  13.171 +by (fast_tac set_cs 1);
  13.172 +qed "insert_Diff_same";
  13.173 +
  13.174 +goal Set.thy "insert a (B-{c}) - D <= insert a (B-insert c D)";
  13.175 +by (fast_tac set_cs 1);
  13.176 +qed "insert_Diff_subset2";
  13.177 +
  13.178 +(*The set hyps(p,t) is finite, and elements have the form #v or #v->false;
  13.179 + could probably prove the stronger hyps(p,t) : Fin(hyps(p,{}) Un hyps(p,nat))*)
  13.180 +goal PropLog.thy "hyps p t : Fin(UN v:{x.True}. {#v, #v->false})";
  13.181 +by (PropLog.pl.induct_tac "p" 1);
  13.182 +by (ALLGOALS (simp_tac (pl_ss setloop (split_tac [expand_if])) THEN'
  13.183 +              fast_tac (set_cs addSIs Fin.intrs@[Fin_UnI])));
  13.184 +qed "hyps_finite";
  13.185 +
  13.186 +val Diff_weaken_left = subset_refl RSN (2, Diff_mono) RS weaken_left;
  13.187 +
  13.188 +(*Induction on the finite set of assumptions hyps(p,t0).
  13.189 +  We may repeatedly subtract assumptions until none are left!*)
  13.190 +val [sat] = goal PropLog.thy
  13.191 +    "{} |= p ==> !t. hyps p t - hyps p t0 |- p";
  13.192 +by (rtac (hyps_finite RS Fin_induct) 1);
  13.193 +by (simp_tac (pl_ss addsimps [sat RS sat_thms_p]) 1);
  13.194 +by (safe_tac set_cs);
  13.195 +(*Case hyps(p,t)-insert(#v,Y) |- p *)
  13.196 +by (rtac thms_excluded_middle_rule 1);
  13.197 +by (rtac (insert_Diff_same RS weaken_left) 1);
  13.198 +by (etac spec 1);
  13.199 +by (rtac (insert_Diff_subset2 RS weaken_left) 1);
  13.200 +by (rtac (hyps_Diff RS Diff_weaken_left) 1);
  13.201 +by (etac spec 1);
  13.202 +(*Case hyps(p,t)-insert(#v -> false,Y) |- p *)
  13.203 +by (rtac thms_excluded_middle_rule 1);
  13.204 +by (rtac (insert_Diff_same RS weaken_left) 2);
  13.205 +by (etac spec 2);
  13.206 +by (rtac (insert_Diff_subset2 RS weaken_left) 1);
  13.207 +by (rtac (hyps_insert RS Diff_weaken_left) 1);
  13.208 +by (etac spec 1);
  13.209 +qed "completeness_0_lemma";
  13.210 +
  13.211 +(*The base case for completeness*)
  13.212 +val [sat] = goal PropLog.thy "{} |= p ==> {} |- p";
  13.213 +by (rtac (Diff_cancel RS subst) 1);
  13.214 +by (rtac (sat RS (completeness_0_lemma RS spec)) 1);
  13.215 +qed "completeness_0";
  13.216 +
  13.217 +(*A semantic analogue of the Deduction Theorem*)
  13.218 +val [sat] = goalw PropLog.thy [sat_def] "insert p H |= q ==> H |= p->q";
  13.219 +by (simp_tac pl_ss 1);
  13.220 +by (cfast_tac [sat] 1);
  13.221 +qed "sat_imp";
  13.222 +
  13.223 +val [finite] = goal PropLog.thy "H: Fin({p.True}) ==> !p. H |= p --> H |- p";
  13.224 +by (rtac (finite RS Fin_induct) 1);
  13.225 +by (safe_tac (set_cs addSIs [completeness_0]));
  13.226 +by (rtac (weaken_left_insert RS thms.MP) 1);
  13.227 +by (fast_tac (set_cs addSIs [sat_imp]) 1);
  13.228 +by (fast_tac thms_cs 1);
  13.229 +qed "completeness_lemma";
  13.230 +
  13.231 +val completeness = completeness_lemma RS spec RS mp;
  13.232 +
  13.233 +val [finite] = goal PropLog.thy "H: Fin({p.True}) ==> (H |- p) = (H |= p)";
  13.234 +by (fast_tac (set_cs addSEs [soundness, finite RS completeness]) 1);
  13.235 +qed "thms_iff";
  13.236 +
  13.237 +writeln"Reached end of file.";
    14.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    14.2 +++ b/src/HOL/ex/PropLog.thy	Wed Mar 22 12:42:34 1995 +0100
    14.3 @@ -0,0 +1,45 @@
    14.4 +(*  Title: 	HOL/ex/PropLog.thy
    14.5 +    ID:         $Id$
    14.6 +    Author: 	Tobias Nipkow
    14.7 +    Copyright   1994  TU Muenchen
    14.8 +
    14.9 +Inductive definition of propositional logic.
   14.10 +*)
   14.11 +
   14.12 +PropLog = Finite +
   14.13 +datatype
   14.14 +    'a pl = false | var ('a) ("#_" [1000]) | "->" ('a pl,'a pl) (infixr 90)
   14.15 +consts
   14.16 +  thms :: "'a pl set => 'a pl set"
   14.17 +  "|-" 	:: "['a pl set, 'a pl] => bool"	(infixl 50)
   14.18 +  "|="	:: "['a pl set, 'a pl] => bool"	(infixl 50)
   14.19 +  eval2	:: "['a pl, 'a set] => bool"
   14.20 +  eval	:: "['a set, 'a pl] => bool"	("_[_]" [100,0] 100)
   14.21 +  hyps	:: "['a pl, 'a set] => 'a pl set"
   14.22 +
   14.23 +translations
   14.24 +  "H |- p" == "p : thms(H)"
   14.25 +
   14.26 +inductive "thms(H)"
   14.27 +  intrs
   14.28 +  H   "p:H ==> H |- p"
   14.29 +  K   "H |- p->q->p"
   14.30 +  S   "H |- (p->q->r) -> (p->q) -> p->r"
   14.31 +  DN  "H |- ((p->false) -> false) -> p"
   14.32 +  MP  "[| H |- p->q; H |- p |] ==> H |- q"
   14.33 +
   14.34 +defs
   14.35 +  sat_def  "H |= p  ==  (!tt. (!q:H. tt[q]) --> tt[p])"
   14.36 +  eval_def "tt[p] == eval2 p tt"
   14.37 +
   14.38 +primrec eval2 pl
   14.39 +  eval2_false "eval2(false) = (%x.False)"
   14.40 +  eval2_var   "eval2(#v) = (%tt.v:tt)"
   14.41 +  eval2_imp   "eval2(p->q) = (%tt.eval2 p tt-->eval2 q tt)"
   14.42 +
   14.43 +primrec hyps pl
   14.44 +  hyps_false "hyps(false) = (%tt.{})"
   14.45 +  hyps_var   "hyps(#v) = (%tt.{if v:tt then #v else #v->false})"
   14.46 +  hyps_imp   "hyps(p->q) = (%tt.hyps p tt Un hyps q tt)"
   14.47 +
   14.48 +end
    15.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    15.2 +++ b/src/HOL/ex/Puzzle.ML	Wed Mar 22 12:42:34 1995 +0100
    15.3 @@ -0,0 +1,58 @@
    15.4 +(*  Title: 	HOL/ex/puzzle.ML
    15.5 +    ID:         $Id$
    15.6 +    Author: 	Tobias Nipkow
    15.7 +    Copyright   1993 TU Muenchen
    15.8 +
    15.9 +For puzzle.thy.  A question from "Bundeswettbewerb Mathematik"
   15.10 +
   15.11 +Proof due to Herbert Ehler
   15.12 +*)
   15.13 +
   15.14 +(*specialized form of induction needed below*)
   15.15 +val prems = goal Nat.thy "[| P(0); !!n. P(Suc(n)) |] ==> !n.P(n)";
   15.16 +by (EVERY1 [rtac (nat_induct RS allI), resolve_tac prems, resolve_tac prems]);
   15.17 +qed "nat_exh";
   15.18 +
   15.19 +goal Puzzle.thy "! n. k=f(n) --> n <= f(n)";
   15.20 +by (res_inst_tac [("n","k")] less_induct 1);
   15.21 +by (rtac nat_exh 1);
   15.22 +by (simp_tac nat_ss 1);
   15.23 +by (rtac impI 1);
   15.24 +by (rtac classical 1);
   15.25 +by (dtac not_leE 1);
   15.26 +by (subgoal_tac "f(na) <= f(f(na))" 1);
   15.27 +by (best_tac (HOL_cs addIs [lessD,Puzzle.f_ax,le_less_trans,le_trans]) 1);
   15.28 +by (fast_tac (HOL_cs addIs [Puzzle.f_ax]) 1);
   15.29 +bind_thm("lemma", result() RS spec RS mp);
   15.30 +
   15.31 +goal Puzzle.thy "n <= f(n)";
   15.32 +by (fast_tac (HOL_cs addIs [lemma]) 1);
   15.33 +qed "lemma1";
   15.34 +
   15.35 +goal Puzzle.thy "f(n) < f(Suc(n))";
   15.36 +by (fast_tac (HOL_cs addIs [Puzzle.f_ax,le_less_trans,lemma1]) 1);
   15.37 +qed "lemma2";
   15.38 +
   15.39 +val prems = goal Puzzle.thy "(!!n.f(n) <= f(Suc(n))) ==> m<n --> f(m) <= f(n)";
   15.40 +by (res_inst_tac[("n","n")]nat_induct 1);
   15.41 +by (simp_tac nat_ss 1);
   15.42 +by (simp_tac nat_ss 1);
   15.43 +by (fast_tac (HOL_cs addIs (le_trans::prems)) 1);
   15.44 +bind_thm("mono_lemma1", result() RS mp);
   15.45 +
   15.46 +val [p1,p2] = goal Puzzle.thy
   15.47 +    "[| !! n. f(n)<=f(Suc(n));  m<=n |] ==> f(m) <= f(n)";
   15.48 +by (rtac (p2 RS le_imp_less_or_eq RS disjE) 1);
   15.49 +by (etac (p1 RS mono_lemma1) 1);
   15.50 +by (fast_tac (HOL_cs addIs [le_refl]) 1);
   15.51 +qed "mono_lemma";
   15.52 +
   15.53 +val prems = goal Puzzle.thy "m <= n ==> f(m) <= f(n)";
   15.54 +by (fast_tac (HOL_cs addIs ([mono_lemma,less_imp_le,lemma2]@prems)) 1);
   15.55 +qed "f_mono";
   15.56 +
   15.57 +goal Puzzle.thy "f(n) = n";
   15.58 +by (rtac le_anti_sym 1);
   15.59 +by (rtac lemma1 2);
   15.60 +by (fast_tac (HOL_cs addIs [Puzzle.f_ax,leI] addDs [leD,f_mono,lessD]) 1);
   15.61 +result();
    16.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    16.2 +++ b/src/HOL/ex/Puzzle.thy	Wed Mar 22 12:42:34 1995 +0100
    16.3 @@ -0,0 +1,12 @@
    16.4 +(*  Title: 	HOL/ex/puzzle.thy
    16.5 +    ID:         $Id$
    16.6 +    Author: 	Tobias Nipkow
    16.7 +    Copyright   1993 TU Muenchen
    16.8 +
    16.9 +An question from "Bundeswettbewerb Mathematik"
   16.10 +*)
   16.11 +
   16.12 +Puzzle = Nat +
   16.13 +consts f :: "nat => nat"
   16.14 +rules  f_ax "f(f(n)) < f(Suc(n))"
   16.15 +end
    17.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    17.2 +++ b/src/HOL/ex/Qsort.ML	Wed Mar 22 12:42:34 1995 +0100
    17.3 @@ -0,0 +1,84 @@
    17.4 +(*  Title: 	HOL/ex/qsort.ML
    17.5 +    ID:         $Id$
    17.6 +    Author: 	Tobias Nipkow
    17.7 +    Copyright   1994 TU Muenchen
    17.8 +
    17.9 +Two verifications of Quicksort
   17.10 +*)
   17.11 +
   17.12 +val ss = sorting_ss addsimps ([Qsort.qsort_Nil,Qsort.qsort_Cons]@conj_comms);
   17.13 +
   17.14 +goal Qsort.thy "!x. mset (qsort le xs) x = mset xs x";
   17.15 +by(res_inst_tac[("xs","xs"),("p","le")]Qsort.qsort_ind 1);
   17.16 +by(ALLGOALS(asm_simp_tac (ss setloop (split_tac [expand_if]))));
   17.17 +result();
   17.18 +
   17.19 +
   17.20 +goal Qsort.thy "(Alls x:[x:xs.P(x)].Q(x)) = (Alls x:xs. P(x)-->Q(x))";
   17.21 +by(list.induct_tac "xs" 1);
   17.22 +by(ALLGOALS(asm_simp_tac (ss setloop (split_tac [expand_if]))));
   17.23 +val ss = ss addsimps [result()];
   17.24 +
   17.25 +goal Qsort.thy
   17.26 + "((Alls x:xs.P(x)) & (Alls x:xs.Q(x))) = (Alls x:xs. P(x)&Q(x))";
   17.27 +by(list.induct_tac "xs" 1);
   17.28 +by(ALLGOALS(asm_simp_tac ss));
   17.29 +val ss = ss addsimps [result()];
   17.30 +
   17.31 +goal HOL.thy "((~P --> Q) & (P --> Q)) = Q";
   17.32 +by(fast_tac HOL_cs 1);
   17.33 +qed "lemma";
   17.34 +
   17.35 +goal Qsort.thy "(Alls x:qsort le xs.P(x))  =  (Alls x:xs.P(x))";
   17.36 +by(res_inst_tac[("xs","xs"),("p","le")]Qsort.qsort_ind 1);
   17.37 +by(ALLGOALS(asm_simp_tac (ss addsimps [lemma])));
   17.38 +val ss = ss addsimps [result()];
   17.39 +
   17.40 +goal Qsort.thy
   17.41 + "sorted le (xs@ys) = (sorted le xs & sorted le ys & \
   17.42 +\                     (Alls x:xs. Alls y:ys. le x y))";
   17.43 +by(list.induct_tac "xs" 1);
   17.44 +by(ALLGOALS(asm_simp_tac ss));
   17.45 +val ss = ss addsimps [result()];
   17.46 +
   17.47 +goal Qsort.thy 
   17.48 + "!!le. [| total(le); transf(le) |] ==>  sorted le (qsort le xs)";
   17.49 +by(res_inst_tac[("xs","xs"),("p","le")]Qsort.qsort_ind 1);
   17.50 +by(ALLGOALS(asm_full_simp_tac (ss addsimps [list_all_mem_conv]) ));
   17.51 +by(rewrite_goals_tac [Sorting.total_def,Sorting.transf_def]);
   17.52 +by(fast_tac HOL_cs 1);
   17.53 +result();
   17.54 +
   17.55 +
   17.56 +(* A verification based on predicate calculus rather than combinators *)
   17.57 +
   17.58 +val sorted_Cons =
   17.59 +  rewrite_rule [list_all_mem_conv RS eq_reflection] Sorting.sorted_Cons;
   17.60 +
   17.61 +val ss = list_ss addsimps
   17.62 + [Sorting.sorted_Nil,sorted_Cons,
   17.63 +  Qsort.qsort_Nil,Qsort.qsort_Cons];
   17.64 +
   17.65 +
   17.66 +goal Qsort.thy "x mem qsort le xs = x mem xs";
   17.67 +by(res_inst_tac[("xs","xs"),("p","le")]Qsort.qsort_ind 1);
   17.68 +by(ALLGOALS(asm_simp_tac (ss setloop (split_tac [expand_if]))));
   17.69 +by(fast_tac HOL_cs 1);
   17.70 +val ss = ss addsimps [result()];
   17.71 +
   17.72 +goal Qsort.thy
   17.73 + "sorted le (xs@ys) = (sorted le xs & sorted le ys & \
   17.74 +\                     (!x. x mem xs --> (!y. y mem ys --> le x y)))";
   17.75 +by(list.induct_tac "xs" 1);
   17.76 +by(ALLGOALS(asm_simp_tac (ss setloop (split_tac [expand_if]))));
   17.77 +by(fast_tac HOL_cs 1);
   17.78 +val ss = ss addsimps [result()];
   17.79 +
   17.80 +goal Qsort.thy
   17.81 +  "!!xs. [| total(le); transf(le) |] ==>  sorted le (qsort le xs)";
   17.82 +by(res_inst_tac[("xs","xs"),("p","le")]Qsort.qsort_ind 1);
   17.83 +by(simp_tac ss 1);
   17.84 +by(asm_full_simp_tac (ss setloop (split_tac [expand_if])) 1);
   17.85 +by(rewrite_goals_tac [Sorting.total_def,Sorting.transf_def]);
   17.86 +by(fast_tac HOL_cs 1);
   17.87 +result();
    18.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    18.2 +++ b/src/HOL/ex/Qsort.thy	Wed Mar 22 12:42:34 1995 +0100
    18.3 @@ -0,0 +1,27 @@
    18.4 +(*  Title: 	HOL/ex/qsort.thy
    18.5 +    ID:         $Id$
    18.6 +    Author: 	Tobias Nipkow
    18.7 +    Copyright   1994 TU Muenchen
    18.8 +
    18.9 +Quicksort
   18.10 +*)
   18.11 +
   18.12 +Qsort = Sorting +
   18.13 +consts
   18.14 +  qsort  :: "[['a,'a] => bool, 'a list] => 'a list"
   18.15 +
   18.16 +rules
   18.17 +
   18.18 +qsort_Nil  "qsort le [] = []"
   18.19 +qsort_Cons "qsort le (x#xs) = qsort le [y:xs . ~le x y] @ \
   18.20 +\                            (x# qsort le [y:xs . le x y])"
   18.21 +
   18.22 +(* computational induction.
   18.23 +   The dependence of p on x but not xs is intentional.
   18.24 +*)
   18.25 +qsort_ind
   18.26 + "[| P([]); \
   18.27 +\    !!x xs. [| P([y:xs . ~p x y]); P([y:xs . p x y]) |] ==> \
   18.28 +\            P(x#xs) |] \
   18.29 +\ ==> P(xs)"
   18.30 +end
    19.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    19.2 +++ b/src/HOL/ex/ROOT.ML	Wed Mar 22 12:42:34 1995 +0100
    19.3 @@ -0,0 +1,32 @@
    19.4 +(*  Title:  	HOL/ex/ROOT
    19.5 +    ID:         $Id$
    19.6 +    Author: 	Tobias Nipkow, Cambridge University Computer Laboratory
    19.7 +    Copyright   1991  University of Cambridge
    19.8 +
    19.9 +Executes miscellaneous examples for Higher-Order Logic. 
   19.10 +*)
   19.11 +
   19.12 +HOL_build_completed;    (*Cause examples to fail if HOL did*)
   19.13 +
   19.14 +(writeln"Root file for HOL examples";
   19.15 + proof_timing := true;
   19.16 + loadpath := ["ex"];
   19.17 + time_use     "ex/cla.ML";
   19.18 + time_use     "ex/meson.ML";
   19.19 + time_use     "ex/mesontest.ML";
   19.20 + time_use_thy "String";
   19.21 + time_use_thy "InSort";
   19.22 + time_use_thy "Qsort";
   19.23 + time_use_thy "LexProd";
   19.24 + time_use_thy "Puzzle";
   19.25 + time_use_thy "NatSum";
   19.26 + time_use     "ex/set.ML";
   19.27 + time_use_thy "SList";
   19.28 + time_use_thy "LList";
   19.29 + time_use_thy "Acc";
   19.30 + time_use_thy "PropLog";
   19.31 + time_use_thy "Term";
   19.32 + time_use_thy "Simult";
   19.33 + time_use_thy "MT";
   19.34 + writeln     "END: Root file for HOL examples"
   19.35 +)  handle _ => exit 1;
    20.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    20.2 +++ b/src/HOL/ex/Rec.ML	Wed Mar 22 12:42:34 1995 +0100
    20.3 @@ -0,0 +1,5 @@
    20.4 +open Rec;
    20.5 +
    20.6 +goalw thy [mono_def,Domf_def] "mono(Domf(F))";
    20.7 +by (DEPTH_SOLVE (slow_step_tac set_cs 1));
    20.8 +qed "mono_Domf";
    21.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    21.2 +++ b/src/HOL/ex/Rec.thy	Wed Mar 22 12:42:34 1995 +0100
    21.3 @@ -0,0 +1,9 @@
    21.4 +Rec = Fixedpt +
    21.5 +consts
    21.6 +fix	:: "('a=>'a) => 'a"
    21.7 +Dom	:: "(('a=>'b) => ('a=>'b)) => 'a set"
    21.8 +Domf	:: "(('a=>'b) => ('a=>'b)) => 'a set => 'a set"
    21.9 +rules
   21.10 +Domf_def "Domf(F,D) == {y . !f g. (!x:D. f(x)=g(x)) --> F(f,y)=F(g,y)}"
   21.11 +Dom_def  "Dom(F) == lfp(Domf(F))"
   21.12 +end
    22.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    22.2 +++ b/src/HOL/ex/SList.ML	Wed Mar 22 12:42:34 1995 +0100
    22.3 @@ -0,0 +1,397 @@
    22.4 +(*  Title: 	HOL/ex/SList.ML
    22.5 +    ID:         $Id$
    22.6 +    Author: 	Lawrence C Paulson, Cambridge University Computer Laboratory
    22.7 +    Copyright   1993  University of Cambridge
    22.8 +
    22.9 +Definition of type 'a list by a least fixed point
   22.10 +*)
   22.11 +
   22.12 +open SList;
   22.13 +
   22.14 +val list_con_defs = [NIL_def, CONS_def];
   22.15 +
   22.16 +goal SList.thy "list(A) = {Numb(0)} <+> (A <*> list(A))";
   22.17 +let val rew = rewrite_rule list_con_defs in  
   22.18 +by (fast_tac (univ_cs addSIs (equalityI :: map rew list.intrs)
   22.19 +                      addEs [rew list.elim]) 1)
   22.20 +end;
   22.21 +qed "list_unfold";
   22.22 +
   22.23 +(*This justifies using list in other recursive type definitions*)
   22.24 +goalw SList.thy list.defs "!!A B. A<=B ==> list(A) <= list(B)";
   22.25 +by (rtac lfp_mono 1);
   22.26 +by (REPEAT (ares_tac basic_monos 1));
   22.27 +qed "list_mono";
   22.28 +
   22.29 +(*Type checking -- list creates well-founded sets*)
   22.30 +goalw SList.thy (list_con_defs @ list.defs) "list(sexp) <= sexp";
   22.31 +by (rtac lfp_lowerbound 1);
   22.32 +by (fast_tac (univ_cs addIs sexp.intrs@[sexp_In0I,sexp_In1I]) 1);
   22.33 +qed "list_sexp";
   22.34 +
   22.35 +(* A <= sexp ==> list(A) <= sexp *)
   22.36 +bind_thm ("list_subset_sexp", ([list_mono, list_sexp] MRS subset_trans));
   22.37 +
   22.38 +(*Induction for the type 'a list *)
   22.39 +val prems = goalw SList.thy [Nil_def,Cons_def]
   22.40 +    "[| P(Nil);   \
   22.41 +\       !!x xs. P(xs) ==> P(x # xs) |]  ==> P(l)";
   22.42 +by (rtac (Rep_list_inverse RS subst) 1);   (*types force good instantiation*)
   22.43 +by (rtac (Rep_list RS list.induct) 1);
   22.44 +by (REPEAT (ares_tac prems 1
   22.45 +     ORELSE eresolve_tac [rangeE, ssubst, Abs_list_inverse RS subst] 1));
   22.46 +qed "list_induct";
   22.47 +
   22.48 +(*Perform induction on xs. *)
   22.49 +fun list_ind_tac a M = 
   22.50 +    EVERY [res_inst_tac [("l",a)] list_induct M,
   22.51 +	   rename_last_tac a ["1"] (M+1)];
   22.52 +
   22.53 +(*** Isomorphisms ***)
   22.54 +
   22.55 +goal SList.thy "inj(Rep_list)";
   22.56 +by (rtac inj_inverseI 1);
   22.57 +by (rtac Rep_list_inverse 1);
   22.58 +qed "inj_Rep_list";
   22.59 +
   22.60 +goal SList.thy "inj_onto Abs_list (list(range Leaf))";
   22.61 +by (rtac inj_onto_inverseI 1);
   22.62 +by (etac Abs_list_inverse 1);
   22.63 +qed "inj_onto_Abs_list";
   22.64 +
   22.65 +(** Distinctness of constructors **)
   22.66 +
   22.67 +goalw SList.thy list_con_defs "CONS M N ~= NIL";
   22.68 +by (rtac In1_not_In0 1);
   22.69 +qed "CONS_not_NIL";
   22.70 +bind_thm ("NIL_not_CONS", (CONS_not_NIL RS not_sym));
   22.71 +
   22.72 +bind_thm ("CONS_neq_NIL", (CONS_not_NIL RS notE));
   22.73 +val NIL_neq_CONS = sym RS CONS_neq_NIL;
   22.74 +
   22.75 +goalw SList.thy [Nil_def,Cons_def] "x # xs ~= Nil";
   22.76 +by (rtac (CONS_not_NIL RS (inj_onto_Abs_list RS inj_onto_contraD)) 1);
   22.77 +by (REPEAT (resolve_tac (list.intrs @ [rangeI, Rep_list]) 1));
   22.78 +qed "Cons_not_Nil";
   22.79 +
   22.80 +bind_thm ("Nil_not_Cons", (Cons_not_Nil RS not_sym));
   22.81 +
   22.82 +bind_thm ("Cons_neq_Nil", (Cons_not_Nil RS notE));
   22.83 +val Nil_neq_Cons = sym RS Cons_neq_Nil;
   22.84 +
   22.85 +(** Injectiveness of CONS and Cons **)
   22.86 +
   22.87 +goalw SList.thy [CONS_def] "(CONS K M=CONS L N) = (K=L & M=N)";
   22.88 +by (fast_tac (HOL_cs addSEs [Scons_inject, make_elim In1_inject]) 1);
   22.89 +qed "CONS_CONS_eq";
   22.90 +
   22.91 +bind_thm ("CONS_inject", (CONS_CONS_eq RS iffD1 RS conjE));
   22.92 +
   22.93 +(*For reasoning about abstract list constructors*)
   22.94 +val list_cs = set_cs addIs [Rep_list] @ list.intrs
   22.95 +	             addSEs [CONS_neq_NIL,NIL_neq_CONS,CONS_inject]
   22.96 +		     addSDs [inj_onto_Abs_list RS inj_ontoD,
   22.97 +			     inj_Rep_list RS injD, Leaf_inject];
   22.98 +
   22.99 +goalw SList.thy [Cons_def] "(x#xs=y#ys) = (x=y & xs=ys)";
  22.100 +by (fast_tac list_cs 1);
  22.101 +qed "Cons_Cons_eq";
  22.102 +bind_thm ("Cons_inject", (Cons_Cons_eq RS iffD1 RS conjE));
  22.103 +
  22.104 +val [major] = goal SList.thy "CONS M N: list(A) ==> M: A & N: list(A)";
  22.105 +by (rtac (major RS setup_induction) 1);
  22.106 +by (etac list.induct 1);
  22.107 +by (ALLGOALS (fast_tac list_cs));
  22.108 +qed "CONS_D";
  22.109 +
  22.110 +val prems = goalw SList.thy [CONS_def,In1_def]
  22.111 +    "CONS M N: sexp ==> M: sexp & N: sexp";
  22.112 +by (cut_facts_tac prems 1);
  22.113 +by (fast_tac (set_cs addSDs [Scons_D]) 1);
  22.114 +qed "sexp_CONS_D";
  22.115 +
  22.116 +
  22.117 +(*Basic ss with constructors and their freeness*)
  22.118 +val list_free_simps = [Cons_not_Nil, Nil_not_Cons, Cons_Cons_eq,
  22.119 +		       CONS_not_NIL, NIL_not_CONS, CONS_CONS_eq]
  22.120 +                      @ list.intrs;
  22.121 +val list_free_ss = HOL_ss  addsimps  list_free_simps;
  22.122 +
  22.123 +goal SList.thy "!!N. N: list(A) ==> !M. N ~= CONS M N";
  22.124 +by (etac list.induct 1);
  22.125 +by (ALLGOALS (asm_simp_tac list_free_ss));
  22.126 +qed "not_CONS_self";
  22.127 +
  22.128 +goal SList.thy "!x. l ~= x#l";
  22.129 +by (list_ind_tac "l" 1);
  22.130 +by (ALLGOALS (asm_simp_tac list_free_ss));
  22.131 +qed "not_Cons_self";
  22.132 +
  22.133 +
  22.134 +goal SList.thy "(xs ~= []) = (? y ys. xs = y#ys)";
  22.135 +by(list_ind_tac "xs" 1);
  22.136 +by(simp_tac list_free_ss 1);
  22.137 +by(asm_simp_tac list_free_ss 1);
  22.138 +by(REPEAT(resolve_tac [exI,refl,conjI] 1));
  22.139 +qed "neq_Nil_conv";
  22.140 +
  22.141 +(** Conversion rules for List_case: case analysis operator **)
  22.142 +
  22.143 +goalw SList.thy [List_case_def,NIL_def] "List_case c h NIL = c";
  22.144 +by (rtac Case_In0 1);
  22.145 +qed "List_case_NIL";
  22.146 +
  22.147 +goalw SList.thy [List_case_def,CONS_def]  "List_case c h (CONS M N) = h M N";
  22.148 +by (simp_tac (HOL_ss addsimps [Split,Case_In1]) 1);
  22.149 +qed "List_case_CONS";
  22.150 +
  22.151 +(*** List_rec -- by wf recursion on pred_sexp ***)
  22.152 +
  22.153 +(* The trancl(pred_sexp) is essential because pred_sexp_CONS_I1,2 would not
  22.154 +   hold if pred_sexp^+ were changed to pred_sexp. *)
  22.155 +
  22.156 +val List_rec_unfold = [List_rec_def, wf_pred_sexp RS wf_trancl] MRS def_wfrec
  22.157 +                      |> standard;
  22.158 +
  22.159 +(** pred_sexp lemmas **)
  22.160 +
  22.161 +goalw SList.thy [CONS_def,In1_def]
  22.162 +    "!!M. [| M: sexp;  N: sexp |] ==> <M, CONS M N> : pred_sexp^+";
  22.163 +by (asm_simp_tac pred_sexp_ss 1);
  22.164 +qed "pred_sexp_CONS_I1";
  22.165 +
  22.166 +goalw SList.thy [CONS_def,In1_def]
  22.167 +    "!!M. [| M: sexp;  N: sexp |] ==> <N, CONS M N> : pred_sexp^+";
  22.168 +by (asm_simp_tac pred_sexp_ss 1);
  22.169 +qed "pred_sexp_CONS_I2";
  22.170 +
  22.171 +val [prem] = goal SList.thy
  22.172 +    "<CONS M1 M2, N> : pred_sexp^+ ==> \
  22.173 +\    <M1,N> : pred_sexp^+ & <M2,N> : pred_sexp^+";
  22.174 +by (rtac (prem RS (pred_sexp_subset_Sigma RS trancl_subset_Sigma RS 
  22.175 +		   subsetD RS SigmaE2)) 1);
  22.176 +by (etac (sexp_CONS_D RS conjE) 1);
  22.177 +by (REPEAT (ares_tac [conjI, pred_sexp_CONS_I1, pred_sexp_CONS_I2,
  22.178 +		      prem RSN (2, trans_trancl RS transD)] 1));
  22.179 +qed "pred_sexp_CONS_D";
  22.180 +
  22.181 +(** Conversion rules for List_rec **)
  22.182 +
  22.183 +goal SList.thy "List_rec NIL c h = c";
  22.184 +by (rtac (List_rec_unfold RS trans) 1);
  22.185 +by (simp_tac (HOL_ss addsimps [List_case_NIL]) 1);
  22.186 +qed "List_rec_NIL";
  22.187 +
  22.188 +goal SList.thy "!!M. [| M: sexp;  N: sexp |] ==> \
  22.189 +\    List_rec (CONS M N) c h = h M N (List_rec N c h)";
  22.190 +by (rtac (List_rec_unfold RS trans) 1);
  22.191 +by (asm_simp_tac
  22.192 +    (HOL_ss addsimps [List_case_CONS, list.CONS_I, pred_sexp_CONS_I2, 
  22.193 +		      cut_apply])1);
  22.194 +qed "List_rec_CONS";
  22.195 +
  22.196 +(*** list_rec -- by List_rec ***)
  22.197 +
  22.198 +val Rep_list_in_sexp =
  22.199 +    [range_Leaf_subset_sexp RS list_subset_sexp, Rep_list] MRS subsetD;
  22.200 +
  22.201 +local
  22.202 +  val list_rec_simps = list_free_simps @
  22.203 +	          [List_rec_NIL, List_rec_CONS, 
  22.204 +		   Abs_list_inverse, Rep_list_inverse,
  22.205 +		   Rep_list, rangeI, inj_Leaf, Inv_f_f,
  22.206 +		   sexp.LeafI, Rep_list_in_sexp]
  22.207 +in
  22.208 +  val list_rec_Nil = prove_goalw SList.thy [list_rec_def, Nil_def]
  22.209 +      "list_rec Nil c h = c"
  22.210 +   (fn _=> [simp_tac (HOL_ss addsimps list_rec_simps) 1]);
  22.211 +
  22.212 +  val list_rec_Cons = prove_goalw SList.thy [list_rec_def, Cons_def]
  22.213 +      "list_rec (a#l) c h = h a l (list_rec l c h)"
  22.214 +   (fn _=> [simp_tac (HOL_ss addsimps list_rec_simps) 1]);
  22.215 +end;
  22.216 +
  22.217 +val list_simps = [List_rec_NIL, List_rec_CONS,
  22.218 +		  list_rec_Nil, list_rec_Cons];
  22.219 +val list_ss = list_free_ss addsimps list_simps;
  22.220 +
  22.221 +
  22.222 +(*Type checking.  Useful?*)
  22.223 +val major::A_subset_sexp::prems = goal SList.thy
  22.224 +    "[| M: list(A);    	\
  22.225 +\       A<=sexp;      	\
  22.226 +\       c: C(NIL);      \
  22.227 +\       !!x y r. [| x: A;  y: list(A);  r: C(y) |] ==> h x y r: C(CONS x y) \
  22.228 +\    |] ==> List_rec M c h : C(M :: 'a item)";
  22.229 +val sexp_ListA_I = A_subset_sexp RS list_subset_sexp RS subsetD;
  22.230 +val sexp_A_I = A_subset_sexp RS subsetD;
  22.231 +by (rtac (major RS list.induct) 1);
  22.232 +by (ALLGOALS(asm_simp_tac (list_ss addsimps ([sexp_A_I,sexp_ListA_I]@prems))));
  22.233 +qed "List_rec_type";
  22.234 +
  22.235 +(** Generalized map functionals **)
  22.236 +
  22.237 +goalw SList.thy [Rep_map_def] "Rep_map f Nil = NIL";
  22.238 +by (rtac list_rec_Nil 1);
  22.239 +qed "Rep_map_Nil";
  22.240 +
  22.241 +goalw SList.thy [Rep_map_def]
  22.242 +    "Rep_map f (x#xs) = CONS (f x) (Rep_map f xs)";
  22.243 +by (rtac list_rec_Cons 1);
  22.244 +qed "Rep_map_Cons";
  22.245 +
  22.246 +goalw SList.thy [Rep_map_def] "!!f. (!!x. f(x): A) ==> Rep_map f xs: list(A)";
  22.247 +by (rtac list_induct 1);
  22.248 +by(ALLGOALS(asm_simp_tac list_ss));
  22.249 +qed "Rep_map_type";
  22.250 +
  22.251 +goalw SList.thy [Abs_map_def] "Abs_map g NIL = Nil";
  22.252 +by (rtac List_rec_NIL 1);
  22.253 +qed "Abs_map_NIL";
  22.254 +
  22.255 +val prems = goalw SList.thy [Abs_map_def]
  22.256 +    "[| M: sexp;  N: sexp |] ==> \
  22.257 +\    Abs_map g (CONS M N) = g(M) # Abs_map g N";
  22.258 +by (REPEAT (resolve_tac (List_rec_CONS::prems) 1));
  22.259 +qed "Abs_map_CONS";
  22.260 +
  22.261 +(*These 2 rules ease the use of primitive recursion.  NOTE USE OF == *)
  22.262 +val [rew] = goal SList.thy
  22.263 +    "[| !!xs. f(xs) == list_rec xs c h |] ==> f([]) = c";
  22.264 +by (rewtac rew);
  22.265 +by (rtac list_rec_Nil 1);
  22.266 +qed "def_list_rec_Nil";
  22.267 +
  22.268 +val [rew] = goal SList.thy
  22.269 +    "[| !!xs. f(xs) == list_rec xs c h |] ==> f(x#xs) = h x xs (f xs)";
  22.270 +by (rewtac rew);
  22.271 +by (rtac list_rec_Cons 1);
  22.272 +qed "def_list_rec_Cons";
  22.273 +
  22.274 +fun list_recs def =
  22.275 +      [standard (def RS def_list_rec_Nil),
  22.276 +       standard (def RS def_list_rec_Cons)];
  22.277 +
  22.278 +(*** Unfolding the basic combinators ***)
  22.279 +
  22.280 +val [null_Nil,null_Cons] = list_recs null_def;
  22.281 +val [_,hd_Cons] = list_recs hd_def;
  22.282 +val [_,tl_Cons] = list_recs tl_def;
  22.283 +val [ttl_Nil,ttl_Cons] = list_recs ttl_def;
  22.284 +val [append_Nil,append_Cons] = list_recs append_def;
  22.285 +val [mem_Nil, mem_Cons] = list_recs mem_def;
  22.286 +val [map_Nil,map_Cons] = list_recs map_def;
  22.287 +val [list_case_Nil,list_case_Cons] = list_recs list_case_def;
  22.288 +val [filter_Nil,filter_Cons] = list_recs filter_def;
  22.289 +val [list_all_Nil,list_all_Cons] = list_recs list_all_def;
  22.290 +
  22.291 +val list_ss = arith_ss addsimps
  22.292 +  [Cons_not_Nil, Nil_not_Cons, Cons_Cons_eq,
  22.293 +   list_rec_Nil, list_rec_Cons,
  22.294 +   null_Nil, null_Cons, hd_Cons, tl_Cons, ttl_Nil, ttl_Cons,
  22.295 +   mem_Nil, mem_Cons,
  22.296 +   list_case_Nil, list_case_Cons,
  22.297 +   append_Nil, append_Cons,
  22.298 +   map_Nil, map_Cons,
  22.299 +   list_all_Nil, list_all_Cons,
  22.300 +   filter_Nil, filter_Cons];
  22.301 +
  22.302 +
  22.303 +(** @ - append **)
  22.304 +
  22.305 +goal SList.thy "(xs@ys)@zs = xs@(ys@zs)";
  22.306 +by(list_ind_tac "xs" 1);
  22.307 +by(ALLGOALS(asm_simp_tac list_ss));
  22.308 +qed "append_assoc";
  22.309 +
  22.310 +goal SList.thy "xs @ [] = xs";
  22.311 +by(list_ind_tac "xs" 1);
  22.312 +by(ALLGOALS(asm_simp_tac list_ss));
  22.313 +qed "append_Nil2";
  22.314 +
  22.315 +(** mem **)
  22.316 +
  22.317 +goal SList.thy "x mem (xs@ys) = (x mem xs | x mem ys)";
  22.318 +by(list_ind_tac "xs" 1);
  22.319 +by(ALLGOALS(asm_simp_tac (list_ss setloop (split_tac [expand_if]))));
  22.320 +qed "mem_append";
  22.321 +
  22.322 +goal SList.thy "x mem [x:xs.P(x)] = (x mem xs & P(x))";
  22.323 +by(list_ind_tac "xs" 1);
  22.324 +by(ALLGOALS(asm_simp_tac (list_ss setloop (split_tac [expand_if]))));
  22.325 +qed "mem_filter";
  22.326 +
  22.327 +(** list_all **)
  22.328 +
  22.329 +goal SList.thy "(Alls x:xs.True) = True";
  22.330 +by(list_ind_tac "xs" 1);
  22.331 +by(ALLGOALS(asm_simp_tac list_ss));
  22.332 +qed "list_all_True";
  22.333 +
  22.334 +goal SList.thy "list_all p (xs@ys) = (list_all p xs & list_all p ys)";
  22.335 +by(list_ind_tac "xs" 1);
  22.336 +by(ALLGOALS(asm_simp_tac list_ss));
  22.337 +qed "list_all_conj";
  22.338 +
  22.339 +goal SList.thy "(Alls x:xs.P(x)) = (!x. x mem xs --> P(x))";
  22.340 +by(list_ind_tac "xs" 1);
  22.341 +by(ALLGOALS(asm_simp_tac (list_ss setloop (split_tac [expand_if]))));
  22.342 +by(fast_tac HOL_cs 1);
  22.343 +qed "list_all_mem_conv";
  22.344 +
  22.345 +
  22.346 +(** The functional "map" **)
  22.347 +
  22.348 +val map_simps = [Abs_map_NIL, Abs_map_CONS, 
  22.349 +		 Rep_map_Nil, Rep_map_Cons, 
  22.350 +		 map_Nil, map_Cons];
  22.351 +val map_ss = list_free_ss addsimps map_simps;
  22.352 +
  22.353 +val [major,A_subset_sexp,minor] = goal SList.thy 
  22.354 +    "[| M: list(A);  A<=sexp;  !!z. z: A ==> f(g(z)) = z |] \
  22.355 +\    ==> Rep_map f (Abs_map g M) = M";
  22.356 +by (rtac (major RS list.induct) 1);
  22.357 +by (ALLGOALS (asm_simp_tac(map_ss addsimps [sexp_A_I,sexp_ListA_I,minor])));
  22.358 +qed "Abs_map_inverse";
  22.359 +
  22.360 +(*Rep_map_inverse is obtained via Abs_Rep_map and map_ident*)
  22.361 +
  22.362 +(** list_case **)
  22.363 +
  22.364 +goal SList.thy
  22.365 + "P(list_case a f xs) = ((xs=[] --> P(a)) & \
  22.366 +\                        (!y ys. xs=y#ys --> P(f y ys)))";
  22.367 +by(list_ind_tac "xs" 1);
  22.368 +by(ALLGOALS(asm_simp_tac list_ss));
  22.369 +by(fast_tac HOL_cs 1);
  22.370 +qed "expand_list_case";
  22.371 +
  22.372 +
  22.373 +(** Additional mapping lemmas **)
  22.374 +
  22.375 +goal SList.thy "map (%x.x) xs = xs";
  22.376 +by (list_ind_tac "xs" 1);
  22.377 +by (ALLGOALS (asm_simp_tac map_ss));
  22.378 +qed "map_ident";
  22.379 +
  22.380 +goal SList.thy "map f (xs@ys) = map f xs @ map f ys";
  22.381 +by (list_ind_tac "xs" 1);
  22.382 +by (ALLGOALS (asm_simp_tac (map_ss addsimps [append_Nil,append_Cons])));
  22.383 +qed "map_append";
  22.384 +
  22.385 +goalw SList.thy [o_def] "map (f o g) xs = map f (map g xs)";
  22.386 +by (list_ind_tac "xs" 1);
  22.387 +by (ALLGOALS (asm_simp_tac map_ss));
  22.388 +qed "map_compose";
  22.389 +
  22.390 +goal SList.thy "!!f. (!!x. f(x): sexp) ==> \
  22.391 +\	Abs_map g (Rep_map f xs) = map (%t. g(f(t))) xs";
  22.392 +by (list_ind_tac "xs" 1);
  22.393 +by(ALLGOALS(asm_simp_tac(map_ss addsimps
  22.394 +       [Rep_map_type,list_sexp RS subsetD])));
  22.395 +qed "Abs_Rep_map";
  22.396 +
  22.397 +val list_ss = list_ss addsimps
  22.398 +  [mem_append, mem_filter, append_assoc, append_Nil2, map_ident,
  22.399 +   list_all_True, list_all_conj];
  22.400 +
    23.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    23.2 +++ b/src/HOL/ex/SList.thy	Wed Mar 22 12:42:34 1995 +0100
    23.3 @@ -0,0 +1,120 @@
    23.4 +(*  Title:      HOL/ex/SList.thy
    23.5 +    ID:         $Id$
    23.6 +    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    23.7 +    Copyright   1993  University of Cambridge
    23.8 +
    23.9 +Definition of type 'a list (strict lists) by a least fixed point
   23.10 +
   23.11 +We use          list(A) == lfp(%Z. {NUMB(0)} <+> A <*> Z)
   23.12 +and not         list    == lfp(%Z. {NUMB(0)} <+> range(Leaf) <*> Z)
   23.13 +so that list can serve as a "functor" for defining other recursive types
   23.14 +*)
   23.15 +
   23.16 +SList = Sexp +
   23.17 +
   23.18 +types
   23.19 +  'a list
   23.20 +
   23.21 +arities
   23.22 +  list :: (term) term
   23.23 +
   23.24 +
   23.25 +consts
   23.26 +
   23.27 +  list      :: "'a item set => 'a item set"
   23.28 +  Rep_list  :: "'a list => 'a item"
   23.29 +  Abs_list  :: "'a item => 'a list"
   23.30 +  NIL       :: "'a item"
   23.31 +  CONS      :: "['a item, 'a item] => 'a item"
   23.32 +  Nil       :: "'a list"
   23.33 +  "#"       :: "['a, 'a list] => 'a list"                   	(infixr 65)
   23.34 +  List_case :: "['b, ['a item, 'a item]=>'b, 'a item] => 'b"
   23.35 +  List_rec  :: "['a item, 'b, ['a item, 'a item, 'b]=>'b] => 'b"
   23.36 +  list_case :: "['b, ['a, 'a list]=>'b, 'a list] => 'b"
   23.37 +  list_rec  :: "['a list, 'b, ['a, 'a list, 'b]=>'b] => 'b"
   23.38 +  Rep_map   :: "('b => 'a item) => ('b list => 'a item)"
   23.39 +  Abs_map   :: "('a item => 'b) => 'a item => 'b list"
   23.40 +  null      :: "'a list => bool"
   23.41 +  hd        :: "'a list => 'a"
   23.42 +  tl,ttl    :: "'a list => 'a list"
   23.43 +  mem		:: "['a, 'a list] => bool"			(infixl 55)
   23.44 +  list_all  :: "('a => bool) => ('a list => bool)"
   23.45 +  map       :: "('a=>'b) => ('a list => 'b list)"
   23.46 +  "@"	    :: "['a list, 'a list] => 'a list"			(infixr 65)
   23.47 +  filter    :: "['a => bool, 'a list] => 'a list"
   23.48 +
   23.49 +  (* list Enumeration *)
   23.50 +
   23.51 +  "[]"      :: "'a list"                            ("[]")
   23.52 +  "@list"   :: "args => 'a list"                    ("[(_)]")
   23.53 +
   23.54 +  (* Special syntax for list_all and filter *)
   23.55 +  "@Alls"	:: "[idt, 'a list, bool] => bool"	("(2Alls _:_./ _)" 10)
   23.56 +  "@filter"	:: "[idt, 'a list, bool] => 'a list"	("(1[_:_ ./ _])")
   23.57 +
   23.58 +translations
   23.59 +  "[x, xs]"     == "x#[xs]"
   23.60 +  "[x]"         == "x#[]"
   23.61 +  "[]"          == "Nil"
   23.62 +
   23.63 +  "case xs of Nil => a | y#ys => b" == "list_case a (%y ys.b) xs"
   23.64 +
   23.65 +  "[x:xs . P]"	== "filter (%x.P) xs"
   23.66 +  "Alls x:xs.P"	== "list_all (%x.P) xs"
   23.67 +
   23.68 +defs
   23.69 +  (* Defining the Concrete Constructors *)
   23.70 +  NIL_def       "NIL == In0(Numb(0))"
   23.71 +  CONS_def      "CONS M N == In1(M $ N)"
   23.72 +
   23.73 +inductive "list(A)"
   23.74 +  intrs
   23.75 +    NIL_I  "NIL: list(A)"
   23.76 +    CONS_I "[| a: A;  M: list(A) |] ==> CONS a M : list(A)"
   23.77 +
   23.78 +rules
   23.79 +  (* Faking a Type Definition ... *)
   23.80 +  Rep_list          "Rep_list(xs): list(range(Leaf))"
   23.81 +  Rep_list_inverse  "Abs_list(Rep_list(xs)) = xs"
   23.82 +  Abs_list_inverse  "M: list(range(Leaf)) ==> Rep_list(Abs_list(M)) = M"
   23.83 +
   23.84 +
   23.85 +defs
   23.86 +  (* Defining the Abstract Constructors *)
   23.87 +  Nil_def       "Nil == Abs_list(NIL)"
   23.88 +  Cons_def      "x#xs == Abs_list(CONS (Leaf x) (Rep_list xs))"
   23.89 +
   23.90 +  List_case_def "List_case c d == Case (%x.c) (Split d)"
   23.91 +
   23.92 +  (* list Recursion -- the trancl is Essential; see list.ML *)
   23.93 +
   23.94 +  List_rec_def
   23.95 +   "List_rec M c d == wfrec (trancl pred_sexp) M \
   23.96 +\                           (List_case (%g.c) (%x y g. d x y (g y)))"
   23.97 +
   23.98 +  list_rec_def
   23.99 +   "list_rec l c d == \
  23.100 +\   List_rec (Rep_list l) c (%x y r. d (Inv Leaf x) (Abs_list y) r)"
  23.101 +
  23.102 +  (* Generalized Map Functionals *)
  23.103 +
  23.104 +  Rep_map_def "Rep_map f xs == list_rec xs NIL (%x l r. CONS (f x) r)"
  23.105 +  Abs_map_def "Abs_map g M == List_rec M Nil (%N L r. g(N)#r)"
  23.106 +
  23.107 +  null_def      "null(xs)            == list_rec xs True (%x xs r.False)"
  23.108 +  hd_def        "hd(xs)              == list_rec xs (@x.True) (%x xs r.x)"
  23.109 +  tl_def        "tl(xs)              == list_rec xs (@xs.True) (%x xs r.xs)"
  23.110 +  (* a total version of tl: *)
  23.111 +  ttl_def	"ttl(xs)             == list_rec xs [] (%x xs r.xs)"
  23.112 +
  23.113 +  mem_def	"x mem xs            == \
  23.114 +\		   list_rec xs False (%y ys r. if y=x then True else r)"
  23.115 +  list_all_def  "list_all P xs       == list_rec xs True (%x l r. P(x) & r)"
  23.116 +  map_def       "map f xs            == list_rec xs [] (%x l r. f(x)#r)"
  23.117 +  append_def	"xs@ys               == list_rec xs ys (%x l r. x#r)"
  23.118 +  filter_def	"filter P xs         == \
  23.119 +\                  list_rec xs [] (%x xs r. if P(x) then x#r else r)"
  23.120 +
  23.121 +  list_case_def "list_case a f xs == list_rec xs a (%x xs r.f x xs)"
  23.122 +
  23.123 +end
    24.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    24.2 +++ b/src/HOL/ex/Simult.ML	Wed Mar 22 12:42:34 1995 +0100
    24.3 @@ -0,0 +1,287 @@
    24.4 +(*  Title: 	HOL/ex/Simult.ML
    24.5 +    ID:         $Id$
    24.6 +    Author: 	Lawrence C Paulson, Cambridge University Computer Laboratory
    24.7 +    Copyright   1993  University of Cambridge
    24.8 +
    24.9 +Primitives for simultaneous recursive type definitions
   24.10 +  includes worked example of trees & forests
   24.11 +
   24.12 +This is essentially the same data structure that on ex/term.ML, which is
   24.13 +simpler because it uses list as a new type former.  The approach in this
   24.14 +file may be superior for other simultaneous recursions.
   24.15 +*)
   24.16 +
   24.17 +open Simult;
   24.18 +
   24.19 +(*** Monotonicity and unfolding of the function ***)
   24.20 +
   24.21 +goal Simult.thy "mono(%Z.  A <*> Part Z In1 \
   24.22 +\                      <+> ({Numb(0)} <+> Part Z In0 <*> Part Z In1))";
   24.23 +by (REPEAT (ares_tac [monoI, subset_refl, usum_mono, uprod_mono,
   24.24 +		      Part_mono] 1));
   24.25 +qed "TF_fun_mono";
   24.26 +
   24.27 +val TF_unfold = TF_fun_mono RS (TF_def RS def_lfp_Tarski);
   24.28 +
   24.29 +goalw Simult.thy [TF_def] "!!A B. A<=B ==> TF(A) <= TF(B)";
   24.30 +by (REPEAT (ares_tac [lfp_mono, subset_refl, usum_mono, uprod_mono] 1));
   24.31 +qed "TF_mono";
   24.32 +
   24.33 +goalw Simult.thy [TF_def] "TF(sexp) <= sexp";
   24.34 +by (rtac lfp_lowerbound 1);
   24.35 +by (fast_tac (univ_cs addIs  sexp.intrs@[sexp_In0I, sexp_In1I]
   24.36 +                      addSEs [PartE]) 1);
   24.37 +qed "TF_sexp";
   24.38 +
   24.39 +(* A <= sexp ==> TF(A) <= sexp *)
   24.40 +val TF_subset_sexp = standard
   24.41 +    (TF_mono RS (TF_sexp RSN (2,subset_trans)));
   24.42 +
   24.43 +
   24.44 +(** Elimination -- structural induction on the set TF **)
   24.45 +
   24.46 +val TF_Rep_defs = [TCONS_def,FNIL_def,FCONS_def,NIL_def,CONS_def];
   24.47 +
   24.48 +val major::prems = goalw Simult.thy TF_Rep_defs
   24.49 + "[| i: TF(A);  \
   24.50 +\    !!M N. [| M: A;  N: Part (TF A) In1;  R(N) |] ==> R(TCONS M N);	\
   24.51 +\    R(FNIL);        		\
   24.52 +\    !!M N. [| M:  Part (TF A) In0;  N: Part (TF A) In1;  R(M);  R(N) \
   24.53 +\            |] ==> R(FCONS M N)    \
   24.54 +\    |] ==> R(i)";
   24.55 +by (rtac ([TF_def, TF_fun_mono, major] MRS def_induct) 1);
   24.56 +by (fast_tac (set_cs addIs (prems@[PartI])
   24.57 +		       addEs [usumE, uprodE, PartE]) 1);
   24.58 +qed "TF_induct";
   24.59 +
   24.60 +(*This lemma replaces a use of subgoal_tac to prove tree_forest_induct*)
   24.61 +val prems = goalw Simult.thy [Part_def]
   24.62 + "! M: TF(A). (M: Part (TF A) In0 --> P(M)) & (M: Part (TF A) In1 --> Q(M)) \
   24.63 +\ ==> (! M: Part (TF A) In0. P(M)) & (! M: Part (TF A) In1. Q(M))";
   24.64 +by (cfast_tac prems 1);
   24.65 +qed "TF_induct_lemma";
   24.66 +
   24.67 +val uplus_cs = set_cs addSIs [PartI]
   24.68 +		      addSDs [In0_inject, In1_inject]
   24.69 +		      addSEs [In0_neq_In1, In1_neq_In0, PartE];
   24.70 +
   24.71 +(*Could prove  ~ TCONS M N : Part (TF A) In1  etc. *)
   24.72 +
   24.73 +(*Induction on TF with separate predicates P, Q*)
   24.74 +val prems = goalw Simult.thy TF_Rep_defs
   24.75 +    "[| !!M N. [| M: A;  N: Part (TF A) In1;  Q(N) |] ==> P(TCONS M N); \
   24.76 +\       Q(FNIL);        \
   24.77 +\       !!M N. [| M:  Part (TF A) In0;  N: Part (TF A) In1;  P(M);  Q(N) \
   24.78 +\               |] ==> Q(FCONS M N)     \
   24.79 +\    |] ==> (! M: Part (TF A) In0. P(M)) & (! N: Part (TF A) In1. Q(N))";
   24.80 +by (rtac (ballI RS TF_induct_lemma) 1);
   24.81 +by (etac TF_induct 1);
   24.82 +by (rewrite_goals_tac TF_Rep_defs);
   24.83 +by (ALLGOALS (fast_tac (uplus_cs addIs prems)));
   24.84 +(*29 secs??*)
   24.85 +qed "Tree_Forest_induct";
   24.86 +
   24.87 +(*Induction for the abstract types 'a tree, 'a forest*)
   24.88 +val prems = goalw Simult.thy [Tcons_def,Fnil_def,Fcons_def]
   24.89 +    "[| !!x ts. Q(ts) ==> P(Tcons x ts);     \
   24.90 +\	Q(Fnil);        \
   24.91 +\       !!t ts. [| P(t);  Q(ts) |] ==> Q(Fcons t ts)    \
   24.92 +\    |] ==> (! t. P(t)) & (! ts. Q(ts))";
   24.93 +by (res_inst_tac [("P1","%z.P(Abs_Tree(z))"),
   24.94 +		  ("Q1","%z.Q(Abs_Forest(z))")] 
   24.95 +    (Tree_Forest_induct RS conjE) 1);
   24.96 +(*Instantiates ?A1 to range(Leaf). *)
   24.97 +by (fast_tac (set_cs addSEs [Rep_Tree_inverse RS subst, 
   24.98 +			     Rep_Forest_inverse RS subst] 
   24.99 +	             addSIs [Rep_Tree,Rep_Forest]) 4);
  24.100 +(*Cannot use simplifier: the rewrites work in the wrong direction!*)
  24.101 +by (ALLGOALS (fast_tac (set_cs addSEs [Abs_Tree_inverse RS subst,
  24.102 +                          Abs_Forest_inverse RS subst] 
  24.103 +	             addSIs prems)));
  24.104 +qed "tree_forest_induct";
  24.105 +
  24.106 +
  24.107 +
  24.108 +(*** Isomorphisms ***)
  24.109 +
  24.110 +goal Simult.thy "inj(Rep_Tree)";
  24.111 +by (rtac inj_inverseI 1);
  24.112 +by (rtac Rep_Tree_inverse 1);
  24.113 +qed "inj_Rep_Tree";
  24.114 +
  24.115 +goal Simult.thy "inj_onto Abs_Tree (Part (TF(range Leaf)) In0)";
  24.116 +by (rtac inj_onto_inverseI 1);
  24.117 +by (etac Abs_Tree_inverse 1);
  24.118 +qed "inj_onto_Abs_Tree";
  24.119 +
  24.120 +goal Simult.thy "inj(Rep_Forest)";
  24.121 +by (rtac inj_inverseI 1);
  24.122 +by (rtac Rep_Forest_inverse 1);
  24.123 +qed "inj_Rep_Forest";
  24.124 +
  24.125 +goal Simult.thy "inj_onto Abs_Forest (Part (TF(range Leaf)) In1)";
  24.126 +by (rtac inj_onto_inverseI 1);
  24.127 +by (etac Abs_Forest_inverse 1);
  24.128 +qed "inj_onto_Abs_Forest";
  24.129 +
  24.130 +(** Introduction rules for constructors **)
  24.131 +
  24.132 +(* c : A <*> Part (TF A) In1 
  24.133 +        <+> {Numb(0)} <+> Part (TF A) In0 <*> Part (TF A) In1 ==> c : TF(A) *)
  24.134 +val TF_I = TF_unfold RS equalityD2 RS subsetD;
  24.135 +
  24.136 +(*For reasoning about the representation*)
  24.137 +val TF_Rep_cs = uplus_cs addIs [TF_I, uprodI, usum_In0I, usum_In1I]
  24.138 +	                 addSEs [Scons_inject];
  24.139 +
  24.140 +val prems = goalw Simult.thy TF_Rep_defs
  24.141 +    "[| a: A;  M: Part (TF A) In1 |] ==> TCONS a M : Part (TF A) In0";
  24.142 +by (fast_tac (TF_Rep_cs addIs prems) 1);
  24.143 +qed "TCONS_I";
  24.144 +
  24.145 +(* FNIL is a TF(A) -- this also justifies the type definition*)
  24.146 +goalw Simult.thy TF_Rep_defs "FNIL: Part (TF A) In1";
  24.147 +by (fast_tac TF_Rep_cs 1);
  24.148 +qed "FNIL_I";
  24.149 +
  24.150 +val prems = goalw Simult.thy TF_Rep_defs
  24.151 +    "[| M: Part (TF A) In0;  N: Part (TF A) In1 |] ==> \
  24.152 +\    FCONS M N : Part (TF A) In1";
  24.153 +by (fast_tac (TF_Rep_cs addIs prems) 1);
  24.154 +qed "FCONS_I";
  24.155 +
  24.156 +(** Injectiveness of TCONS and FCONS **)
  24.157 +
  24.158 +goalw Simult.thy TF_Rep_defs "(TCONS K M=TCONS L N) = (K=L & M=N)";
  24.159 +by (fast_tac TF_Rep_cs 1);
  24.160 +qed "TCONS_TCONS_eq";
  24.161 +bind_thm ("TCONS_inject", (TCONS_TCONS_eq RS iffD1 RS conjE));
  24.162 +
  24.163 +goalw Simult.thy TF_Rep_defs "(FCONS K M=FCONS L N) = (K=L & M=N)";
  24.164 +by (fast_tac TF_Rep_cs 1);
  24.165 +qed "FCONS_FCONS_eq";
  24.166 +bind_thm ("FCONS_inject", (FCONS_FCONS_eq RS iffD1 RS conjE));
  24.167 +
  24.168 +(** Distinctness of TCONS, FNIL and FCONS **)
  24.169 +
  24.170 +goalw Simult.thy TF_Rep_defs "TCONS M N ~= FNIL";
  24.171 +by (fast_tac TF_Rep_cs 1);
  24.172 +qed "TCONS_not_FNIL";
  24.173 +bind_thm ("FNIL_not_TCONS", (TCONS_not_FNIL RS not_sym));
  24.174 +
  24.175 +bind_thm ("TCONS_neq_FNIL", (TCONS_not_FNIL RS notE));
  24.176 +val FNIL_neq_TCONS = sym RS TCONS_neq_FNIL;
  24.177 +
  24.178 +goalw Simult.thy TF_Rep_defs "FCONS M N ~= FNIL";
  24.179 +by (fast_tac TF_Rep_cs 1);
  24.180 +qed "FCONS_not_FNIL";
  24.181 +bind_thm ("FNIL_not_FCONS", (FCONS_not_FNIL RS not_sym));
  24.182 +
  24.183 +bind_thm ("FCONS_neq_FNIL", (FCONS_not_FNIL RS notE));
  24.184 +val FNIL_neq_FCONS = sym RS FCONS_neq_FNIL;
  24.185 +
  24.186 +goalw Simult.thy TF_Rep_defs "TCONS M N ~= FCONS K L";
  24.187 +by (fast_tac TF_Rep_cs 1);
  24.188 +qed "TCONS_not_FCONS";
  24.189 +bind_thm ("FCONS_not_TCONS", (TCONS_not_FCONS RS not_sym));
  24.190 +
  24.191 +bind_thm ("TCONS_neq_FCONS", (TCONS_not_FCONS RS notE));
  24.192 +val FCONS_neq_TCONS = sym RS TCONS_neq_FCONS;
  24.193 +
  24.194 +(*???? Too many derived rules ????
  24.195 +  Automatically generate symmetric forms?  Always expand TF_Rep_defs? *)
  24.196 +
  24.197 +(** Injectiveness of Tcons and Fcons **)
  24.198 +
  24.199 +(*For reasoning about abstract constructors*)
  24.200 +val TF_cs = set_cs addSIs [Rep_Tree, Rep_Forest, TCONS_I, FNIL_I, FCONS_I]
  24.201 +	           addSEs [TCONS_inject, FCONS_inject,
  24.202 +			   TCONS_neq_FNIL, FNIL_neq_TCONS,
  24.203 +			   FCONS_neq_FNIL, FNIL_neq_FCONS,
  24.204 +			   TCONS_neq_FCONS, FCONS_neq_TCONS]
  24.205 +		   addSDs [inj_onto_Abs_Tree RS inj_ontoD,
  24.206 +			   inj_onto_Abs_Forest RS inj_ontoD,
  24.207 +			   inj_Rep_Tree RS injD, inj_Rep_Forest RS injD,
  24.208 +			   Leaf_inject];
  24.209 +
  24.210 +goalw Simult.thy [Tcons_def] "(Tcons x xs=Tcons y ys) = (x=y & xs=ys)";
  24.211 +by (fast_tac TF_cs 1);
  24.212 +qed "Tcons_Tcons_eq";
  24.213 +bind_thm ("Tcons_inject", (Tcons_Tcons_eq RS iffD1 RS conjE));
  24.214 +
  24.215 +goalw Simult.thy [Fcons_def,Fnil_def] "Fcons x xs ~= Fnil";
  24.216 +by (fast_tac TF_cs 1);
  24.217 +qed "Fcons_not_Fnil";
  24.218 +
  24.219 +bind_thm ("Fcons_neq_Fnil", Fcons_not_Fnil RS notE);
  24.220 +val Fnil_neq_Fcons = sym RS Fcons_neq_Fnil;
  24.221 +
  24.222 +
  24.223 +(** Injectiveness of Fcons **)
  24.224 +
  24.225 +goalw Simult.thy [Fcons_def] "(Fcons x xs=Fcons y ys) = (x=y & xs=ys)";
  24.226 +by (fast_tac TF_cs 1);
  24.227 +qed "Fcons_Fcons_eq";
  24.228 +bind_thm ("Fcons_inject", Fcons_Fcons_eq RS iffD1 RS conjE);
  24.229 +
  24.230 +
  24.231 +(*** TF_rec -- by wf recursion on pred_sexp ***)
  24.232 +
  24.233 +val TF_rec_unfold =
  24.234 +    wf_pred_sexp RS wf_trancl RS (TF_rec_def RS def_wfrec);
  24.235 +
  24.236 +(** conversion rules for TF_rec **)
  24.237 +
  24.238 +goalw Simult.thy [TCONS_def]
  24.239 +    "!!M N. [| M: sexp;  N: sexp |] ==> 	\
  24.240 +\           TF_rec (TCONS M N) b c d = b M N (TF_rec N b c d)";
  24.241 +by (rtac (TF_rec_unfold RS trans) 1);
  24.242 +by (simp_tac (HOL_ss addsimps [Case_In0, Split]) 1);
  24.243 +by (asm_simp_tac (pred_sexp_ss addsimps [In0_def]) 1);
  24.244 +qed "TF_rec_TCONS";
  24.245 +
  24.246 +goalw Simult.thy [FNIL_def] "TF_rec FNIL b c d = c";
  24.247 +by (rtac (TF_rec_unfold RS trans) 1);
  24.248 +by (simp_tac (HOL_ss addsimps [Case_In1, List_case_NIL]) 1);
  24.249 +qed "TF_rec_FNIL";
  24.250 +
  24.251 +goalw Simult.thy [FCONS_def]
  24.252 + "!!M N. [| M: sexp;  N: sexp |] ==> 	\
  24.253 +\        TF_rec (FCONS M N) b c d = d M N (TF_rec M b c d) (TF_rec N b c d)";
  24.254 +by (rtac (TF_rec_unfold RS trans) 1);
  24.255 +by (simp_tac (HOL_ss addsimps [Case_In1, List_case_CONS]) 1);
  24.256 +by (asm_simp_tac (pred_sexp_ss addsimps [CONS_def,In1_def]) 1);
  24.257 +qed "TF_rec_FCONS";
  24.258 +
  24.259 +
  24.260 +(*** tree_rec, forest_rec -- by TF_rec ***)
  24.261 +
  24.262 +val Rep_Tree_in_sexp =
  24.263 +    [range_Leaf_subset_sexp RS TF_subset_sexp RS (Part_subset RS subset_trans),
  24.264 +     Rep_Tree] MRS subsetD;
  24.265 +val Rep_Forest_in_sexp =
  24.266 +    [range_Leaf_subset_sexp RS TF_subset_sexp RS (Part_subset RS subset_trans),
  24.267 +     Rep_Forest] MRS subsetD;
  24.268 +
  24.269 +val tf_rec_simps = [TF_rec_TCONS, TF_rec_FNIL, TF_rec_FCONS,
  24.270 +		    TCONS_I, FNIL_I, FCONS_I, Rep_Tree, Rep_Forest,
  24.271 +		    Rep_Tree_inverse, Rep_Forest_inverse,
  24.272 +		    Abs_Tree_inverse, Abs_Forest_inverse,
  24.273 +		    inj_Leaf, Inv_f_f, sexp.LeafI, range_eqI,
  24.274 +		    Rep_Tree_in_sexp, Rep_Forest_in_sexp];
  24.275 +val tf_rec_ss = HOL_ss addsimps tf_rec_simps;
  24.276 +
  24.277 +goalw Simult.thy [tree_rec_def, forest_rec_def, Tcons_def]
  24.278 +    "tree_rec (Tcons a tf) b c d = b a tf (forest_rec tf b c d)";
  24.279 +by (simp_tac tf_rec_ss 1);
  24.280 +qed "tree_rec_Tcons";
  24.281 +
  24.282 +goalw Simult.thy [forest_rec_def, Fnil_def] "forest_rec Fnil b c d = c";
  24.283 +by (simp_tac tf_rec_ss 1);
  24.284 +qed "forest_rec_Fnil";
  24.285 +
  24.286 +goalw Simult.thy [tree_rec_def, forest_rec_def, Fcons_def]
  24.287 +    "forest_rec (Fcons t tf) b c d = \
  24.288 +\    d t tf (tree_rec t b c d) (forest_rec tf b c d)";
  24.289 +by (simp_tac tf_rec_ss 1);
  24.290 +qed "forest_rec_Cons";
    25.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    25.2 +++ b/src/HOL/ex/Simult.thy	Wed Mar 22 12:42:34 1995 +0100
    25.3 @@ -0,0 +1,82 @@
    25.4 +(*  Title: 	HOL/ex/Simult
    25.5 +    ID:         $Id$
    25.6 +    Author: 	Lawrence C Paulson, Cambridge University Computer Laboratory
    25.7 +    Copyright   1993  University of Cambridge
    25.8 +
    25.9 +A simultaneous recursive type definition: trees & forests
   25.10 +
   25.11 +This is essentially the same data structure that on ex/term.ML, which is
   25.12 +simpler because it uses list as a new type former.  The approach in this
   25.13 +file may be superior for other simultaneous recursions.
   25.14 +
   25.15 +The inductive definition package does not help defining this sort of mutually
   25.16 +recursive data structure because it uses Inl, Inr instead of In0, In1.
   25.17 +*)
   25.18 +
   25.19 +Simult = SList +
   25.20 +
   25.21 +types    'a tree
   25.22 +         'a forest
   25.23 +
   25.24 +arities  tree,forest :: (term)term
   25.25 +
   25.26 +consts
   25.27 +  TF          :: "'a item set => 'a item set"
   25.28 +  FNIL        :: "'a item"
   25.29 +  TCONS,FCONS :: "['a item, 'a item] => 'a item"
   25.30 +  Rep_Tree    :: "'a tree => 'a item"
   25.31 +  Abs_Tree    :: "'a item => 'a tree"
   25.32 +  Rep_Forest  :: "'a forest => 'a item"
   25.33 +  Abs_Forest  :: "'a item => 'a forest"
   25.34 +  Tcons       :: "['a, 'a forest] => 'a tree"
   25.35 +  Fcons       :: "['a tree, 'a forest] => 'a forest"
   25.36 +  Fnil        :: "'a forest"
   25.37 +  TF_rec      :: "['a item, ['a item , 'a item, 'b]=>'b,     \
   25.38 +\                 'b, ['a item , 'a item, 'b, 'b]=>'b] => 'b"
   25.39 +  tree_rec    :: "['a tree, ['a, 'a forest, 'b]=>'b,          \
   25.40 +\                 'b, ['a tree, 'a forest, 'b, 'b]=>'b] => 'b"
   25.41 +  forest_rec  :: "['a forest, ['a, 'a forest, 'b]=>'b,        \
   25.42 +\                  'b, ['a tree, 'a forest, 'b, 'b]=>'b] => 'b"
   25.43 +
   25.44 +defs
   25.45 +     (*the concrete constants*)
   25.46 +  TCONS_def 	"TCONS M N == In0(M $ N)"
   25.47 +  FNIL_def	"FNIL      == In1(NIL)"
   25.48 +  FCONS_def	"FCONS M N == In1(CONS M N)"
   25.49 +     (*the abstract constants*)
   25.50 +  Tcons_def 	"Tcons a ts == Abs_Tree(TCONS (Leaf a) (Rep_Forest ts))"
   25.51 +  Fnil_def  	"Fnil       == Abs_Forest(FNIL)"
   25.52 +  Fcons_def 	"Fcons t ts == Abs_Forest(FCONS (Rep_Tree t) (Rep_Forest ts))"
   25.53 +
   25.54 +  TF_def	"TF(A) == lfp(%Z. A <*> Part Z In1 \
   25.55 +\                           <+> ({Numb(0)} <+> Part Z In0 <*> Part Z In1))"
   25.56 +
   25.57 +rules
   25.58 +  (*faking a type definition for tree...*)
   25.59 +  Rep_Tree 	   "Rep_Tree(n): Part (TF(range Leaf)) In0"
   25.60 +  Rep_Tree_inverse "Abs_Tree(Rep_Tree(t)) = t"
   25.61 +  Abs_Tree_inverse "z: Part (TF(range Leaf)) In0 ==> Rep_Tree(Abs_Tree(z)) = z"
   25.62 +    (*faking a type definition for forest...*)
   25.63 +  Rep_Forest 	     "Rep_Forest(n): Part (TF(range Leaf)) In1"
   25.64 +  Rep_Forest_inverse "Abs_Forest(Rep_Forest(ts)) = ts"
   25.65 +  Abs_Forest_inverse 
   25.66 +	"z: Part (TF(range Leaf)) In1 ==> Rep_Forest(Abs_Forest(z)) = z"
   25.67 +
   25.68 +
   25.69 +defs
   25.70 +     (*recursion*)
   25.71 +  TF_rec_def	
   25.72 +   "TF_rec M b c d == wfrec (trancl pred_sexp) M   \
   25.73 +\               (Case (Split(%x y g. b x y (g y))) \
   25.74 +\	              (List_case (%g.c) (%x y g. d x y (g x) (g y))))"
   25.75 +
   25.76 +  tree_rec_def
   25.77 +   "tree_rec t b c d == \
   25.78 +\   TF_rec (Rep_Tree t) (%x y r. b (Inv Leaf x) (Abs_Forest y) r) \
   25.79 +\          c (%x y rt rf. d (Abs_Tree x) (Abs_Forest y) rt rf)"
   25.80 +
   25.81 +  forest_rec_def
   25.82 +   "forest_rec tf b c d == \
   25.83 +\   TF_rec (Rep_Forest tf) (%x y r. b (Inv Leaf x) (Abs_Forest y) r) \
   25.84 +\          c (%x y rt rf. d (Abs_Tree x) (Abs_Forest y) rt rf)"
   25.85 +end
    26.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    26.2 +++ b/src/HOL/ex/Sorting.ML	Wed Mar 22 12:42:34 1995 +0100
    26.3 @@ -0,0 +1,26 @@
    26.4 +(*  Title: 	HOL/ex/sorting.ML
    26.5 +    ID:         $Id$
    26.6 +    Author: 	Tobias Nipkow
    26.7 +    Copyright   1994 TU Muenchen
    26.8 +
    26.9 +Some general lemmas
   26.10 +*)
   26.11 +
   26.12 +val sorting_ss = list_ss addsimps
   26.13 +      [Sorting.mset_Nil,Sorting.mset_Cons,
   26.14 +       Sorting.sorted_Nil,Sorting.sorted_Cons,
   26.15 +       Sorting.sorted1_Nil,Sorting.sorted1_One,Sorting.sorted1_Cons];
   26.16 +
   26.17 +goal Sorting.thy "!x.mset (xs@ys) x = mset xs x + mset ys x";
   26.18 +by(list.induct_tac "xs" 1);
   26.19 +by(ALLGOALS(asm_simp_tac (sorting_ss setloop (split_tac [expand_if]))));
   26.20 +qed "mset_app_distr";
   26.21 +
   26.22 +goal Sorting.thy "!x. mset [x:xs. ~p(x)] x + mset [x:xs.p(x)] x = \
   26.23 +\                     mset xs x";
   26.24 +by(list.induct_tac "xs" 1);
   26.25 +by(ALLGOALS(asm_simp_tac (sorting_ss setloop (split_tac [expand_if]))));
   26.26 +qed "mset_compl_add";
   26.27 +
   26.28 +val sorting_ss = sorting_ss addsimps
   26.29 +      [mset_app_distr, mset_compl_add];
    27.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    27.2 +++ b/src/HOL/ex/Sorting.thy	Wed Mar 22 12:42:34 1995 +0100
    27.3 @@ -0,0 +1,31 @@
    27.4 +(*  Title: 	HOL/ex/sorting.thy
    27.5 +    ID:         $Id$
    27.6 +    Author: 	Tobias Nipkow
    27.7 +    Copyright   1994 TU Muenchen
    27.8 +
    27.9 +Specification of sorting
   27.10 +*)
   27.11 +
   27.12 +Sorting = List +
   27.13 +consts
   27.14 +  sorted1:: "[['a,'a] => bool, 'a list] => bool"
   27.15 +  sorted :: "[['a,'a] => bool, 'a list] => bool"
   27.16 +  mset   :: "'a list => ('a => nat)"
   27.17 +  total  :: "(['a,'a] => bool) => bool"
   27.18 +  transf :: "(['a,'a] => bool) => bool"
   27.19 +
   27.20 +rules
   27.21 +
   27.22 +sorted1_Nil  "sorted1 f []"
   27.23 +sorted1_One  "sorted1 f [x]"
   27.24 +sorted1_Cons "sorted1 f (Cons x (y#zs)) = (f x y & sorted1 f (y#zs))"
   27.25 +
   27.26 +sorted_Nil "sorted le []"
   27.27 +sorted_Cons "sorted le (x#xs) = ((Alls y:xs. le x y) & sorted le xs)"
   27.28 +
   27.29 +mset_Nil "mset [] y = 0"
   27.30 +mset_Cons "mset (x#xs) y = (if x=y then Suc(mset xs y) else mset xs y)"
   27.31 +
   27.32 +total_def  "total r == (!x y. r x y | r y x)"
   27.33 +transf_def "transf f == (!x y z. f x y & f y z --> f x z)"
   27.34 +end
    28.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    28.2 +++ b/src/HOL/ex/String.ML	Wed Mar 22 12:42:34 1995 +0100
    28.3 @@ -0,0 +1,22 @@
    28.4 +val string_ss = list_ss addsimps (String.nibble.simps @ String.char.simps);
    28.5 +
    28.6 +goal String.thy "hd(''ABCD'') = CHR ''A''";
    28.7 +by(simp_tac string_ss 1);
    28.8 +result();
    28.9 +
   28.10 +goal String.thy "hd(''ABCD'') ~= CHR ''B''";
   28.11 +by(simp_tac string_ss 1);
   28.12 +result();
   28.13 +
   28.14 +goal String.thy "''ABCD'' ~= ''ABCX''";
   28.15 +by(simp_tac string_ss 1);
   28.16 +result();
   28.17 +
   28.18 +goal String.thy "''ABCD'' = ''ABCD''";
   28.19 +by(simp_tac string_ss 1);
   28.20 +result();
   28.21 +
   28.22 +goal String.thy
   28.23 +  "''ABCDEFGHIJKLMNOPQRSTUVWXYZ'' ~= ''ABCDEFGHIJKLMNOPQRSTUVWXY''";
   28.24 +by(simp_tac string_ss 1);
   28.25 +result();
    29.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    29.2 +++ b/src/HOL/ex/String.thy	Wed Mar 22 12:42:34 1995 +0100
    29.3 @@ -0,0 +1,90 @@
    29.4 +(*  Title:      HOL/String.thy
    29.5 +    ID:         $Id$
    29.6 +
    29.7 +Hex chars. Strings.
    29.8 +*)
    29.9 +
   29.10 +String = List +
   29.11 +
   29.12 +datatype
   29.13 +  nibble = H00 | H01 | H02 | H03 | H04 | H05 | H06 | H07
   29.14 +         | H08 | H09 | H0A | H0B | H0C | H0D | H0E | H0F
   29.15 +
   29.16 +datatype
   29.17 +  char = Char (nibble, nibble)
   29.18 +
   29.19 +types
   29.20 +  string = "char list"
   29.21 +
   29.22 +syntax
   29.23 +  "_Char"       :: "xstr => char"       ("CHR _")
   29.24 +  "_String"     :: "xstr => string"     ("_")
   29.25 +
   29.26 +end
   29.27 +
   29.28 +
   29.29 +ML
   29.30 +
   29.31 +local
   29.32 +  open Syntax;
   29.33 +
   29.34 +  val ssquote = enclose "''" "''";
   29.35 +
   29.36 +
   29.37 +  (* chars *)
   29.38 +
   29.39 +  val zero = ord "0";
   29.40 +  val ten = ord "A" - 10;
   29.41 +
   29.42 +  fun mk_nib n =
   29.43 +    const ("H0" ^ chr (n + (if n <= 9 then zero else ten)));
   29.44 +
   29.45 +  fun dest_nib (Const (c, _)) =
   29.46 +        (case explode c of
   29.47 +          ["H", "0", h] => ord h - (if h <= "9" then zero else ten)
   29.48 +        | _ => raise Match)
   29.49 +    | dest_nib _ = raise Match;
   29.50 +
   29.51 +  fun dest_nibs t1 t2 = chr (dest_nib t1 * 16 + dest_nib t2);
   29.52 +
   29.53 +
   29.54 +  fun mk_char c =
   29.55 +    const "Char" $ mk_nib (ord c div 16) $ mk_nib (ord c mod 16);
   29.56 +
   29.57 +  fun dest_char (Const ("Char", _) $ t1 $ t2) = dest_nibs t1 t2
   29.58 +    | dest_char _ = raise Match;
   29.59 +
   29.60 +
   29.61 +  fun char_tr (*"_Char"*) [Free (c, _)] =
   29.62 +        if size c = 1 then mk_char c
   29.63 +        else error ("Bad character: " ^ quote c)
   29.64 +    | char_tr (*"_Char"*) ts = raise_term "char_tr" ts;
   29.65 +
   29.66 +  fun char_tr' (*"Char"*) [t1, t2] =
   29.67 +        const "_Char" $ free (ssquote (dest_nibs t1 t2))
   29.68 +    | char_tr' (*"Char"*) _ = raise Match;
   29.69 +
   29.70 +
   29.71 +  (* strings *)
   29.72 +
   29.73 +  fun mk_string [] = const constrainC $ const "[]" $ const "string"
   29.74 +    | mk_string (t :: ts) = const "op #" $ t $ mk_string ts;
   29.75 +
   29.76 +  fun dest_string (Const ("[]", _)) = []
   29.77 +    | dest_string (Const ("op #", _) $ c $ cs) = dest_char c :: dest_string cs
   29.78 +    | dest_string _ = raise Match;
   29.79 +
   29.80 +
   29.81 +  fun string_tr (*"_String"*) [Free (txt, _)] =
   29.82 +        mk_string (map mk_char (explode txt))
   29.83 +    | string_tr (*"_String"*) ts = raise_term "string_tr" ts;
   29.84 +
   29.85 +  fun cons_tr' (*"op #"*) [c, cs] =
   29.86 +        const "_String" $ free (ssquote (implode (dest_char c :: dest_string cs)))
   29.87 +    | cons_tr' (*"op #"*) ts = raise Match;
   29.88 +
   29.89 +in
   29.90 +  val parse_translation = [("_Char", char_tr), ("_String", string_tr)];
   29.91 +  val print_translation = [("Char", char_tr'), ("op #", cons_tr')];
   29.92 +end;
   29.93 +
    30.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    30.2 +++ b/src/HOL/ex/Term.ML	Wed Mar 22 12:42:34 1995 +0100
    30.3 @@ -0,0 +1,165 @@
    30.4 +(*  Title: 	HOL/ex/Term
    30.5 +    ID:         $Id$
    30.6 +    Author: 	Lawrence C Paulson, Cambridge University Computer Laboratory
    30.7 +    Copyright   1992  University of Cambridge
    30.8 +
    30.9 +Terms over a given alphabet -- function applications; illustrates list functor
   30.10 +  (essentially the same type as in Trees & Forests)
   30.11 +*)
   30.12 +
   30.13 +open Term;
   30.14 +
   30.15 +(*** Monotonicity and unfolding of the function ***)
   30.16 +
   30.17 +goal Term.thy "term(A) = A <*> list(term(A))";
   30.18 +by (fast_tac (univ_cs addSIs (equalityI :: term.intrs)
   30.19 +                      addEs [term.elim]) 1);
   30.20 +qed "term_unfold";
   30.21 +
   30.22 +(*This justifies using term in other recursive type definitions*)
   30.23 +goalw Term.thy term.defs "!!A B. A<=B ==> term(A) <= term(B)";
   30.24 +by (REPEAT (ares_tac ([lfp_mono, list_mono] @ basic_monos) 1));
   30.25 +qed "term_mono";
   30.26 +
   30.27 +(** Type checking -- term creates well-founded sets **)
   30.28 +
   30.29 +goalw Term.thy term.defs "term(sexp) <= sexp";
   30.30 +by (rtac lfp_lowerbound 1);
   30.31 +by (fast_tac (univ_cs addIs [sexp.SconsI, list_sexp RS subsetD]) 1);
   30.32 +qed "term_sexp";
   30.33 +
   30.34 +(* A <= sexp ==> term(A) <= sexp *)
   30.35 +bind_thm ("term_subset_sexp", ([term_mono, term_sexp] MRS subset_trans));
   30.36 +
   30.37 +
   30.38 +(** Elimination -- structural induction on the set term(A) **)
   30.39 +
   30.40 +(*Induction for the set term(A) *)
   30.41 +val [major,minor] = goal Term.thy 
   30.42 +    "[| M: term(A);  \
   30.43 +\       !!x zs. [| x: A;  zs: list(term(A));  zs: list({x.R(x)}) \
   30.44 +\               |] ==> R(x$zs)  \
   30.45 +\    |] ==> R(M)";
   30.46 +by (rtac (major RS term.induct) 1);
   30.47 +by (REPEAT (eresolve_tac ([minor] @
   30.48 + 		([Int_lower1,Int_lower2] RL [list_mono RS subsetD])) 1));
   30.49 +(*Proof could also use  mono_Int RS subsetD RS IntE *)
   30.50 +qed "Term_induct";
   30.51 +
   30.52 +(*Induction on term(A) followed by induction on list *)
   30.53 +val major::prems = goal Term.thy
   30.54 +    "[| M: term(A);  \
   30.55 +\       !!x.      [| x: A |] ==> R(x$NIL);  \
   30.56 +\       !!x z zs. [| x: A;  z: term(A);  zs: list(term(A));  R(x$zs)  \
   30.57 +\                 |] ==> R(x $ CONS z zs)  \
   30.58 +\    |] ==> R(M)";
   30.59 +by (rtac (major RS Term_induct) 1);
   30.60 +by (etac list.induct 1);
   30.61 +by (REPEAT (ares_tac prems 1));
   30.62 +qed "Term_induct2";
   30.63 +
   30.64 +(*** Structural Induction on the abstract type 'a term ***)
   30.65 +
   30.66 +val list_all_ss = map_ss addsimps [list_all_Nil, list_all_Cons];
   30.67 +
   30.68 +val Rep_term_in_sexp =
   30.69 +    Rep_term RS (range_Leaf_subset_sexp RS term_subset_sexp RS subsetD);
   30.70 +
   30.71 +(*Induction for the abstract type 'a term*)
   30.72 +val prems = goalw Term.thy [App_def,Rep_Tlist_def,Abs_Tlist_def]
   30.73 +    "[| !!x ts. list_all R ts ==> R(App x ts)  \
   30.74 +\    |] ==> R(t)";
   30.75 +by (rtac (Rep_term_inverse RS subst) 1);   (*types force good instantiation*)
   30.76 +by (res_inst_tac [("P","Rep_term(t) : sexp")] conjunct2 1);
   30.77 +by (rtac (Rep_term RS Term_induct) 1);
   30.78 +by (REPEAT (ares_tac [conjI, sexp.SconsI, term_subset_sexp RS 
   30.79 +    list_subset_sexp, range_Leaf_subset_sexp] 1
   30.80 +     ORELSE etac rev_subsetD 1));
   30.81 +by (eres_inst_tac [("A1","term(?u)"), ("f1","Rep_term"), ("g1","Abs_term")]
   30.82 +    	(Abs_map_inverse RS subst) 1);
   30.83 +by (rtac (range_Leaf_subset_sexp RS term_subset_sexp) 1);
   30.84 +by (etac Abs_term_inverse 1);
   30.85 +by (etac rangeE 1);
   30.86 +by (hyp_subst_tac 1);
   30.87 +by (resolve_tac prems 1);
   30.88 +by (etac list.induct 1);
   30.89 +by (etac CollectE 2);
   30.90 +by (stac Abs_map_CONS 2);
   30.91 +by (etac conjunct1 2);
   30.92 +by (etac rev_subsetD 2);
   30.93 +by (rtac list_subset_sexp 2);
   30.94 +by (fast_tac set_cs 2);
   30.95 +by (ALLGOALS (asm_simp_tac list_all_ss));
   30.96 +qed "term_induct";
   30.97 +
   30.98 +(*Induction for the abstract type 'a term*)
   30.99 +val prems = goal Term.thy 
  30.100 +    "[| !!x. R(App x Nil);  \
  30.101 +\       !!x t ts. R(App x ts) ==> R(App x (t#ts))  \
  30.102 +\    |] ==> R(t)";
  30.103 +by (rtac term_induct 1);  (*types force good instantiation*)
  30.104 +by (etac rev_mp 1);
  30.105 +by (rtac list_induct 1);  (*types force good instantiation*)
  30.106 +by (ALLGOALS (asm_simp_tac (list_all_ss addsimps prems)));
  30.107 +qed "term_induct2";
  30.108 +
  30.109 +(*Perform induction on xs. *)
  30.110 +fun term_ind2_tac a i = 
  30.111 +    EVERY [res_inst_tac [("t",a)] term_induct2 i,
  30.112 +	   rename_last_tac a ["1","s"] (i+1)];
  30.113 +
  30.114 +
  30.115 +
  30.116 +(*** Term_rec -- by wf recursion on pred_sexp ***)
  30.117 +
  30.118 +val Term_rec_unfold =
  30.119 +    wf_pred_sexp RS wf_trancl RS (Term_rec_def RS def_wfrec);
  30.120 +
  30.121 +(** conversion rules **)
  30.122 +
  30.123 +val [prem] = goal Term.thy
  30.124 +    "N: list(term(A)) ==>  \
  30.125 +\    !M. <N,M>: pred_sexp^+ --> \
  30.126 +\        Abs_map (cut h (pred_sexp^+) M) N = \
  30.127 +\        Abs_map h N";
  30.128 +by (rtac (prem RS list.induct) 1);
  30.129 +by (simp_tac list_all_ss 1);
  30.130 +by (strip_tac 1);
  30.131 +by (etac (pred_sexp_CONS_D RS conjE) 1);
  30.132 +by (asm_simp_tac (list_all_ss addsimps [trancl_pred_sexpD1, cut_apply]) 1);
  30.133 +qed "Abs_map_lemma";
  30.134 +
  30.135 +val [prem1,prem2,A_subset_sexp] = goal Term.thy
  30.136 +    "[| M: sexp;  N: list(term(A));  A<=sexp |] ==> \
  30.137 +\    Term_rec (M$N) d = d M N (Abs_map (%Z. Term_rec Z d) N)";
  30.138 +by (rtac (Term_rec_unfold RS trans) 1);
  30.139 +by (simp_tac (HOL_ss addsimps
  30.140 +      [Split,
  30.141 +       prem2 RS Abs_map_lemma RS spec RS mp, pred_sexpI2 RS r_into_trancl,
  30.142 +       prem1, prem2 RS rev_subsetD, list_subset_sexp,
  30.143 +       term_subset_sexp, A_subset_sexp])1);
  30.144 +qed "Term_rec";
  30.145 +
  30.146 +(*** term_rec -- by Term_rec ***)
  30.147 +
  30.148 +local
  30.149 +  val Rep_map_type1 = read_instantiate_sg (sign_of Term.thy)
  30.150 +                        [("f","Rep_term")] Rep_map_type;
  30.151 +  val Rep_Tlist = Rep_term RS Rep_map_type1;
  30.152 +  val Rep_Term_rec = range_Leaf_subset_sexp RSN (2,Rep_Tlist RSN(2,Term_rec));
  30.153 +
  30.154 +  (*Now avoids conditional rewriting with the premise N: list(term(A)),
  30.155 +    since A will be uninstantiated and will cause rewriting to fail. *)
  30.156 +  val term_rec_ss = HOL_ss 
  30.157 +      addsimps [Rep_Tlist RS (rangeI RS term.APP_I RS Abs_term_inverse),  
  30.158 +	       Rep_term_in_sexp, Rep_Term_rec, Rep_term_inverse,
  30.159 +	       inj_Leaf, Inv_f_f,
  30.160 +	       Abs_Rep_map, map_ident, sexp.LeafI]
  30.161 +in
  30.162 +
  30.163 +val term_rec = prove_goalw Term.thy
  30.164 +	 [term_rec_def, App_def, Rep_Tlist_def, Abs_Tlist_def]
  30.165 +    "term_rec (App f ts) d = d f ts (map (%t. term_rec t d) ts)"
  30.166 + (fn _ => [simp_tac term_rec_ss 1])
  30.167 +
  30.168 +end;
    31.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    31.2 +++ b/src/HOL/ex/Term.thy	Wed Mar 22 12:42:34 1995 +0100
    31.3 @@ -0,0 +1,55 @@
    31.4 +(*  Title: 	HOL/ex/Term
    31.5 +    ID:         $Id$
    31.6 +    Author: 	Lawrence C Paulson, Cambridge University Computer Laboratory
    31.7 +    Copyright   1992  University of Cambridge
    31.8 +
    31.9 +Terms over a given alphabet -- function applications; illustrates list functor
   31.10 +  (essentially the same type as in Trees & Forests)
   31.11 +
   31.12 +There is no constructor APP because it is simply cons ($) 
   31.13 +*)
   31.14 +
   31.15 +Term = SList +
   31.16 +
   31.17 +types   'a term
   31.18 +
   31.19 +arities term :: (term)term
   31.20 +
   31.21 +consts
   31.22 +  term		:: "'a item set => 'a item set"
   31.23 +  Rep_term	:: "'a term => 'a item"
   31.24 +  Abs_term	:: "'a item => 'a term"
   31.25 +  Rep_Tlist	:: "'a term list => 'a item"
   31.26 +  Abs_Tlist	:: "'a item => 'a term list"
   31.27 +  App		:: "['a, ('a term)list] => 'a term"
   31.28 +  Term_rec	:: "['a item, ['a item , 'a item, 'b list]=>'b] => 'b"
   31.29 +  term_rec	:: "['a term, ['a ,'a term list, 'b list]=>'b] => 'b"
   31.30 +
   31.31 +inductive "term(A)"
   31.32 +  intrs
   31.33 +    APP_I "[| M: A;  N : list(term(A)) |] ==> M$N : term(A)"
   31.34 +  monos   "[list_mono]"
   31.35 +
   31.36 +defs
   31.37 +  (*defining abstraction/representation functions for term list...*)
   31.38 +  Rep_Tlist_def	"Rep_Tlist == Rep_map(Rep_term)"
   31.39 +  Abs_Tlist_def	"Abs_Tlist == Abs_map(Abs_term)"
   31.40 +
   31.41 +  (*defining the abstract constants*)
   31.42 +  App_def 	"App a ts == Abs_term(Leaf(a) $ Rep_Tlist(ts))"
   31.43 +
   31.44 +  (*list recursion*)
   31.45 +  Term_rec_def	
   31.46 +   "Term_rec M d == wfrec (trancl pred_sexp) M \
   31.47 +\           (Split(%x y g. d x y (Abs_map g y)))"
   31.48 +
   31.49 +  term_rec_def
   31.50 +   "term_rec t d == \
   31.51 +\   Term_rec (Rep_term t) (%x y r. d (Inv Leaf x) (Abs_Tlist(y)) r)"
   31.52 +
   31.53 +rules
   31.54 +    (*faking a type definition for term...*)
   31.55 +  Rep_term 		"Rep_term(n): term(range(Leaf))"
   31.56 +  Rep_term_inverse 	"Abs_term(Rep_term(t)) = t"
   31.57 +  Abs_term_inverse 	"M: term(range(Leaf)) ==> Rep_term(Abs_term(M)) = M"
   31.58 +end
    32.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    32.2 +++ b/src/HOL/ex/cla.ML	Wed Mar 22 12:42:34 1995 +0100
    32.3 @@ -0,0 +1,455 @@
    32.4 +(*  Title: 	HOL/ex/cla
    32.5 +    ID:         $Id$
    32.6 +    Author: 	Lawrence C Paulson, Cambridge University Computer Laboratory
    32.7 +    Copyright   1994  University of Cambridge
    32.8 +
    32.9 +Higher-Order Logic: predicate calculus problems
   32.10 +
   32.11 +Taken from FOL/cla.ML; beware of precedence of = vs <->
   32.12 +*)
   32.13 +
   32.14 +writeln"File HOL/ex/cla.";
   32.15 +
   32.16 +goal HOL.thy "(P --> Q | R) --> (P-->Q) | (P-->R)";
   32.17 +by (fast_tac HOL_cs 1);
   32.18 +result();
   32.19 +
   32.20 +(*If and only if*)
   32.21 +
   32.22 +goal HOL.thy "(P=Q) = (Q=P::bool)";
   32.23 +by (fast_tac HOL_cs 1);
   32.24 +result();
   32.25 +
   32.26 +goal HOL.thy "~ (P = (~P))";
   32.27 +by (fast_tac HOL_cs 1);
   32.28 +result();
   32.29 +
   32.30 +
   32.31 +(*Sample problems from 
   32.32 +  F. J. Pelletier, 
   32.33 +  Seventy-Five Problems for Testing Automatic Theorem Provers,
   32.34 +  J. Automated Reasoning 2 (1986), 191-216.
   32.35 +  Errata, JAR 4 (1988), 236-236.
   32.36 +
   32.37 +The hardest problems -- judging by experience with several theorem provers,
   32.38 +including matrix ones -- are 34 and 43.
   32.39 +*)
   32.40 +
   32.41 +writeln"Pelletier's examples";
   32.42 +(*1*)
   32.43 +goal HOL.thy "(P-->Q)  =  (~Q --> ~P)";
   32.44 +by (fast_tac HOL_cs 1);
   32.45 +result();
   32.46 +
   32.47 +(*2*)
   32.48 +goal HOL.thy "(~ ~ P) =  P";
   32.49 +by (fast_tac HOL_cs 1);
   32.50 +result();
   32.51 +
   32.52 +(*3*)
   32.53 +goal HOL.thy "~(P-->Q) --> (Q-->P)";
   32.54 +by (fast_tac HOL_cs 1);
   32.55 +result();
   32.56 +
   32.57 +(*4*)
   32.58 +goal HOL.thy "(~P-->Q)  =  (~Q --> P)";
   32.59 +by (fast_tac HOL_cs 1);
   32.60 +result();
   32.61 +
   32.62 +(*5*)
   32.63 +goal HOL.thy "((P|Q)-->(P|R)) --> (P|(Q-->R))";
   32.64 +by (fast_tac HOL_cs 1);
   32.65 +result();
   32.66 +
   32.67 +(*6*)
   32.68 +goal HOL.thy "P | ~ P";
   32.69 +by (fast_tac HOL_cs 1);
   32.70 +result();
   32.71 +
   32.72 +(*7*)
   32.73 +goal HOL.thy "P | ~ ~ ~ P";
   32.74 +by (fast_tac HOL_cs 1);
   32.75 +result();
   32.76 +
   32.77 +(*8.  Peirce's law*)
   32.78 +goal HOL.thy "((P-->Q) --> P)  -->  P";
   32.79 +by (fast_tac HOL_cs 1);
   32.80 +result();
   32.81 +
   32.82 +(*9*)
   32.83 +goal HOL.thy "((P|Q) & (~P|Q) & (P| ~Q)) --> ~ (~P | ~Q)";
   32.84 +by (fast_tac HOL_cs 1);
   32.85 +result();
   32.86 +
   32.87 +(*10*)
   32.88 +goal HOL.thy "(Q-->R) & (R-->P&Q) & (P-->Q|R) --> (P=Q)";
   32.89 +by (fast_tac HOL_cs 1);
   32.90 +result();
   32.91 +
   32.92 +(*11.  Proved in each direction (incorrectly, says Pelletier!!)  *)
   32.93 +goal HOL.thy "P=P::bool";
   32.94 +by (fast_tac HOL_cs 1);
   32.95 +result();
   32.96 +
   32.97 +(*12.  "Dijkstra's law"*)
   32.98 +goal HOL.thy "((P = Q) = R) = (P = (Q = R))";
   32.99 +by (fast_tac HOL_cs 1);
  32.100 +result();
  32.101 +
  32.102 +(*13.  Distributive law*)
  32.103 +goal HOL.thy "(P | (Q & R)) = ((P | Q) & (P | R))";
  32.104 +by (fast_tac HOL_cs 1);
  32.105 +result();
  32.106 +
  32.107 +(*14*)
  32.108 +goal HOL.thy "(P = Q) = ((Q | ~P) & (~Q|P))";
  32.109 +by (fast_tac HOL_cs 1);
  32.110 +result();
  32.111 +
  32.112 +(*15*)
  32.113 +goal HOL.thy "(P --> Q) = (~P | Q)";
  32.114 +by (fast_tac HOL_cs 1);
  32.115 +result();
  32.116 +
  32.117 +(*16*)
  32.118 +goal HOL.thy "(P-->Q) | (Q-->P)";
  32.119 +by (fast_tac HOL_cs 1);
  32.120 +result();
  32.121 +
  32.122 +(*17*)
  32.123 +goal HOL.thy "((P & (Q-->R))-->S)  =  ((~P | Q | S) & (~P | ~R | S))";
  32.124 +by (fast_tac HOL_cs 1);
  32.125 +result();
  32.126 +
  32.127 +writeln"Classical Logic: examples with quantifiers";
  32.128 +
  32.129 +goal HOL.thy "(! x. P(x) & Q(x)) = ((! x. P(x)) & (! x. Q(x)))";
  32.130 +by (fast_tac HOL_cs 1);
  32.131 +result(); 
  32.132 +
  32.133 +goal HOL.thy "(? x. P-->Q(x))  =  (P --> (? x.Q(x)))";
  32.134 +by (fast_tac HOL_cs 1);
  32.135 +result(); 
  32.136 +
  32.137 +goal HOL.thy "(? x.P(x)-->Q) = ((! x.P(x)) --> Q)";
  32.138 +by (fast_tac HOL_cs 1);
  32.139 +result(); 
  32.140 +
  32.141 +goal HOL.thy "((! x.P(x)) | Q)  =  (! x. P(x) | Q)";
  32.142 +by (fast_tac HOL_cs 1);
  32.143 +result(); 
  32.144 +
  32.145 +(*From Wishnu Prasetya*)
  32.146 +goal HOL.thy
  32.147 +   "(!s. q(s) --> r(s)) & ~r(s) & (!s. ~r(s) & ~q(s) --> p(t) | q(t)) \
  32.148 +\   --> p(t) | r(t)";
  32.149 +by (fast_tac HOL_cs 1);
  32.150 +result(); 
  32.151 +
  32.152 +
  32.153 +writeln"Problems requiring quantifier duplication";
  32.154 +
  32.155 +(*Needs multiple instantiation of the quantifier.*)
  32.156 +goal HOL.thy "(! x. P(x)-->P(f(x)))  &  P(d)-->P(f(f(f(d))))";
  32.157 +by (deepen_tac HOL_cs 1 1);
  32.158 +result();
  32.159 +
  32.160 +(*Needs double instantiation of the quantifier*)
  32.161 +goal HOL.thy "? x. P(x) --> P(a) & P(b)";
  32.162 +by (deepen_tac HOL_cs 1 1);
  32.163 +result();
  32.164 +
  32.165 +goal HOL.thy "? z. P(z) --> (! x. P(x))";
  32.166 +by (deepen_tac HOL_cs 1 1);
  32.167 +result();
  32.168 +
  32.169 +goal HOL.thy "? x. (? y. P(y)) --> P(x)";
  32.170 +by (deepen_tac HOL_cs 1 1);
  32.171 +result();
  32.172 +
  32.173 +writeln"Hard examples with quantifiers";
  32.174 +
  32.175 +writeln"Problem 18";
  32.176 +goal HOL.thy "? y. ! x. P(y)-->P(x)";
  32.177 +by (deepen_tac HOL_cs 1 1);
  32.178 +result(); 
  32.179 +
  32.180 +writeln"Problem 19";
  32.181 +goal HOL.thy "? x. ! y z. (P(y)-->Q(z)) --> (P(x)-->Q(x))";
  32.182 +by (deepen_tac HOL_cs 1 1);
  32.183 +result();
  32.184 +
  32.185 +writeln"Problem 20";
  32.186 +goal HOL.thy "(! x y. ? z. ! w. (P(x)&Q(y)-->R(z)&S(w)))     \
  32.187 +\   --> (? x y. P(x) & Q(y)) --> (? z. R(z))";
  32.188 +by (fast_tac HOL_cs 1); 
  32.189 +result();
  32.190 +
  32.191 +writeln"Problem 21";
  32.192 +goal HOL.thy "(? x. P-->Q(x)) & (? x. Q(x)-->P) --> (? x. P=Q(x))";
  32.193 +by (deepen_tac HOL_cs 1 1); 
  32.194 +result();
  32.195 +
  32.196 +writeln"Problem 22";
  32.197 +goal HOL.thy "(! x. P = Q(x))  -->  (P = (! x. Q(x)))";
  32.198 +by (fast_tac HOL_cs 1); 
  32.199 +result();
  32.200 +
  32.201 +writeln"Problem 23";
  32.202 +goal HOL.thy "(! x. P | Q(x))  =  (P | (! x. Q(x)))";
  32.203 +by (best_tac HOL_cs 1);  
  32.204 +result();
  32.205 +
  32.206 +writeln"Problem 24";
  32.207 +goal HOL.thy "~(? x. S(x)&Q(x)) & (! x. P(x) --> Q(x)|R(x)) &  \
  32.208 +\    ~(? x.P(x)) --> (? x.Q(x)) & (! x. Q(x)|R(x) --> S(x))  \
  32.209 +\   --> (? x. P(x)&R(x))";
  32.210 +by (fast_tac HOL_cs 1); 
  32.211 +result();
  32.212 +
  32.213 +writeln"Problem 25";
  32.214 +goal HOL.thy "(? x. P(x)) &  \
  32.215 +\       (! x. L(x) --> ~ (M(x) & R(x))) &  \
  32.216 +\       (! x. P(x) --> (M(x) & L(x))) &   \
  32.217 +\       ((! x. P(x)-->Q(x)) | (? x. P(x)&R(x)))  \
  32.218 +\   --> (? x. Q(x)&P(x))";
  32.219 +by (best_tac HOL_cs 1); 
  32.220 +result();
  32.221 +
  32.222 +writeln"Problem 26";
  32.223 +goal HOL.thy "((? x. p(x)) = (? x. q(x))) &	\
  32.224 +\     (! x. ! y. p(x) & q(y) --> (r(x) = s(y)))	\
  32.225 +\ --> ((! x. p(x)-->r(x)) = (! x. q(x)-->s(x)))";
  32.226 +by (fast_tac HOL_cs 1);
  32.227 +result();
  32.228 +
  32.229 +writeln"Problem 27";
  32.230 +goal HOL.thy "(? x. P(x) & ~Q(x)) &   \
  32.231 +\             (! x. P(x) --> R(x)) &   \
  32.232 +\             (! x. M(x) & L(x) --> P(x)) &   \
  32.233 +\             ((? x. R(x) & ~ Q(x)) --> (! x. L(x) --> ~ R(x)))  \
  32.234 +\         --> (! x. M(x) --> ~L(x))";
  32.235 +by (fast_tac HOL_cs 1); 
  32.236 +result();
  32.237 +
  32.238 +writeln"Problem 28.  AMENDED";
  32.239 +goal HOL.thy "(! x. P(x) --> (! x. Q(x))) &   \
  32.240 +\       ((! x. Q(x)|R(x)) --> (? x. Q(x)&S(x))) &  \
  32.241 +\       ((? x.S(x)) --> (! x. L(x) --> M(x)))  \
  32.242 +\   --> (! x. P(x) & L(x) --> M(x))";
  32.243 +by (fast_tac HOL_cs 1);  
  32.244 +result();
  32.245 +
  32.246 +writeln"Problem 29.  Essentially the same as Principia Mathematica *11.71";
  32.247 +goal HOL.thy "(? x. F(x)) & (? y. G(y))  \
  32.248 +\   --> ( ((! x. F(x)-->H(x)) & (! y. G(y)-->J(y)))  =   \
  32.249 +\         (! x y. F(x) & G(y) --> H(x) & J(y)))";
  32.250 +by (fast_tac HOL_cs 1); 
  32.251 +result();
  32.252 +
  32.253 +writeln"Problem 30";
  32.254 +goal HOL.thy "(! x. P(x) | Q(x) --> ~ R(x)) & \
  32.255 +\       (! x. (Q(x) --> ~ S(x)) --> P(x) & R(x))  \
  32.256 +\   --> (! x. S(x))";
  32.257 +by (fast_tac HOL_cs 1);  
  32.258 +result();
  32.259 +
  32.260 +writeln"Problem 31";
  32.261 +goal HOL.thy "~(? x.P(x) & (Q(x) | R(x))) & \
  32.262 +\       (? x. L(x) & P(x)) & \
  32.263 +\       (! x. ~ R(x) --> M(x))  \
  32.264 +\   --> (? x. L(x) & M(x))";
  32.265 +by (fast_tac HOL_cs 1);
  32.266 +result();
  32.267 +
  32.268 +writeln"Problem 32";
  32.269 +goal HOL.thy "(! x. P(x) & (Q(x)|R(x))-->S(x)) & \
  32.270 +\       (! x. S(x) & R(x) --> L(x)) & \
  32.271 +\       (! x. M(x) --> R(x))  \
  32.272 +\   --> (! x. P(x) & M(x) --> L(x))";
  32.273 +by (best_tac HOL_cs 1);
  32.274 +result();
  32.275 +
  32.276 +writeln"Problem 33";
  32.277 +goal HOL.thy "(! x. P(a) & (P(x)-->P(b))-->P(c))  =    \
  32.278 +\    (! x. (~P(a) | P(x) | P(c)) & (~P(a) | ~P(b) | P(c)))";
  32.279 +by (best_tac HOL_cs 1);
  32.280 +result();
  32.281 +
  32.282 +writeln"Problem 34  AMENDED (TWICE!!)  NOT PROVED AUTOMATICALLY";
  32.283 +(*Andrews's challenge*)
  32.284 +goal HOL.thy "((? x. ! y. p(x) = p(y))  =		\
  32.285 +\                   ((? x. q(x)) = (! y. p(y))))   =	\
  32.286 +\                  ((? x. ! y. q(x) = q(y))  =		\
  32.287 +\                   ((? x. p(x)) = (! y. q(y))))";
  32.288 +by (deepen_tac HOL_cs 3 1);
  32.289 +(*slower with smaller bounds*)
  32.290 +result();
  32.291 +
  32.292 +writeln"Problem 35";
  32.293 +goal HOL.thy "? x y. P x y -->  (! u v. P u v)";
  32.294 +by (deepen_tac HOL_cs 1 1);
  32.295 +result();
  32.296 +
  32.297 +writeln"Problem 36";
  32.298 +goal HOL.thy "(! x. ? y. J x y) & \
  32.299 +\       (! x. ? y. G x y) & \
  32.300 +\       (! x y. J x y | G x y -->	\
  32.301 +\       (! z. J y z | G y z --> H x z))   \
  32.302 +\   --> (! x. ? y. H x y)";
  32.303 +by (fast_tac HOL_cs 1);
  32.304 +result();
  32.305 +
  32.306 +writeln"Problem 37";
  32.307 +goal HOL.thy "(! z. ? w. ! x. ? y. \
  32.308 +\          (P x z -->P y w) & P y z & (P y w --> (? u.Q u w))) & \
  32.309 +\       (! x z. ~(P x z) --> (? y. Q y z)) & \
  32.310 +\       ((? x y. Q x y) --> (! x. R x x))  \
  32.311 +\   --> (! x. ? y. R x y)";
  32.312 +by (fast_tac HOL_cs 1);
  32.313 +result();
  32.314 +
  32.315 +writeln"Problem 38";
  32.316 +goal HOL.thy
  32.317 +    "(! x. p(a) & (p(x) --> (? y. p(y) & r x y)) -->		\
  32.318 +\          (? z. ? w. p(z) & r x w & r w z))  =			\
  32.319 +\    (! x. (~p(a) | p(x) | (? z. ? w. p(z) & r x w & r w z)) &	\
  32.320 +\          (~p(a) | ~(? y. p(y) & r x y) |				\
  32.321 +\           (? z. ? w. p(z) & r x w & r w z)))";
  32.322 +
  32.323 +writeln"Problem 39";
  32.324 +goal HOL.thy "~ (? x. ! y. F y x = (~ F y y))";
  32.325 +by (fast_tac HOL_cs 1);
  32.326 +result();
  32.327 +
  32.328 +writeln"Problem 40.  AMENDED";
  32.329 +goal HOL.thy "(? y. ! x. F x y = F x x)  \
  32.330 +\       -->  ~ (! x. ? y. ! z. F z y = (~ F z x))";
  32.331 +by (fast_tac HOL_cs 1);
  32.332 +result();
  32.333 +
  32.334 +writeln"Problem 41";
  32.335 +goal HOL.thy "(! z. ? y. ! x. f x y = (f x z & ~ f x x))	\
  32.336 +\              --> ~ (? z. ! x. f x z)";
  32.337 +by (best_tac HOL_cs 1);
  32.338 +result();
  32.339 +
  32.340 +writeln"Problem 42";
  32.341 +goal HOL.thy "~ (? y. ! x. p x y = (~ (? z. p x z & p z x)))";
  32.342 +by (deepen_tac HOL_cs 3 1);
  32.343 +result();
  32.344 +
  32.345 +writeln"Problem 43  NOT PROVED AUTOMATICALLY";
  32.346 +goal HOL.thy
  32.347 +    "(! x::'a. ! y::'a. q x y = (! z. p z x = (p z y::bool)))	\
  32.348 +\ --> (! x. (! y. q x y = (q y x::bool)))";
  32.349 +
  32.350 +
  32.351 +writeln"Problem 44";
  32.352 +goal HOL.thy "(! x. f(x) -->					\
  32.353 +\             (? y. g(y) & h x y & (? y. g(y) & ~ h x y)))  &   \
  32.354 +\             (? x. j(x) & (! y. g(y) --> h x y))		\
  32.355 +\             --> (? x. j(x) & ~f(x))";
  32.356 +by (fast_tac HOL_cs 1);
  32.357 +result();
  32.358 +
  32.359 +writeln"Problem 45";
  32.360 +goal HOL.thy
  32.361 +    "(! x. f(x) & (! y. g(y) & h x y --> j x y)	\
  32.362 +\                     --> (! y. g(y) & h x y --> k(y))) &	\
  32.363 +\    ~ (? y. l(y) & k(y)) &					\
  32.364 +\    (? x. f(x) & (! y. h x y --> l(y))				\
  32.365 +\               & (! y. g(y) & h x y --> j x y))		\
  32.366 +\     --> (? x. f(x) & ~ (? y. g(y) & h x y))";
  32.367 +by (best_tac HOL_cs 1); 
  32.368 +result();
  32.369 +
  32.370 +
  32.371 +writeln"Problems (mainly) involving equality or functions";
  32.372 +
  32.373 +writeln"Problem 48";
  32.374 +goal HOL.thy "(a=b | c=d) & (a=c | b=d) --> a=d | b=c";
  32.375 +by (fast_tac HOL_cs 1);
  32.376 +result();
  32.377 +
  32.378 +writeln"Problem 49  NOT PROVED AUTOMATICALLY";
  32.379 +(*Hard because it involves substitution for Vars;
  32.380 +  the type constraint ensures that x,y,z have the same type as a,b,u. *)
  32.381 +goal HOL.thy "(? x y::'a. ! z. z=x | z=y) & P(a) & P(b) & (~a=b) \
  32.382 +\		--> (! u::'a.P(u))";
  32.383 +by (Classical.safe_tac HOL_cs);
  32.384 +by (res_inst_tac [("x","a")] allE 1);
  32.385 +by (assume_tac 1);
  32.386 +by (res_inst_tac [("x","b")] allE 1);
  32.387 +by (assume_tac 1);
  32.388 +by (fast_tac HOL_cs 1);
  32.389 +result();
  32.390 +
  32.391 +writeln"Problem 50";  
  32.392 +(*What has this to do with equality?*)
  32.393 +goal HOL.thy "(! x. P a x | (! y.P x y)) --> (? x. ! y.P x y)";
  32.394 +by (deepen_tac HOL_cs 1 1);
  32.395 +result();
  32.396 +
  32.397 +writeln"Problem 51";
  32.398 +goal HOL.thy
  32.399 +    "(? z w. ! x y. P x y = (x=z & y=w)) -->  \
  32.400 +\    (? z. ! x. ? w. (! y. P x y = (y=w)) = (x=z))";
  32.401 +by (best_tac HOL_cs 1);
  32.402 +result();
  32.403 +
  32.404 +writeln"Problem 52";
  32.405 +(*Almost the same as 51. *)
  32.406 +goal HOL.thy
  32.407 +    "(? z w. ! x y. P x y = (x=z & y=w)) -->  \
  32.408 +\    (? w. ! y. ? z. (! x. P x y = (x=z)) = (y=w))";
  32.409 +by (best_tac HOL_cs 1);
  32.410 +result();
  32.411 +
  32.412 +writeln"Problem 55";
  32.413 +
  32.414 +(*Non-equational version, from Manthey and Bry, CADE-9 (Springer, 1988).
  32.415 +  fast_tac DISCOVERS who killed Agatha. *)
  32.416 +goal HOL.thy "lives(agatha) & lives(butler) & lives(charles) & \
  32.417 +\  (killed agatha agatha | killed butler agatha | killed charles agatha) & \
  32.418 +\  (!x y. killed x y --> hates x y & ~richer x y) & \
  32.419 +\  (!x. hates agatha x --> ~hates charles x) & \
  32.420 +\  (hates agatha agatha & hates agatha charles) & \
  32.421 +\  (!x. lives(x) & ~richer x agatha --> hates butler x) & \
  32.422 +\  (!x. hates agatha x --> hates butler x) & \
  32.423 +\  (!x. ~hates x agatha | ~hates x butler | ~hates x charles) --> \
  32.424 +\   killed ?who agatha";
  32.425 +by (fast_tac HOL_cs 1);
  32.426 +result();
  32.427 +
  32.428 +writeln"Problem 56";
  32.429 +goal HOL.thy
  32.430 +    "(! x. (? y. P(y) & x=f(y)) --> P(x)) = (! x. P(x) --> P(f(x)))";
  32.431 +by (fast_tac HOL_cs 1);
  32.432 +result();
  32.433 +
  32.434 +writeln"Problem 57";
  32.435 +goal HOL.thy
  32.436 +    "P (f a b) (f b c) & P (f b c) (f a c) & \
  32.437 +\    (! x y z. P x y & P y z --> P x z)    -->   P (f a b) (f a c)";
  32.438 +by (fast_tac HOL_cs 1);
  32.439 +result();
  32.440 +
  32.441 +writeln"Problem 58  NOT PROVED AUTOMATICALLY";
  32.442 +goal HOL.thy "(! x y. f(x)=g(y)) --> (! x y. f(f(x))=f(g(y)))";
  32.443 +val f_cong = read_instantiate [("f","f")] arg_cong;
  32.444 +by (fast_tac (HOL_cs addIs [f_cong]) 1);
  32.445 +result();
  32.446 +
  32.447 +writeln"Problem 59";
  32.448 +goal HOL.thy "(! x. P(x) = (~P(f(x)))) --> (? x. P(x) & ~P(f(x)))";
  32.449 +by (deepen_tac HOL_cs 1 1);
  32.450 +result();
  32.451 +
  32.452 +writeln"Problem 60";
  32.453 +goal HOL.thy
  32.454 +    "! x. P x (f x) = (? y. (! z. P z y --> P z (f x)) & P x y)";
  32.455 +by (fast_tac HOL_cs 1);
  32.456 +result();
  32.457 +
  32.458 +writeln"Reached end of file.";
    33.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    33.2 +++ b/src/HOL/ex/meson.ML	Wed Mar 22 12:42:34 1995 +0100
    33.3 @@ -0,0 +1,417 @@
    33.4 +(*  Title: 	HOL/ex/meson
    33.5 +    ID:         $Id$
    33.6 +    Author: 	Lawrence C Paulson, Cambridge University Computer Laboratory
    33.7 +    Copyright   1992  University of Cambridge
    33.8 +
    33.9 +The MESON resolution proof procedure for HOL
   33.10 +
   33.11 +When making clauses, avoids using the rewriter -- instead uses RS recursively
   33.12 +*)
   33.13 +
   33.14 +writeln"File HOL/ex/meson.";
   33.15 +
   33.16 +(*Prove theorems using fast_tac*)
   33.17 +fun prove_fun s = 
   33.18 +    prove_goal HOL.thy s
   33.19 +	 (fn prems => [ cut_facts_tac prems 1, fast_tac HOL_cs 1 ]);
   33.20 +
   33.21 +(**** Negation Normal Form ****)
   33.22 +
   33.23 +(*** de Morgan laws ***)
   33.24 +
   33.25 +val not_conjD = prove_fun "~(P&Q) ==> ~P | ~Q";
   33.26 +val not_disjD = prove_fun "~(P|Q) ==> ~P & ~Q";
   33.27 +val not_notD = prove_fun "~~P ==> P";
   33.28 +val not_allD = prove_fun  "~(! x.P(x)) ==> ? x. ~P(x)";
   33.29 +val not_exD = prove_fun   "~(? x.P(x)) ==> ! x. ~P(x)";
   33.30 +
   33.31 +
   33.32 +(*** Removal of --> and <-> (positive and negative occurrences) ***)
   33.33 +
   33.34 +val imp_to_disjD = prove_fun "P-->Q ==> ~P | Q";
   33.35 +val not_impD = prove_fun   "~(P-->Q) ==> P & ~Q";
   33.36 +
   33.37 +val iff_to_disjD = prove_fun "P=Q ==> (~P | Q) & (~Q | P)";
   33.38 +
   33.39 +(*Much more efficient than (P & ~Q) | (Q & ~P) for computing CNF*)
   33.40 +val not_iffD = prove_fun "~(P=Q) ==> (P | Q) & (~P | ~Q)";
   33.41 +
   33.42 +
   33.43 +(**** Pulling out the existential quantifiers ****)
   33.44 +
   33.45 +(*** Conjunction ***)
   33.46 +
   33.47 +val conj_exD1 = prove_fun "(? x.P(x)) & Q ==> ? x. P(x) & Q";
   33.48 +val conj_exD2 = prove_fun "P & (? x.Q(x)) ==> ? x. P & Q(x)";
   33.49 +
   33.50 +(*** Disjunction ***)
   33.51 +
   33.52 +(*DO NOT USE with forall-Skolemization: makes fewer schematic variables!!
   33.53 +  With ex-Skolemization, makes fewer Skolem constants*)
   33.54 +val disj_exD = prove_fun "(? x.P(x)) | (? x.Q(x)) ==> ? x. P(x) | Q(x)";
   33.55 +
   33.56 +val disj_exD1 = prove_fun "(? x.P(x)) | Q ==> ? x. P(x) | Q";
   33.57 +val disj_exD2 = prove_fun "P | (? x.Q(x)) ==> ? x. P | Q(x)";
   33.58 +
   33.59 +
   33.60 +(**** Skolemization -- pulling "?" over "!" ****)
   33.61 +
   33.62 +(*"Axiom" of Choice, proved using the description operator*)
   33.63 +val [major] = goal HOL.thy
   33.64 +    "! x. ? y. Q x y ==> ? f. ! x. Q x (f x)";
   33.65 +by (cut_facts_tac [major] 1);
   33.66 +by (fast_tac (HOL_cs addEs [selectI]) 1);
   33.67 +qed "choice";
   33.68 +
   33.69 +
   33.70 +(***** Generating clauses for the Meson Proof Procedure *****)
   33.71 +
   33.72 +(*** Disjunctions ***)
   33.73 +
   33.74 +val disj_assoc = prove_fun "(P|Q)|R ==> P|(Q|R)";
   33.75 +
   33.76 +val disj_comm = prove_fun "P|Q ==> Q|P";
   33.77 +
   33.78 +val disj_FalseD1 = prove_fun "False|P ==> P";
   33.79 +val disj_FalseD2 = prove_fun "P|False ==> P";
   33.80 +
   33.81 +(*** Generation of contrapositives ***)
   33.82 +
   33.83 +(*Inserts negated disjunct after removing the negation; P is a literal*)
   33.84 +val [major,minor] = goal HOL.thy "~P|Q ==> ((~P==>P) ==> Q)";
   33.85 +by (rtac (major RS disjE) 1);
   33.86 +by (rtac notE 1);
   33.87 +by (etac minor 2);
   33.88 +by (ALLGOALS assume_tac);
   33.89 +qed "make_neg_rule";
   33.90 +
   33.91 +(*For Plaisted's "Postive refinement" of the MESON procedure*)
   33.92 +val [major,minor] = goal HOL.thy "~P|Q ==> (P ==> Q)";
   33.93 +by (rtac (major RS disjE) 1);
   33.94 +by (rtac notE 1);
   33.95 +by (rtac minor 2);
   33.96 +by (ALLGOALS assume_tac);
   33.97 +qed "make_refined_neg_rule";
   33.98 +
   33.99 +(*P should be a literal*)
  33.100 +val [major,minor] = goal HOL.thy "P|Q ==> ((P==>~P) ==> Q)";
  33.101 +by (rtac (major RS disjE) 1);
  33.102 +by (rtac notE 1);
  33.103 +by (etac minor 1);
  33.104 +by (ALLGOALS assume_tac);
  33.105 +qed "make_pos_rule";
  33.106 +
  33.107 +(*** Generation of a goal clause -- put away the final literal ***)
  33.108 +
  33.109 +val [major,minor] = goal HOL.thy "~P ==> ((~P==>P) ==> False)";
  33.110 +by (rtac notE 1);
  33.111 +by (rtac minor 2);
  33.112 +by (ALLGOALS (rtac major));
  33.113 +qed "make_neg_goal";
  33.114 +
  33.115 +val [major,minor] = goal HOL.thy "P ==> ((P==>~P) ==> False)";
  33.116 +by (rtac notE 1);
  33.117 +by (rtac minor 1);
  33.118 +by (ALLGOALS (rtac major));
  33.119 +qed "make_pos_goal";
  33.120 +
  33.121 +
  33.122 +(**** Lemmas for forward proof (like congruence rules) ****)
  33.123 +
  33.124 +(*NOTE: could handle conjunctions (faster?) by
  33.125 +    nf(th RS conjunct2) RS (nf(th RS conjunct1) RS conjI) *)
  33.126 +val major::prems = goal HOL.thy
  33.127 +    "[| P'&Q';  P' ==> P;  Q' ==> Q |] ==> P&Q";
  33.128 +by (rtac (major RS conjE) 1);
  33.129 +by (rtac conjI 1);
  33.130 +by (ALLGOALS (eresolve_tac prems));
  33.131 +qed "conj_forward";
  33.132 +
  33.133 +val major::prems = goal HOL.thy
  33.134 +    "[| P'|Q';  P' ==> P;  Q' ==> Q |] ==> P|Q";
  33.135 +by (rtac (major RS disjE) 1);
  33.136 +by (ALLGOALS (dresolve_tac prems));
  33.137 +by (ALLGOALS (eresolve_tac [disjI1,disjI2]));
  33.138 +qed "disj_forward";
  33.139 +
  33.140 +val major::prems = goal HOL.thy
  33.141 +    "[| ! x. P'(x);  !!x. P'(x) ==> P(x) |] ==> ! x. P(x)";
  33.142 +by (rtac allI 1);
  33.143 +by (resolve_tac prems 1);
  33.144 +by (rtac (major RS spec) 1);
  33.145 +qed "all_forward";
  33.146 +
  33.147 +val major::prems = goal HOL.thy
  33.148 +    "[| ? x. P'(x);  !!x. P'(x) ==> P(x) |] ==> ? x. P(x)";
  33.149 +by (rtac (major RS exE) 1);
  33.150 +by (rtac exI 1);
  33.151 +by (eresolve_tac prems 1);
  33.152 +qed "ex_forward";
  33.153 +
  33.154 +
  33.155 +(**** Operators for forward proof ****)
  33.156 +
  33.157 +(*raises exception if no rules apply -- unlike RL*)
  33.158 +fun tryres (th, rl::rls) = (th RS rl handle THM _ => tryres(th,rls))
  33.159 +  | tryres (th, []) = raise THM("tryres", 0, [th]);
  33.160 +
  33.161 +val prop_of = #prop o rep_thm;
  33.162 +
  33.163 +(*Permits forward proof from rules that discharge assumptions*)
  33.164 +fun forward_res nf state =
  33.165 +  case Sequence.pull
  33.166 +	(tapply(ALLGOALS (METAHYPS (fn [prem] => rtac (nf prem) 1)), 
  33.167 +		state))
  33.168 +  of Some(th,_) => th
  33.169 +   | None => raise THM("forward_res", 0, [state]);
  33.170 +
  33.171 +
  33.172 +(*Negation Normal Form*)
  33.173 +val nnf_rls = [imp_to_disjD, iff_to_disjD, not_conjD, not_disjD,
  33.174 +	       not_impD, not_iffD, not_allD, not_exD, not_notD];
  33.175 +fun make_nnf th = make_nnf (tryres(th, nnf_rls))
  33.176 +    handle THM _ => 
  33.177 +	forward_res make_nnf
  33.178 +      	   (tryres(th, [conj_forward,disj_forward,all_forward,ex_forward]))
  33.179 +    handle THM _ => th;
  33.180 +
  33.181 +
  33.182 +(*Are any of the constants in "bs" present in the term?*)
  33.183 +fun has_consts bs = 
  33.184 +  let fun has (Const(a,_)) = a mem bs
  33.185 +	| has (f$u) = has f orelse has u
  33.186 +	| has (Abs(_,_,t)) = has t
  33.187 +	| has _ = false
  33.188 +  in  has  end;
  33.189 +
  33.190 +(*Pull existential quantifiers (Skolemization)*)
  33.191 +fun skolemize th = 
  33.192 +  if not (has_consts ["Ex"] (prop_of th)) then th
  33.193 +  else skolemize (tryres(th, [choice, conj_exD1, conj_exD2,
  33.194 +			  disj_exD, disj_exD1, disj_exD2]))
  33.195 +    handle THM _ => 
  33.196 +	skolemize (forward_res skolemize
  33.197 +		(tryres (th, [conj_forward, disj_forward, all_forward])))
  33.198 +    handle THM _ => forward_res skolemize (th RS ex_forward);
  33.199 +
  33.200 +
  33.201 +(**** Clause handling ****)
  33.202 +
  33.203 +fun literals (Const("Trueprop",_) $ P) = literals P
  33.204 +  | literals (Const("op |",_) $ P $ Q) = literals P @ literals Q
  33.205 +  | literals (Const("not",_) $ P) = [(false,P)]
  33.206 +  | literals P = [(true,P)];
  33.207 +
  33.208 +(*number of literals in a term*)
  33.209 +val nliterals = length o literals;
  33.210 +
  33.211 +(*to delete tautologous clauses*)
  33.212 +fun taut_lits [] = false
  33.213 +  | taut_lits ((flg,t)::ts) = (not flg,t) mem ts orelse taut_lits ts;
  33.214 +
  33.215 +val is_taut = taut_lits o literals o prop_of;
  33.216 +
  33.217 +
  33.218 +(*Generation of unique names -- maxidx cannot be relied upon to increase!
  33.219 +  Cannot rely on "variant", since variables might coincide when literals
  33.220 +  are joined to make a clause... 
  33.221 +  19 chooses "U" as the first variable name*)
  33.222 +val name_ref = ref 19;
  33.223 +
  33.224 +(*Replaces universally quantified variables by FREE variables -- because
  33.225 +  assumptions may not contain scheme variables.  Later, call "generalize". *)
  33.226 +fun freeze_spec th =
  33.227 +  let val sth = th RS spec
  33.228 +      val newname = (name_ref := !name_ref + 1;
  33.229 +                     radixstring(26, "A", !name_ref))
  33.230 +  in  read_instantiate [("x", newname)] sth  end;
  33.231 +
  33.232 +fun resop nf [prem] = resolve_tac (nf prem) 1;
  33.233 +
  33.234 +(*Conjunctive normal form, detecting tautologies early.
  33.235 +  Strips universal quantifiers and breaks up conjunctions. *)
  33.236 +fun cnf_aux seen (th,ths) = 
  33.237 +  if taut_lits (literals(prop_of th) @ seen)  then ths
  33.238 +  else if not (has_consts ["All","op &"] (prop_of th))  then th::ths
  33.239 +  else (*conjunction?*)
  33.240 +        cnf_aux seen (th RS conjunct1, 
  33.241 +		      cnf_aux seen (th RS conjunct2, ths))
  33.242 +  handle THM _ => (*universal quant?*)
  33.243 +	cnf_aux  seen (freeze_spec th,  ths)
  33.244 +  handle THM _ => (*disjunction?*)
  33.245 +    let val tac = 
  33.246 +	(METAHYPS (resop (cnf_nil seen)) 1) THEN
  33.247 +	(STATE (fn st' => 
  33.248 +		METAHYPS (resop (cnf_nil (literals (concl_of st') @ seen))) 1))
  33.249 +    in  Sequence.list_of_s (tapply(tac, th RS disj_forward))  @  ths
  33.250 +    end
  33.251 +and cnf_nil seen th = cnf_aux seen (th,[]);
  33.252 +
  33.253 +(*Top-level call to cnf -- it's safe to reset name_ref*)
  33.254 +fun cnf (th,ths) = 
  33.255 +   (name_ref := 19;  cnf (th RS conjunct1, cnf (th RS conjunct2, ths))
  33.256 +    handle THM _ => (*not a conjunction*) cnf_aux [] (th, ths));
  33.257 +
  33.258 +(**** Removal of duplicate literals ****)
  33.259 +
  33.260 +(*Version for removal of duplicate literals*)
  33.261 +val major::prems = goal HOL.thy
  33.262 +    "[| P'|Q';  P' ==> P;  [| Q'; P==>False |] ==> Q |] ==> P|Q";
  33.263 +by (rtac (major RS disjE) 1);
  33.264 +by (rtac disjI1 1);
  33.265 +by (rtac (disjCI RS disj_comm) 2);
  33.266 +by (ALLGOALS (eresolve_tac prems));
  33.267 +by (etac notE 1);
  33.268 +by (assume_tac 1);
  33.269 +qed "disj_forward2";
  33.270 +
  33.271 +(*Forward proof, passing extra assumptions as theorems to the tactic*)
  33.272 +fun forward_res2 nf hyps state =
  33.273 +  case Sequence.pull
  33.274 +	(tapply(REPEAT 
  33.275 +	   (METAHYPS (fn major::minors => rtac (nf (minors@hyps) major) 1) 1), 
  33.276 +	   state))
  33.277 +  of Some(th,_) => th
  33.278 +   | None => raise THM("forward_res2", 0, [state]);
  33.279 +
  33.280 +(*Remove duplicates in P|Q by assuming ~P in Q
  33.281 +  rls (initially []) accumulates assumptions of the form P==>False*)
  33.282 +fun nodups_aux rls th = nodups_aux rls (th RS disj_assoc)
  33.283 +    handle THM _ => tryres(th,rls)
  33.284 +    handle THM _ => tryres(forward_res2 nodups_aux rls (th RS disj_forward2),
  33.285 +			   [disj_FalseD1, disj_FalseD2, asm_rl])
  33.286 +    handle THM _ => th;
  33.287 +
  33.288 +(*Remove duplicate literals, if there are any*)
  33.289 +fun nodups th =
  33.290 +    if null(findrep(literals(prop_of th))) then th
  33.291 +    else nodups_aux [] th;
  33.292 +
  33.293 +
  33.294 +(**** Generation of contrapositives ****)
  33.295 +
  33.296 +(*Associate disjuctions to right -- make leftmost disjunct a LITERAL*)
  33.297 +fun assoc_right th = assoc_right (th RS disj_assoc)
  33.298 +	handle THM _ => th;
  33.299 +
  33.300 +(*Must check for negative literal first!*)
  33.301 +val clause_rules = [disj_assoc, make_neg_rule, make_pos_rule];
  33.302 +val refined_clause_rules = [disj_assoc, make_refined_neg_rule, make_pos_rule];
  33.303 +
  33.304 +(*Create a goal or support clause, conclusing False*)
  33.305 +fun make_goal th =   (*Must check for negative literal first!*)
  33.306 +    make_goal (tryres(th, clause_rules)) 
  33.307 +  handle THM _ => tryres(th, [make_neg_goal, make_pos_goal]);
  33.308 +
  33.309 +(*Sort clauses by number of literals*)
  33.310 +fun fewerlits(th1,th2) = nliterals(prop_of th1) < nliterals(prop_of th2);
  33.311 +
  33.312 +(*TAUTOLOGY CHECK SHOULD NOT BE NECESSARY!*)
  33.313 +fun sort_clauses ths = sort fewerlits (filter (not o is_taut) ths);
  33.314 +
  33.315 +(*Convert all suitable free variables to schematic variables*)
  33.316 +fun generalize th = forall_elim_vars 0 (forall_intr_frees th);
  33.317 +
  33.318 +(*make clauses from a list of theorems*)
  33.319 +fun make_clauses ths = 
  33.320 +    sort_clauses (map (generalize o nodups) (foldr cnf (ths,[])));
  33.321 +
  33.322 +(*Create a Horn clause*)
  33.323 +fun make_horn crules th = make_horn crules (tryres(th,crules)) 
  33.324 +		          handle THM _ => th;
  33.325 +
  33.326 +(*Generate Horn clauses for all contrapositives of a clause*)
  33.327 +fun add_contras crules (th,hcs) = 
  33.328 +  let fun rots (0,th) = hcs
  33.329 +	| rots (k,th) = zero_var_indexes (make_horn crules th) ::
  33.330 +			rots(k-1, assoc_right (th RS disj_comm))
  33.331 +  in case nliterals(prop_of th) of
  33.332 +	1 => th::hcs
  33.333 +      | n => rots(n, assoc_right th)
  33.334 +  end;
  33.335 +
  33.336 +(*Convert a list of clauses to (contrapositive) Horn clauses*)
  33.337 +fun make_horns ths = foldr (add_contras clause_rules) (ths,[]);
  33.338 +
  33.339 +(*Find an all-negative support clause*)
  33.340 +fun is_negative th = forall (not o #1) (literals (prop_of th));
  33.341 +
  33.342 +val neg_clauses = filter is_negative;
  33.343 +
  33.344 +
  33.345 +(***** MESON PROOF PROCEDURE *****)
  33.346 +
  33.347 +fun rhyps (Const("==>",_) $ (Const("Trueprop",_) $ A) $ phi,
  33.348 +	   As) = rhyps(phi, A::As)
  33.349 +  | rhyps (_, As) = As;
  33.350 +
  33.351 +(** Detecting repeated assumptions in a subgoal **)
  33.352 +
  33.353 +(*The stringtree detects repeated assumptions.*)
  33.354 +fun ins_term (net,t) = Net.insert_term((t,t), net, op aconv);
  33.355 +
  33.356 +(*detects repetitions in a list of terms*)
  33.357 +fun has_reps [] = false
  33.358 +  | has_reps [_] = false
  33.359 +  | has_reps [t,u] = (t aconv u)
  33.360 +  | has_reps ts = (foldl ins_term (Net.empty, ts);  false)
  33.361 +    		  handle INSERT => true; 
  33.362 +
  33.363 +(*Loop checking: FAIL if trying to prove the same thing twice
  33.364 +  -- repeated literals*)
  33.365 +val check_tac = SUBGOAL (fn (prem,_) =>
  33.366 +  if has_reps (rhyps(prem,[]))  then  no_tac  else  all_tac); 
  33.367 +
  33.368 +(* net_resolve_tac actually made it slower... *)
  33.369 +fun prolog_step_tac horns i = 
  33.370 +    (assume_tac i APPEND resolve_tac horns i) THEN
  33.371 +    (ALLGOALS check_tac) THEN
  33.372 +    (TRYALL eq_assume_tac);
  33.373 +
  33.374 +
  33.375 +(*Sums the sizes of the subgoals, ignoring hypotheses (ancestors)*)
  33.376 +local fun addconcl(prem,sz) = size_of_term (Logic.strip_assums_concl prem) + sz
  33.377 +in
  33.378 +fun size_of_subgoals st = foldr addconcl (prems_of st, 0)
  33.379 +end;
  33.380 +
  33.381 +(*Could simply use nprems_of, which would count remaining subgoals -- no
  33.382 +  discrimination as to their size!  With BEST_FIRST, fails for problem 41.*)
  33.383 +
  33.384 +fun best_prolog_tac sizef horns = 
  33.385 +    BEST_FIRST (has_fewer_prems 1, sizef) (prolog_step_tac horns 1);
  33.386 +
  33.387 +fun depth_prolog_tac horns = 
  33.388 +    DEPTH_FIRST (has_fewer_prems 1) (prolog_step_tac horns 1);
  33.389 +
  33.390 +(*Return all negative clauses, as possible goal clauses*)
  33.391 +fun gocls cls = map make_goal (neg_clauses cls);
  33.392 +
  33.393 +
  33.394 +fun skolemize_tac prems = 
  33.395 +    cut_facts_tac (map (skolemize o make_nnf) prems)  THEN'
  33.396 +    REPEAT o (etac exE);
  33.397 +
  33.398 +fun MESON sko_tac = SELECT_GOAL
  33.399 + (EVERY1 [rtac ccontr,
  33.400 +	  METAHYPS (fn negs =>
  33.401 +		    EVERY1 [skolemize_tac negs,
  33.402 +			    METAHYPS (sko_tac o make_clauses)])]);
  33.403 +
  33.404 +fun best_meson_tac sizef = 
  33.405 +  MESON (fn cls => 
  33.406 +	 resolve_tac (gocls cls) 1
  33.407 +	 THEN_BEST_FIRST 
  33.408 + 	 (has_fewer_prems 1, sizef,
  33.409 +	  prolog_step_tac (make_horns cls) 1));
  33.410 +
  33.411 +(*First, breaks the goal into independent units*)
  33.412 +val safe_meson_tac =
  33.413 +     SELECT_GOAL (TRY (safe_tac HOL_cs) THEN 
  33.414 +		  TRYALL (best_meson_tac size_of_subgoals));
  33.415 +
  33.416 +val depth_meson_tac =
  33.417 +     MESON (fn cls => EVERY [resolve_tac (gocls cls) 1, 
  33.418 +			     depth_prolog_tac (make_horns cls)]);
  33.419 +
  33.420 +writeln"Reached end of file.";
    34.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    34.2 +++ b/src/HOL/ex/mesontest.ML	Wed Mar 22 12:42:34 1995 +0100
    34.3 @@ -0,0 +1,496 @@
    34.4 +(*  Title: 	HOL/ex/meson
    34.5 +    ID:         $Id$
    34.6 +    Author: 	Lawrence C Paulson, Cambridge University Computer Laboratory
    34.7 +    Copyright   1992  University of Cambridge
    34.8 +
    34.9 +Test data for the MESON proof procedure
   34.10 +   (Excludes the equality problems 51, 52, 56, 58)
   34.11 +
   34.12 +show_hyps:=false;
   34.13 +
   34.14 +by (rtac ccontr 1);
   34.15 +val [prem] = gethyps 1;
   34.16 +val nnf = make_nnf prem;
   34.17 +val xsko = skolemize nnf;
   34.18 +by (cut_facts_tac [xsko] 1 THEN REPEAT (etac exE 1));
   34.19 +val [_,sko] = gethyps 1;
   34.20 +val clauses = make_clauses [sko];	
   34.21 +val horns = make_horns clauses;
   34.22 +val go::_ = neg_clauses clauses;
   34.23 +
   34.24 +goal HOL.thy "False";
   34.25 +by (rtac (make_goal go) 1);
   34.26 +by (prolog_step_tac horns 1);
   34.27 +by (depth_prolog_tac horns);
   34.28 +by (best_prolog_tac size_of_subgoals horns);
   34.29 +*)
   34.30 +
   34.31 +writeln"File HOL/ex/meson-test.";
   34.32 +
   34.33 +(**** Interactive examples ****)
   34.34 +
   34.35 +(*Generate nice names for Skolem functions*)
   34.36 +Logic.auto_rename := true; Logic.set_rename_prefix "a";
   34.37 +
   34.38 +
   34.39 +writeln"Problem 25";
   34.40 +goal HOL.thy "(? x. P(x)) &  \
   34.41 +\       (! x. L(x) --> ~ (M(x) & R(x))) &  \
   34.42 +\       (! x. P(x) --> (M(x) & L(x))) &   \
   34.43 +\       ((! x. P(x)-->Q(x)) | (? x. P(x)&R(x)))  \
   34.44 +\   --> (? x. Q(x)&P(x))";
   34.45 +by (rtac ccontr 1);
   34.46 +val [prem25] = gethyps 1;
   34.47 +val nnf25 = make_nnf prem25;
   34.48 +val xsko25 = skolemize nnf25;
   34.49 +by (cut_facts_tac [xsko25] 1 THEN REPEAT (etac exE 1));
   34.50 +val [_,sko25] = gethyps 1;
   34.51 +val clauses25 = make_clauses [sko25];	(*7 clauses*)
   34.52 +val horns25 = make_horns clauses25;	(*16 Horn clauses*)
   34.53 +val go25::_ = neg_clauses clauses25;
   34.54 +
   34.55 +goal HOL.thy "False";
   34.56 +by (rtac (make_goal go25) 1);
   34.57 +by (depth_prolog_tac horns25);
   34.58 +
   34.59 +
   34.60 +writeln"Problem 26";
   34.61 +goal HOL.thy "((? x. p(x)) = (? x. q(x))) &	\
   34.62 +\     (! x. ! y. p(x) & q(y) --> (r(x) = s(y)))	\
   34.63 +\ --> ((! x. p(x)-->r(x)) = (! x. q(x)-->s(x)))";
   34.64 +by (rtac ccontr 1);
   34.65 +val [prem26] = gethyps 1;
   34.66 +val nnf26 = make_nnf prem26;
   34.67 +val xsko26 = skolemize nnf26;
   34.68 +by (cut_facts_tac [xsko26] 1 THEN REPEAT (etac exE 1));
   34.69 +val [_,sko26] = gethyps 1;
   34.70 +val clauses26 = make_clauses [sko26];			(*9 clauses*)
   34.71 +val horns26 = make_horns clauses26;			(*24 Horn clauses*)
   34.72 +val go26::_ = neg_clauses clauses26;
   34.73 +
   34.74 +goal HOL.thy "False";
   34.75 +by (rtac (make_goal go26) 1);
   34.76 +by (depth_prolog_tac horns26);	(*6 secs*)
   34.77 +
   34.78 +
   34.79 +
   34.80 +writeln"Problem 43  NOW PROVED AUTOMATICALLY!!";
   34.81 +goal HOL.thy "(! x. ! y. q x y = (! z. p z x = (p z y::bool)))	\
   34.82 +\         --> (! x. (! y. q x y = (q y x::bool)))";
   34.83 +by (rtac ccontr 1);
   34.84 +val [prem43] = gethyps 1;
   34.85 +val nnf43 = make_nnf prem43;
   34.86 +val xsko43 = skolemize nnf43;
   34.87 +by (cut_facts_tac [xsko43] 1 THEN REPEAT (etac exE 1));
   34.88 +val [_,sko43] = gethyps 1;
   34.89 +val clauses43 = make_clauses [sko43];	(*6*)
   34.90 +val horns43 = make_horns clauses43;	(*16*)
   34.91 +val go43::_ = neg_clauses clauses43;
   34.92 +
   34.93 +goal HOL.thy "False";
   34.94 +by (rtac (make_goal go43) 1);
   34.95 +by (best_prolog_tac size_of_subgoals horns43);
   34.96 +(*8.7 secs*)
   34.97 +
   34.98 +
   34.99 +(*Restore variable name preservation*)
  34.100 +Logic.auto_rename := false; 
  34.101 +
  34.102 +
  34.103 +(**** Batch test data ****)
  34.104 +
  34.105 +(*Sample problems from 
  34.106 +  F. J. Pelletier, 
  34.107 +  Seventy-Five Problems for Testing Automatic Theorem Provers,
  34.108 +  J. Automated Reasoning 2 (1986), 191-216.
  34.109 +  Errata, JAR 4 (1988), 236-236.
  34.110 +
  34.111 +The hardest problems -- judging by experience with several theorem provers,
  34.112 +including matrix ones -- are 34 and 43.
  34.113 +*)
  34.114 +
  34.115 +writeln"Pelletier's examples";
  34.116 +(*1*)
  34.117 +goal HOL.thy "(P-->Q)  =  (~Q --> ~P)";
  34.118 +by (safe_meson_tac 1);
  34.119 +result();
  34.120 +
  34.121 +(*2*)
  34.122 +goal HOL.thy "(~ ~ P) =  P";
  34.123 +by (safe_meson_tac 1);
  34.124 +result();
  34.125 +
  34.126 +(*3*)
  34.127 +goal HOL.thy "~(P-->Q) --> (Q-->P)";
  34.128 +by (safe_meson_tac 1);
  34.129 +result();
  34.130 +
  34.131 +(*4*)
  34.132 +goal HOL.thy "(~P-->Q)  =  (~Q --> P)";
  34.133 +by (safe_meson_tac 1);
  34.134 +result();
  34.135 +
  34.136 +(*5*)
  34.137 +goal HOL.thy "((P|Q)-->(P|R)) --> (P|(Q-->R))";
  34.138 +by (safe_meson_tac 1);
  34.139 +result();
  34.140 +
  34.141 +(*6*)
  34.142 +goal HOL.thy "P | ~ P";
  34.143 +by (safe_meson_tac 1);
  34.144 +result();
  34.145 +
  34.146 +(*7*)
  34.147 +goal HOL.thy "P | ~ ~ ~ P";
  34.148 +by (safe_meson_tac 1);
  34.149 +result();
  34.150 +
  34.151 +(*8.  Peirce's law*)
  34.152 +goal HOL.thy "((P-->Q) --> P)  -->  P";
  34.153 +by (safe_meson_tac 1);
  34.154 +result();
  34.155 +
  34.156 +(*9*)
  34.157 +goal HOL.thy "((P|Q) & (~P|Q) & (P| ~Q)) --> ~ (~P | ~Q)";
  34.158 +by (safe_meson_tac 1);
  34.159 +result();
  34.160 +
  34.161 +(*10*)
  34.162 +goal HOL.thy "(Q-->R) & (R-->P&Q) & (P-->Q|R) --> (P=Q)";
  34.163 +by (safe_meson_tac 1);
  34.164 +result();
  34.165 +
  34.166 +(*11.  Proved in each direction (incorrectly, says Pelletier!!)  *)
  34.167 +goal HOL.thy "P=(P::bool)";
  34.168 +by (safe_meson_tac 1);
  34.169 +result();
  34.170 +
  34.171 +(*12.  "Dijkstra's law"*)
  34.172 +goal HOL.thy "((P = Q) = R) = (P = (Q = R))";
  34.173 +by (best_meson_tac size_of_subgoals 1);
  34.174 +result();
  34.175 +
  34.176 +(*13.  Distributive law*)
  34.177 +goal HOL.thy "(P | (Q & R)) = ((P | Q) & (P | R))";
  34.178 +by (safe_meson_tac 1);
  34.179 +result();
  34.180 +
  34.181 +(*14*)
  34.182 +goal HOL.thy "(P = Q) = ((Q | ~P) & (~Q|P))";
  34.183 +by (safe_meson_tac 1);
  34.184 +result();
  34.185 +
  34.186 +(*15*)
  34.187 +goal HOL.thy "(P --> Q) = (~P | Q)";
  34.188 +by (safe_meson_tac 1);
  34.189 +result();
  34.190 +
  34.191 +(*16*)
  34.192 +goal HOL.thy "(P-->Q) | (Q-->P)";
  34.193 +by (safe_meson_tac 1);
  34.194 +result();
  34.195 +
  34.196 +(*17*)
  34.197 +goal HOL.thy "((P & (Q-->R))-->S)  =  ((~P | Q | S) & (~P | ~R | S))";
  34.198 +by (safe_meson_tac 1);
  34.199 +result();
  34.200 +
  34.201 +writeln"Classical Logic: examples with quantifiers";
  34.202 +
  34.203 +goal HOL.thy "(! x. P(x) & Q(x)) = ((! x. P(x)) & (! x. Q(x)))";
  34.204 +by (safe_meson_tac 1);
  34.205 +result(); 
  34.206 +
  34.207 +goal HOL.thy "(? x. P-->Q(x))  =  (P --> (? x.Q(x)))";
  34.208 +by (safe_meson_tac 1);
  34.209 +result(); 
  34.210 +
  34.211 +goal HOL.thy "(? x.P(x)-->Q) = ((! x.P(x)) --> Q)";
  34.212 +by (safe_meson_tac 1);
  34.213 +result(); 
  34.214 +
  34.215 +goal HOL.thy "((! x.P(x)) | Q)  =  (! x. P(x) | Q)";
  34.216 +by (safe_meson_tac 1);
  34.217 +result(); 
  34.218 +
  34.219 +writeln"Testing the complete tactic";
  34.220 +
  34.221 +(*Not provable by pc_tac: needs multiple instantiation of !.
  34.222 +  Could be proved trivially by a PROLOG interpreter*)
  34.223 +goal HOL.thy "(! x. P(x)-->P(f(x)))  &  P(d)-->P(f(f(f(d))))";
  34.224 +by (safe_meson_tac 1);
  34.225 +result();
  34.226 +
  34.227 +(*Not provable by pc_tac: needs double instantiation of EXISTS*)
  34.228 +goal HOL.thy "? x. P(x) --> P(a) & P(b)";
  34.229 +by (safe_meson_tac 1);
  34.230 +result();
  34.231 +
  34.232 +goal HOL.thy "? z. P(z) --> (! x. P(x))";
  34.233 +by (safe_meson_tac 1);
  34.234 +result();
  34.235 +
  34.236 +writeln"Hard examples with quantifiers";
  34.237 +
  34.238 +writeln"Problem 18";
  34.239 +goal HOL.thy "? y. ! x. P(y)-->P(x)";
  34.240 +by (safe_meson_tac 1);
  34.241 +result(); 
  34.242 +
  34.243 +writeln"Problem 19";
  34.244 +goal HOL.thy "? x. ! y z. (P(y)-->Q(z)) --> (P(x)-->Q(x))";
  34.245 +by (safe_meson_tac 1);
  34.246 +result();
  34.247 +
  34.248 +writeln"Problem 20";
  34.249 +goal HOL.thy "(! x y. ? z. ! w. (P(x)&Q(y)-->R(z)&S(w)))     \
  34.250 +\   --> (? x y. P(x) & Q(y)) --> (? z. R(z))";
  34.251 +by (safe_meson_tac 1); 
  34.252 +result();
  34.253 +
  34.254 +writeln"Problem 21";
  34.255 +goal HOL.thy "(? x. P-->Q(x)) & (? x. Q(x)-->P) --> (? x. P=Q(x))";
  34.256 +by (safe_meson_tac 1); 
  34.257 +result();
  34.258 +
  34.259 +writeln"Problem 22";
  34.260 +goal HOL.thy "(! x. P = Q(x))  -->  (P = (! x. Q(x)))";
  34.261 +by (safe_meson_tac 1); 
  34.262 +result();
  34.263 +
  34.264 +writeln"Problem 23";
  34.265 +goal HOL.thy "(! x. P | Q(x))  =  (P | (! x. Q(x)))";
  34.266 +by (safe_meson_tac 1);  
  34.267 +result();
  34.268 +
  34.269 +writeln"Problem 24";
  34.270 +goal HOL.thy "~(? x. S(x)&Q(x)) & (! x. P(x) --> Q(x)|R(x)) &  \
  34.271 +\    ~(? x.P(x)) --> (? x.Q(x)) & (! x. Q(x)|R(x) --> S(x))  \
  34.272 +\   --> (? x. P(x)&R(x))";
  34.273 +by (safe_meson_tac 1); 
  34.274 +result();
  34.275 +
  34.276 +writeln"Problem 25";
  34.277 +goal HOL.thy "(? x. P(x)) &  \
  34.278 +\       (! x. L(x) --> ~ (M(x) & R(x))) &  \
  34.279 +\       (! x. P(x) --> (M(x) & L(x))) &   \
  34.280 +\       ((! x. P(x)-->Q(x)) | (? x. P(x)&R(x)))  \
  34.281 +\   --> (? x. Q(x)&P(x))";
  34.282 +by (safe_meson_tac 1); 
  34.283 +result();
  34.284 +
  34.285 +writeln"Problem 26";
  34.286 +goal HOL.thy "((? x. p(x)) = (? x. q(x))) &	\
  34.287 +\     (! x. ! y. p(x) & q(y) --> (r(x) = s(y)))	\
  34.288 +\ --> ((! x. p(x)-->r(x)) = (! x. q(x)-->s(x)))";
  34.289 +by (safe_meson_tac 1); 
  34.290 +result();
  34.291 +
  34.292 +writeln"Problem 27";
  34.293 +goal HOL.thy "(? x. P(x) & ~Q(x)) &   \
  34.294 +\             (! x. P(x) --> R(x)) &   \
  34.295 +\             (! x. M(x) & L(x) --> P(x)) &   \
  34.296 +\             ((? x. R(x) & ~ Q(x)) --> (! x. L(x) --> ~ R(x)))  \
  34.297 +\         --> (! x. M(x) --> ~L(x))";
  34.298 +by (safe_meson_tac 1); 
  34.299 +result();
  34.300 +
  34.301 +writeln"Problem 28.  AMENDED";
  34.302 +goal HOL.thy "(! x. P(x) --> (! x. Q(x))) &   \
  34.303 +\       ((! x. Q(x)|R(x)) --> (? x. Q(x)&S(x))) &  \
  34.304 +\       ((? x.S(x)) --> (! x. L(x) --> M(x)))  \
  34.305 +\   --> (! x. P(x) & L(x) --> M(x))";
  34.306 +by (safe_meson_tac 1);  
  34.307 +result();
  34.308 +
  34.309 +writeln"Problem 29.  Essentially the same as Principia Mathematica *11.71";
  34.310 +goal HOL.thy "(? x. F(x)) & (? y. G(y))  \
  34.311 +\   --> ( ((! x. F(x)-->H(x)) & (! y. G(y)-->J(y)))  =   \
  34.312 +\         (! x y. F(x) & G(y) --> H(x) & J(y)))";
  34.313 +by (safe_meson_tac 1);		(*5 secs*)
  34.314 +result();
  34.315 +
  34.316 +writeln"Problem 30";
  34.317 +goal HOL.thy "(! x. P(x) | Q(x) --> ~ R(x)) & \
  34.318 +\       (! x. (Q(x) --> ~ S(x)) --> P(x) & R(x))  \
  34.319 +\   --> (! x. S(x))";
  34.320 +by (safe_meson_tac 1);  
  34.321 +result();
  34.322 +
  34.323 +writeln"Problem 31";
  34.324 +goal HOL.thy "~(? x.P(x) & (Q(x) | R(x))) & \
  34.325 +\       (? x. L(x) & P(x)) & \
  34.326 +\       (! x. ~ R(x) --> M(x))  \
  34.327 +\   --> (? x. L(x) & M(x))";
  34.328 +by (safe_meson_tac 1);
  34.329 +result();
  34.330 +
  34.331 +writeln"Problem 32";
  34.332 +goal HOL.thy "(! x. P(x) & (Q(x)|R(x))-->S(x)) & \
  34.333 +\       (! x. S(x) & R(x) --> L(x)) & \
  34.334 +\       (! x. M(x) --> R(x))  \
  34.335 +\   --> (! x. P(x) & M(x) --> L(x))";
  34.336 +by (safe_meson_tac 1);
  34.337 +result();
  34.338 +
  34.339 +writeln"Problem 33";
  34.340 +goal HOL.thy "(! x. P(a) & (P(x)-->P(b))-->P(c))  =    \
  34.341 +\    (! x. (~P(a) | P(x) | P(c)) & (~P(a) | ~P(b) | P(c)))";
  34.342 +by (safe_meson_tac 1);		(*5.6 secs*)
  34.343 +result();
  34.344 +
  34.345 +writeln"Problem 34  AMENDED (TWICE!!)";
  34.346 +(*Andrews's challenge*)
  34.347 +goal HOL.thy "((? x. ! y. p(x) = p(y))  =		\
  34.348 +\              ((? x. q(x)) = (! y. p(y))))     =	\
  34.349 +\             ((? x. ! y. q(x) = q(y))  =		\
  34.350 +\              ((? x. p(x)) = (! y. q(y))))";
  34.351 +by (safe_meson_tac 1);  	(*90 secs*)
  34.352 +result();
  34.353 +
  34.354 +writeln"Problem 35";
  34.355 +goal HOL.thy "? x y. P x y -->  (! u v. P u v)";
  34.356 +by (safe_meson_tac 1);
  34.357 +result();
  34.358 +
  34.359 +writeln"Problem 36";
  34.360 +goal HOL.thy "(! x. ? y. J x y) & \
  34.361 +\       (! x. ? y. G x y) & \
  34.362 +\       (! x y. J x y | G x y -->	\
  34.363 +\       (! z. J y z | G y z --> H x z))   \
  34.364 +\   --> (! x. ? y. H x y)";
  34.365 +by (safe_meson_tac 1);
  34.366 +result();
  34.367 +
  34.368 +writeln"Problem 37";
  34.369 +goal HOL.thy "(! z. ? w. ! x. ? y. \
  34.370 +\          (P x z-->P y w) & P y z & (P y w --> (? u.Q u w))) & \
  34.371 +\       (! x z. ~P x z --> (? y. Q y z)) & \
  34.372 +\       ((? x y. Q x y) --> (! x. R x x))  \
  34.373 +\   --> (! x. ? y. R x y)";
  34.374 +by (safe_meson_tac 1);   (*causes unification tracing messages*)
  34.375 +result();
  34.376 +
  34.377 +writeln"Problem 38";
  34.378 +goal HOL.thy
  34.379 +    "(! x. p(a) & (p(x) --> (? y. p(y) & r x y)) -->		\
  34.380 +\          (? z. ? w. p(z) & r x w & r w z))  =			\
  34.381 +\    (! x. (~p(a) | p(x) | (? z. ? w. p(z) & r x w & r w z)) &	\
  34.382 +\          (~p(a) | ~(? y. p(y) & r x y) |			\
  34.383 +\           (? z. ? w. p(z) & r x w & r w z)))";
  34.384 +by (safe_meson_tac 1);		(*62 secs*)
  34.385 +result();
  34.386 +
  34.387 +writeln"Problem 39";
  34.388 +goal HOL.thy "~ (? x. ! y. F y x = (~F y y))";
  34.389 +by (safe_meson_tac 1);
  34.390 +result();
  34.391 +
  34.392 +writeln"Problem 40.  AMENDED";
  34.393 +goal HOL.thy "(? y. ! x. F x y = F x x)  \
  34.394 +\       -->  ~ (! x. ? y. ! z. F z y = (~F z x))";
  34.395 +by (safe_meson_tac 1);
  34.396 +result();
  34.397 +
  34.398 +writeln"Problem 41";
  34.399 +goal HOL.thy "(! z. (? y. (! x. f x y = (f x z & ~ f x x))))	\
  34.400 +\              --> ~ (? z. ! x. f x z)";
  34.401 +by (safe_meson_tac 1);
  34.402 +result();
  34.403 +
  34.404 +writeln"Problem 42";
  34.405 +goal HOL.thy "~ (? y. ! x. p x y = (~ (? z. p x z & p z x)))";
  34.406 +by (safe_meson_tac 1);
  34.407 +result();
  34.408 +
  34.409 +writeln"Problem 43  NOW PROVED AUTOMATICALLY!!";
  34.410 +goal HOL.thy "(! x. ! y. q x y = (! z. p z x = (p z y::bool)))	\
  34.411 +\         --> (! x. (! y. q x y = (q y x::bool)))";
  34.412 +by (safe_meson_tac 1);
  34.413 +result();
  34.414 +
  34.415 +writeln"Problem 44";
  34.416 +goal HOL.thy "(! x. f(x) -->					\
  34.417 +\             (? y. g(y) & h x y & (? y. g(y) & ~ h x y)))  &  	\
  34.418 +\             (? x. j(x) & (! y. g(y) --> h x y))		\
  34.419 +\             --> (? x. j(x) & ~f(x))";
  34.420 +by (safe_meson_tac 1);
  34.421 +result();
  34.422 +
  34.423 +writeln"Problem 45";
  34.424 +goal HOL.thy "(! x. f(x) & (! y. g(y) & h x y --> j x y)	\
  34.425 +\                     --> (! y. g(y) & h x y --> k(y))) &	\
  34.426 +\     ~ (? y. l(y) & k(y)) &					\
  34.427 +\     (? x. f(x) & (! y. h x y --> l(y))			\
  34.428 +\                  & (! y. g(y) & h x y --> j x y))		\
  34.429 +\     --> (? x. f(x) & ~ (? y. g(y) & h x y))";
  34.430 +by (safe_meson_tac 1);  	(*11 secs*)
  34.431 +result();
  34.432 +
  34.433 +writeln"Problem 46";
  34.434 +goal HOL.thy
  34.435 +    "(! x. f(x) & (! y. f(y) & h y x --> g(y)) --> g(x)) &	\
  34.436 +\    ((? x.f(x) & ~g(x)) -->					\
  34.437 +\     (? x. f(x) & ~g(x) & (! y. f(y) & ~g(y) --> j x y))) &	\
  34.438 +\    (! x y. f(x) & f(y) & h x y --> ~j y x)			\
  34.439 +\     --> (! x. f(x) --> g(x))";
  34.440 +by (safe_meson_tac 1); 		(*11 secs*)
  34.441 +result();
  34.442 +
  34.443 +(* Example suggested by Johannes Schumann and credited to Pelletier *)
  34.444 +goal HOL.thy "(!x y z. P x y --> P y z --> P x z) --> \
  34.445 +\	(!x y z. Q x y --> Q y z --> Q x z) --> \
  34.446 +\	(!x y.Q x y --> Q y x) -->  (!x y. P x y | Q x y) --> \
  34.447 +\	(!x y.P x y) | (!x y.Q x y)";
  34.448 +by (safe_meson_tac 1);		(*32 secs*)
  34.449 +result();
  34.450 +
  34.451 +writeln"Problem 50";  
  34.452 +(*What has this to do with equality?*)
  34.453 +goal HOL.thy "(! x. P a x | (! y.P x y)) --> (? x. ! y.P x y)";
  34.454 +by (safe_meson_tac 1);
  34.455 +result();
  34.456 +
  34.457 +writeln"Problem 55";
  34.458 +
  34.459 +(*Non-equational version, from Manthey and Bry, CADE-9 (Springer, 1988).
  34.460 +  meson_tac cannot report who killed Agatha. *)
  34.461 +goal HOL.thy "lives(agatha) & lives(butler) & lives(charles) & \
  34.462 +\  (killed agatha agatha | killed butler agatha | killed charles agatha) & \
  34.463 +\  (!x y. killed x y --> hates x y & ~richer x y) & \
  34.464 +\  (!x. hates agatha x --> ~hates charles x) & \
  34.465 +\  (hates agatha agatha & hates agatha charles) & \
  34.466 +\  (!x. lives(x) & ~richer x agatha --> hates butler x) & \
  34.467 +\  (!x. hates agatha x --> hates butler x) & \
  34.468 +\  (!x. ~hates x agatha | ~hates x butler | ~hates x charles) --> \
  34.469 +\  (? x. killed x agatha)";
  34.470 +by (safe_meson_tac 1);
  34.471 +result();
  34.472 +
  34.473 +writeln"Problem 57";
  34.474 +goal HOL.thy
  34.475 +    "P (f a b) (f b c) & P (f b c) (f a c) & \
  34.476 +\    (! x y z. P x y & P y z --> P x z)    -->   P (f a b) (f a c)";
  34.477 +by (safe_meson_tac 1);
  34.478 +result();
  34.479 +
  34.480 +writeln"Problem 58";
  34.481 +(* Challenge found on info-hol *)
  34.482 +goal HOL.thy
  34.483 +    "! P Q R x. ? v w. ! y z. P(x) & Q(y) --> (P(v) | R(w)) & (R(z) --> Q(v))";
  34.484 +by (safe_meson_tac 1);
  34.485 +result();
  34.486 +
  34.487 +writeln"Problem 59";
  34.488 +goal HOL.thy "(! x. P(x) = (~P(f(x)))) --> (? x. P(x) & ~P(f(x)))";
  34.489 +by (safe_meson_tac 1);
  34.490 +result();
  34.491 +
  34.492 +writeln"Problem 60";
  34.493 +goal HOL.thy "! x. P x (f x) = (? y. (! z. P z y --> P z (f x)) & P x y)";
  34.494 +by (safe_meson_tac 1);
  34.495 +result();
  34.496 +
  34.497 +writeln"Reached end of file.";
  34.498 +
  34.499 +(*26 August 1992: loaded in 277 secs.  New Jersey v 75*)
    35.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    35.2 +++ b/src/HOL/ex/rel.ML	Wed Mar 22 12:42:34 1995 +0100
    35.3 @@ -0,0 +1,109 @@
    35.4 +(*  Title: 	HOL/ex/rel
    35.5 +    ID:         $Id$
    35.6 +    Author: 	Lawrence C Paulson, Cambridge University Computer Laboratory
    35.7 +    Copyright   1991  University of Cambridge
    35.8 +
    35.9 +Domain, range of a relation or function -- NOT YET WORKING
   35.10 +*)
   35.11 +
   35.12 +structure Rel =
   35.13 +struct
   35.14 +val thy = extend_theory Univ.thy "Rel"
   35.15 +([], [], [], [],
   35.16 + [ 
   35.17 +  (["domain"],	"('a * 'b)set => 'a set"),
   35.18 +  (["range2"],	"('a * 'b)set => 'b set"),
   35.19 +  (["field"],	"('a * 'a)set => 'a set")
   35.20 + ],
   35.21 + None)
   35.22 + [
   35.23 +  ("domain_def",     "domain(r) == {a. ? b. <a,b> : r}" ),
   35.24 +  ("range2_def",     "range2(r) == {b. ? a. <a,b> : r}" ),
   35.25 +  ("field_def",      "field(r)  == domain(r) Un range2(r)" )
   35.26 + ];
   35.27 +end;
   35.28 +
   35.29 +local val ax = get_axiom Rel.thy
   35.30 +in
   35.31 +val domain_def = ax"domain_def";
   35.32 +val range2_def = ax"range2_def";
   35.33 +val field_def = ax"field_def";
   35.34 +end;
   35.35 +
   35.36 +
   35.37 +(*** domain ***)
   35.38 +
   35.39 +val [prem] = goalw Rel.thy [domain_def,Pair_def] "<a,b>: r ==> a : domain(r)";
   35.40 +by (fast_tac (set_cs addIs [prem]) 1);
   35.41 +qed "domainI";
   35.42 +
   35.43 +val major::prems = goalw Rel.thy [domain_def]
   35.44 +    "[| a : domain(r);  !!y. <a,y>: r ==> P |] ==> P";
   35.45 +by (rtac (major RS CollectE) 1);
   35.46 +by (etac exE 1);
   35.47 +by (REPEAT (ares_tac prems 1));
   35.48 +qed "domainE";
   35.49 +
   35.50 +
   35.51 +(*** range2 ***)
   35.52 +
   35.53 +val [prem] = goalw Rel.thy [range2_def,Pair_def] "<a,b>: r ==> b : range2(r)";
   35.54 +by (fast_tac (set_cs addIs [prem]) 1);
   35.55 +qed "range2I";
   35.56 +
   35.57 +val major::prems = goalw Rel.thy [range2_def]
   35.58 +    "[| b : range2(r);  !!x. <x,b>: r ==> P |] ==> P";
   35.59 +by (rtac (major RS CollectE) 1);
   35.60 +by (etac exE 1);
   35.61 +by (REPEAT (ares_tac prems 1));
   35.62 +qed "range2E";
   35.63 +
   35.64 +
   35.65 +(*** field ***)
   35.66 +
   35.67 +val [prem] = goalw Rel.thy [field_def] "<a,b>: r ==> a : field(r)";
   35.68 +by (rtac (prem RS domainI RS UnI1) 1);
   35.69 +qed "fieldI1";
   35.70 +
   35.71 +val [prem] = goalw Rel.thy [field_def] "<a,b>: r ==> b : field(r)";
   35.72 +by (rtac (prem RS range2I RS UnI2) 1);
   35.73 +qed "fieldI2";
   35.74 +
   35.75 +val [prem] = goalw Rel.thy [field_def]
   35.76 +    "(~ <c,a>:r ==> <a,b>: r) ==> a : field(r)";
   35.77 +by (rtac (prem RS domainI RS UnCI) 1);
   35.78 +by (swap_res_tac [range2I] 1);
   35.79 +by (etac notnotD 1);
   35.80 +qed "fieldCI";
   35.81 +
   35.82 +val major::prems = goalw Rel.thy [field_def]
   35.83 +     "[| a : field(r);  \
   35.84 +\        !!x. <a,x>: r ==> P;  \
   35.85 +\        !!x. <x,a>: r ==> P        |] ==> P";
   35.86 +by (rtac (major RS UnE) 1);
   35.87 +by (REPEAT (eresolve_tac (prems@[domainE,range2E]) 1));
   35.88 +qed "fieldE";
   35.89 +
   35.90 +goalw Rel.thy [field_def] "domain(r) <= field(r)";
   35.91 +by (rtac Un_upper1 1);
   35.92 +qed "domain_in_field";
   35.93 +
   35.94 +goalw Rel.thy [field_def] "range2(r) <= field(r)";
   35.95 +by (rtac Un_upper2 1);
   35.96 +qed "range2_in_field";
   35.97 +
   35.98 +
   35.99 +????????????????????????????????????????????????????????????????;
  35.100 +
  35.101 +(*If r allows well-founded induction then wf(r)*)
  35.102 +val [prem1,prem2] = goalw Rel.thy [wf_def] 
  35.103 +    "[| field(r)<=A;  \
  35.104 +\       !!P u. ! x:A. (! y. <y,x>: r --> P(y)) --> P(x) ==> P(u) |]  \
  35.105 +\    ==>  wf(r)";
  35.106 +by (rtac (prem1 RS wfI) 1);
  35.107 +by (res_inst_tac [ ("B", "A-Z") ] (prem2 RS subsetCE) 1);
  35.108 +by (fast_tac ZF_cs 3);
  35.109 +by (fast_tac ZF_cs 2);
  35.110 +by (fast_tac ZF_cs 1);
  35.111 +qed "wfI2";
  35.112 +
    36.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    36.2 +++ b/src/HOL/ex/set.ML	Wed Mar 22 12:42:34 1995 +0100
    36.3 @@ -0,0 +1,132 @@
    36.4 +(*  Title: 	HOL/ex/set.ML
    36.5 +    ID:         $Id$
    36.6 +    Author: 	Tobias Nipkow, Cambridge University Computer Laboratory
    36.7 +    Copyright   1991  University of Cambridge
    36.8 +
    36.9 +Cantor's Theorem; the Schroeder-Berstein Theorem.  
   36.10 +*)
   36.11 +
   36.12 +
   36.13 +writeln"File HOL/ex/set.";
   36.14 +
   36.15 +(*** A unique fixpoint theorem --- fast/best/meson all fail ***)
   36.16 +
   36.17 +val [prem] = goal HOL.thy "?!x.f(g(x))=x ==> ?!y.g(f(y))=y";
   36.18 +by(EVERY1[rtac (prem RS ex1E), rtac ex1I, etac arg_cong,
   36.19 +          rtac subst, atac, etac allE, rtac arg_cong, etac mp, etac arg_cong]);
   36.20 +result();
   36.21 +
   36.22 +(*** Cantor's Theorem: There is no surjection from a set to its powerset. ***)
   36.23 +
   36.24 +goal Set.thy "~ (? f:: 'a=>'a set. ! S. ? x. f(x) = S)";
   36.25 +(*requires best-first search because it is undirectional*)
   36.26 +by (best_tac (set_cs addSEs [equalityCE]) 1);
   36.27 +qed "cantor1";
   36.28 +
   36.29 +(*This form displays the diagonal term*)
   36.30 +goal Set.thy "! f:: 'a=>'a set. ! x. f(x) ~= ?S(f)";
   36.31 +by (best_tac (set_cs addSEs [equalityCE]) 1);
   36.32 +uresult();
   36.33 +
   36.34 +(*This form exploits the set constructs*)
   36.35 +goal Set.thy "?S ~: range(f :: 'a=>'a set)";
   36.36 +by (rtac notI 1);
   36.37 +by (etac rangeE 1);
   36.38 +by (etac equalityCE 1);
   36.39 +by (dtac CollectD 1);
   36.40 +by (contr_tac 1);
   36.41 +by (swap_res_tac [CollectI] 1);
   36.42 +by (assume_tac 1);
   36.43 +
   36.44 +choplev 0;
   36.45 +by (best_tac (set_cs addSEs [equalityCE]) 1);
   36.46 +
   36.47 +(*** The Schroder-Berstein Theorem ***)
   36.48 +
   36.49 +val prems = goalw Lfp.thy [image_def] "inj(f) ==> Inv(f)``(f``X) = X";
   36.50 +by (cut_facts_tac prems 1);
   36.51 +by (rtac equalityI 1);
   36.52 +by (fast_tac (set_cs addEs [Inv_f_f RS ssubst]) 1);
   36.53 +by (fast_tac (set_cs addEs [Inv_f_f RS ssubst]) 1);
   36.54 +qed "inv_image_comp";
   36.55 +
   36.56 +val prems = goal Set.thy "f(a) ~: (f``X) ==> a~:X";
   36.57 +by (cfast_tac prems 1);
   36.58 +qed "contra_imageI";
   36.59 +
   36.60 +goal Lfp.thy "(a ~: Compl(X)) = (a:X)";
   36.61 +by (fast_tac set_cs 1);
   36.62 +qed "not_Compl";
   36.63 +
   36.64 +(*Lots of backtracking in this proof...*)
   36.65 +val [compl,fg,Xa] = goal Lfp.thy
   36.66 +    "[| Compl(f``X) = g``Compl(X);  f(a)=g(b);  a:X |] ==> b:X";
   36.67 +by (EVERY1 [rtac (not_Compl RS subst), rtac contra_imageI,
   36.68 +	    rtac (compl RS subst), rtac (fg RS subst), stac not_Compl,
   36.69 +	    rtac imageI, rtac Xa]);
   36.70 +qed "disj_lemma";
   36.71 +
   36.72 +goal Lfp.thy "range(%z. if z:X then f(z) else g(z)) = f``X Un g``Compl(X)";
   36.73 +by (rtac equalityI 1);
   36.74 +by (rewtac range_def);
   36.75 +by (fast_tac (set_cs addIs [if_P RS sym, if_not_P RS sym]) 2);
   36.76 +by (rtac subsetI 1);
   36.77 +by (etac CollectE 1);
   36.78 +by (etac exE 1);
   36.79 +by (etac ssubst 1);
   36.80 +by (rtac (excluded_middle RS disjE) 1);
   36.81 +by (EVERY' [rtac (if_P     RS ssubst), atac, fast_tac set_cs] 2);
   36.82 +by (EVERY' [rtac (if_not_P RS ssubst), atac, fast_tac set_cs] 1);
   36.83 +qed "range_if_then_else";
   36.84 +
   36.85 +goal Lfp.thy "a : X Un Compl(X)";
   36.86 +by (fast_tac set_cs 1);
   36.87 +qed "X_Un_Compl";
   36.88 +
   36.89 +goalw Lfp.thy [surj_def] "surj(f) = (!a. a : range(f))";
   36.90 +by (fast_tac (set_cs addEs [ssubst]) 1);
   36.91 +qed "surj_iff_full_range";
   36.92 +
   36.93 +val [compl] = goal Lfp.thy
   36.94 +    "Compl(f``X) = g``Compl(X) ==> surj(%z. if z:X then f(z) else g(z))";
   36.95 +by (sstac [surj_iff_full_range, range_if_then_else, compl RS sym] 1);
   36.96 +by (rtac (X_Un_Compl RS allI) 1);
   36.97 +qed "surj_if_then_else";
   36.98 +
   36.99 +val [injf,injg,compl,bij] = goal Lfp.thy
  36.100 +    "[| inj_onto f X;  inj_onto g (Compl X);  Compl(f``X) = g``Compl(X); \
  36.101 +\       bij = (%z. if z:X then f(z) else g(z)) |] ==> \
  36.102 +\       inj(bij) & surj(bij)";
  36.103 +val f_eq_gE = make_elim (compl RS disj_lemma);
  36.104 +by (rtac (bij RS ssubst) 1);
  36.105 +by (rtac conjI 1);
  36.106 +by (rtac (compl RS surj_if_then_else) 2);
  36.107 +by (rewtac inj_def);
  36.108 +by (cut_facts_tac [injf,injg] 1);
  36.109 +by (EVERY1 [rtac allI, rtac allI, stac expand_if, rtac conjI, stac expand_if]);
  36.110 +by (fast_tac (set_cs addEs  [inj_ontoD, sym RS f_eq_gE]) 1);
  36.111 +by (stac expand_if 1);
  36.112 +by (fast_tac (set_cs addEs  [inj_ontoD, f_eq_gE]) 1);
  36.113 +qed "bij_if_then_else";
  36.114 +
  36.115 +goal Lfp.thy "? X. X = Compl(g``Compl((f:: 'a=>'b)``X))";
  36.116 +by (rtac exI 1);
  36.117 +by (rtac lfp_Tarski 1);
  36.118 +by (REPEAT (ares_tac [monoI, image_mono, Compl_anti_mono] 1));
  36.119 +qed "decomposition";
  36.120 +
  36.121 +val [injf,injg] = goal Lfp.thy
  36.122 +   "[| inj(f:: 'a=>'b);  inj(g:: 'b=>'a) |] ==> \
  36.123 +\   ? h:: 'a=>'b. inj(h) & surj(h)";
  36.124 +by (rtac (decomposition RS exE) 1);
  36.125 +by (rtac exI 1);
  36.126 +by (rtac bij_if_then_else 1);
  36.127 +by (EVERY [rtac refl 4, rtac (injf RS inj_imp) 1,
  36.128 +	   rtac (injg RS inj_onto_Inv) 1]);
  36.129 +by (EVERY1 [etac ssubst, stac double_complement, rtac subsetI,
  36.130 +	    etac imageE, etac ssubst, rtac rangeI]);
  36.131 +by (EVERY1 [etac ssubst, stac double_complement, 
  36.132 +	    rtac (injg RS inv_image_comp RS sym)]);
  36.133 +qed "schroeder_bernstein";
  36.134 +
  36.135 +writeln"Reached end of file.";
    37.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    37.2 +++ b/src/HOL/ex/unsolved.ML	Wed Mar 22 12:42:34 1995 +0100
    37.3 @@ -0,0 +1,70 @@
    37.4 +(*  Title: 	HOL/ex/unsolved
    37.5 +    ID:         $Id$
    37.6 +    Author: 	Lawrence C Paulson, Cambridge University Computer Laboratory
    37.7 +    Copyright   1992  University of Cambridge
    37.8 +
    37.9 +Problems that currently defeat the MESON procedure as well as best_tac
   37.10 +*)
   37.11 +
   37.12 +(*from Vladimir Lifschitz, What Is the Inverse Method?, JAR 5 (1989), 1--23*)
   37.13 +goal HOL.thy "? x x'. ! y. ? z z'. (~P(y,y) | P(x,x) | ~S(z,x)) & \
   37.14 +\                                       (S(x,y) | ~S(y,z) | Q(z',z'))  & \
   37.15 +\                                       (Q(x',y) | ~Q(y,z') | S(x',x'))";
   37.16 +
   37.17 +
   37.18 +writeln"Problem 47  Schubert's Steamroller";
   37.19 +goal HOL.thy
   37.20 +    "(! x. P1(x) --> P0(x)) & (? x.P1(x)) &	\
   37.21 +\    (! x. P2(x) --> P0(x)) & (? x.P2(x)) &	\
   37.22 +\    (! x. P3(x) --> P0(x)) & (? x.P3(x)) &	\
   37.23 +\    (! x. P4(x) --> P0(x)) & (? x.P4(x)) &	\
   37.24 +\    (! x. P5(x) --> P0(x)) & (? x.P5(x)) &	\
   37.25 +\    (! x. Q1(x) --> Q0(x)) & (? x.Q1(x)) &	\
   37.26 +\    (! x. P0(x) --> ((! y.Q0(y)-->R(x,y)) | 	\
   37.27 +\		      (! y.P0(y) & S(y,x) & 	\
   37.28 +\		           (? z.Q0(z)&R(y,z)) --> R(x,y)))) &	\
   37.29 +\    (! x y. P3(y) & (P5(x)|P4(x)) --> S(x,y)) &	\
   37.30 +\    (! x y. P3(x) & P2(y) --> S(x,y)) &	\
   37.31 +\    (! x y. P2(x) & P1(y) --> S(x,y)) &	\
   37.32 +\    (! x y. P1(x) & (P2(y)|Q1(y)) --> ~R(x,y)) &	\
   37.33 +\    (! x y. P3(x) & P4(y) --> R(x,y)) &	\
   37.34 +\    (! x y. P3(x) & P5(y) --> ~R(x,y)) &	\
   37.35 +\    (! x. (P4(x)|P5(x)) --> (? y.Q0(y) & R(x,y)))	\
   37.36 +\    --> (? x y. P0(x) & P0(y) & (? z. Q1(z) & R(y,z) & R(x,y)))";
   37.37 +
   37.38 +
   37.39 +writeln"Problem 55";
   37.40 +
   37.41 +(*Original, equational version by Len Schubert, via Pelletier *)
   37.42 +goal HOL.thy
   37.43 +  "(? x. lives(x) & killed(x,agatha)) & \
   37.44 +\  lives(agatha) & lives(butler) & lives(charles) & \
   37.45 +\  (! x. lives(x) --> x=agatha | x=butler | x=charles) & \
   37.46 +\  (! x y. killed(x,y) --> hates(x,y)) & \
   37.47 +\  (! x y. killed(x,y) --> ~richer(x,y)) & \
   37.48 +\  (! x. hates(agatha,x) --> ~hates(charles,x)) & \
   37.49 +\  (! x. ~ x=butler --> hates(agatha,x)) & \
   37.50 +\  (! x. ~richer(x,agatha) --> hates(butler,x)) & \
   37.51 +\  (! x. hates(agatha,x) --> hates(butler,x)) & \
   37.52 +\  (! x. ? y. ~hates(x,y)) & \
   37.53 +\  ~ agatha=butler --> \
   37.54 +\  killed(agatha,agatha)";
   37.55 +
   37.56 +(** Charles Morgan's problems **)
   37.57 +
   37.58 +val axa = "! x y.   T(i(x, i(y,x)))";
   37.59 +val axb = "! x y z. T(i(i(x, i(y,z)), i(i(x,y), i(x,z))))";
   37.60 +val axc = "! x y.   T(i(i(n(x), n(y)), i(y,x)))";
   37.61 +val axd = "! x y.   T(i(x,y)) & T(x) --> T(y)";
   37.62 +
   37.63 +fun axjoin ([],   q) = q
   37.64 +  | axjoin(p::ps, q) = "(" ^ p ^ ") --> (" ^ axjoin(ps,q) ^ ")";
   37.65 +
   37.66 +goal HOL.thy (axjoin([axa,axb,axd], "! x. T(i(x,x))"));
   37.67 +
   37.68 +writeln"Problem 66";
   37.69 +goal HOL.thy (axjoin([axa,axb,axc,axd], "! x. T(i(x, n(n(x))))"));
   37.70 +
   37.71 +writeln"Problem 67";
   37.72 +goal HOL.thy (axjoin([axa,axb,axc,axd], "! x. T(i(n(n(x)), x))"));
   37.73 +