removed most batch-style proofs
authorpaulson
Tue Jul 04 15:58:11 2000 +0200 (2000-07-04)
changeset 9245428385c4bc50
parent 9244 7edd3e5f26d4
child 9246 91423cd08c6f
removed most batch-style proofs
src/HOLCF/Cfun1.ML
src/HOLCF/Cfun2.ML
src/HOLCF/Cfun3.ML
src/HOLCF/Cont.ML
src/HOLCF/Cprod1.ML
src/HOLCF/Cprod2.ML
src/HOLCF/Cprod3.ML
src/HOLCF/Fix.ML
src/HOLCF/Fun1.ML
src/HOLCF/Fun2.ML
src/HOLCF/Fun3.ML
src/HOLCF/HOLCF.ML
src/HOLCF/Lift2.ML
src/HOLCF/Lift3.ML
src/HOLCF/One.ML
src/HOLCF/Porder.ML
src/HOLCF/Porder0.ML
src/HOLCF/Sprod0.ML
src/HOLCF/Sprod1.ML
src/HOLCF/Sprod2.ML
src/HOLCF/Sprod3.ML
src/HOLCF/Ssum0.ML
src/HOLCF/Ssum1.ML
src/HOLCF/Ssum2.ML
src/HOLCF/Ssum3.ML
src/HOLCF/Tr.ML
src/HOLCF/Up1.ML
src/HOLCF/Up2.ML
src/HOLCF/Up3.ML
     1.1 --- a/src/HOLCF/Cfun1.ML	Tue Jul 04 14:58:40 2000 +0200
     1.2 +++ b/src/HOLCF/Cfun1.ML	Tue Jul 04 15:58:11 2000 +0200
     1.3 @@ -3,129 +3,103 @@
     1.4      Author:     Franz Regensburger
     1.5      Copyright   1993 Technische Universitaet Muenchen
     1.6  
     1.7 -Lemmas for Cfun1.thy 
     1.8 +The type ->  of continuous functions.
     1.9  *)
    1.10  
    1.11 -open Cfun1;
    1.12 -
    1.13  (* ------------------------------------------------------------------------ *)
    1.14  (* derive old type definition rules for Abs_CFun & Rep_CFun                         *)
    1.15  (* Rep_CFun and Abs_CFun should be replaced by Rep_Cfun anf Abs_Cfun in future      *)
    1.16  (* ------------------------------------------------------------------------ *)
    1.17 -qed_goal "Rep_Cfun" thy "Rep_CFun fo : CFun"
    1.18 -(fn prems =>
    1.19 -        [
    1.20 -        (rtac Rep_CFun 1)
    1.21 -        ]);
    1.22 +val prems = goal thy "Rep_CFun fo : CFun";
    1.23 +by (rtac Rep_CFun 1);
    1.24 +qed "Rep_Cfun";
    1.25  
    1.26 -qed_goal "Rep_Cfun_inverse" thy "Abs_CFun (Rep_CFun fo) = fo"
    1.27 -(fn prems =>
    1.28 -        [
    1.29 -        (rtac Rep_CFun_inverse 1)
    1.30 -        ]);
    1.31 +val prems = goal thy "Abs_CFun (Rep_CFun fo) = fo";
    1.32 +by (rtac Rep_CFun_inverse 1);
    1.33 +qed "Rep_Cfun_inverse";
    1.34  
    1.35 -qed_goal "Abs_Cfun_inverse" thy "f:CFun==>Rep_CFun(Abs_CFun f)=f"
    1.36 -(fn prems =>
    1.37 -        [
    1.38 -	(cut_facts_tac prems 1),
    1.39 -        (etac Abs_CFun_inverse 1)
    1.40 -        ]);
    1.41 +val prems = goal thy "f:CFun==>Rep_CFun(Abs_CFun f)=f";
    1.42 +by (cut_facts_tac prems 1);
    1.43 +by (etac Abs_CFun_inverse 1);
    1.44 +qed "Abs_Cfun_inverse";
    1.45  
    1.46  (* ------------------------------------------------------------------------ *)
    1.47  (* less_cfun is a partial order on type 'a -> 'b                            *)
    1.48  (* ------------------------------------------------------------------------ *)
    1.49  
    1.50 -qed_goalw "refl_less_cfun" thy [less_cfun_def] "(f::'a->'b) << f"
    1.51 -(fn prems =>
    1.52 -        [
    1.53 -        (rtac refl_less 1)
    1.54 -        ]);
    1.55 +val prems = goalw thy [less_cfun_def] "(f::'a->'b) << f";
    1.56 +by (rtac refl_less 1);
    1.57 +qed "refl_less_cfun";
    1.58  
    1.59 -qed_goalw "antisym_less_cfun" thy [less_cfun_def] 
    1.60 -        "[|(f1::'a->'b) << f2; f2 << f1|] ==> f1 = f2"
    1.61 -(fn prems =>
    1.62 -        [
    1.63 -        (cut_facts_tac prems 1),
    1.64 -        (rtac injD 1),
    1.65 -        (rtac antisym_less 2),
    1.66 -        (atac 3),
    1.67 -        (atac 2),
    1.68 -        (rtac inj_inverseI 1),
    1.69 -        (rtac Rep_Cfun_inverse 1)
    1.70 -        ]);
    1.71 +val prems = goalw thy [less_cfun_def] 
    1.72 +        "[|(f1::'a->'b) << f2; f2 << f1|] ==> f1 = f2";
    1.73 +by (cut_facts_tac prems 1);
    1.74 +by (rtac injD 1);
    1.75 +by (rtac antisym_less 2);
    1.76 +by (atac 3);
    1.77 +by (atac 2);
    1.78 +by (rtac inj_inverseI 1);
    1.79 +by (rtac Rep_Cfun_inverse 1);
    1.80 +qed "antisym_less_cfun";
    1.81  
    1.82 -qed_goalw "trans_less_cfun" thy [less_cfun_def] 
    1.83 -        "[|(f1::'a->'b) << f2; f2 << f3|] ==> f1 << f3"
    1.84 -(fn prems =>
    1.85 -        [
    1.86 -        (cut_facts_tac prems 1),
    1.87 -        (etac trans_less 1),
    1.88 -        (atac 1)
    1.89 -        ]);
    1.90 +val prems = goalw thy [less_cfun_def] 
    1.91 +        "[|(f1::'a->'b) << f2; f2 << f3|] ==> f1 << f3";
    1.92 +by (cut_facts_tac prems 1);
    1.93 +by (etac trans_less 1);
    1.94 +by (atac 1);
    1.95 +qed "trans_less_cfun";
    1.96  
    1.97  (* ------------------------------------------------------------------------ *)
    1.98  (* lemmas about application of continuous functions                         *)
    1.99  (* ------------------------------------------------------------------------ *)
   1.100  
   1.101 -qed_goal "cfun_cong" thy 
   1.102 -         "[| f=g; x=y |] ==> f`x = g`y"
   1.103 -(fn prems =>
   1.104 -        [
   1.105 -        (cut_facts_tac prems 1),
   1.106 -        (fast_tac HOL_cs 1)
   1.107 -        ]);
   1.108 +val prems = goal thy 
   1.109 +         "[| f=g; x=y |] ==> f`x = g`y";
   1.110 +by (cut_facts_tac prems 1);
   1.111 +by (fast_tac HOL_cs 1);
   1.112 +qed "cfun_cong";
   1.113  
   1.114 -qed_goal "cfun_fun_cong" thy "f=g ==> f`x = g`x"
   1.115 -(fn prems =>
   1.116 -        [
   1.117 -        (cut_facts_tac prems 1),
   1.118 -        (etac cfun_cong 1),
   1.119 -        (rtac refl 1)
   1.120 -        ]);
   1.121 +val prems = goal thy "f=g ==> f`x = g`x";
   1.122 +by (cut_facts_tac prems 1);
   1.123 +by (etac cfun_cong 1);
   1.124 +by (rtac refl 1);
   1.125 +qed "cfun_fun_cong";
   1.126  
   1.127 -qed_goal "cfun_arg_cong" thy "x=y ==> f`x = f`y"
   1.128 -(fn prems =>
   1.129 -        [
   1.130 -        (cut_facts_tac prems 1),
   1.131 -        (rtac cfun_cong 1),
   1.132 -        (rtac refl 1),
   1.133 -        (atac 1)
   1.134 -        ]);
   1.135 +val prems = goal thy "x=y ==> f`x = f`y";
   1.136 +by (cut_facts_tac prems 1);
   1.137 +by (rtac cfun_cong 1);
   1.138 +by (rtac refl 1);
   1.139 +by (atac 1);
   1.140 +qed "cfun_arg_cong";
   1.141  
   1.142  
   1.143  (* ------------------------------------------------------------------------ *)
   1.144  (* additional lemma about the isomorphism between -> and Cfun               *)
   1.145  (* ------------------------------------------------------------------------ *)
   1.146  
   1.147 -qed_goal "Abs_Cfun_inverse2" thy "cont f ==> Rep_CFun (Abs_CFun f) = f"
   1.148 -(fn prems =>
   1.149 -        [
   1.150 -        (cut_facts_tac prems 1),
   1.151 -        (rtac Abs_Cfun_inverse 1),
   1.152 -        (rewtac CFun_def),
   1.153 -        (etac (mem_Collect_eq RS ssubst) 1)
   1.154 -        ]);
   1.155 +val prems = goal thy "cont f ==> Rep_CFun (Abs_CFun f) = f";
   1.156 +by (cut_facts_tac prems 1);
   1.157 +by (rtac Abs_Cfun_inverse 1);
   1.158 +by (rewtac CFun_def);
   1.159 +by (etac (mem_Collect_eq RS ssubst) 1);
   1.160 +qed "Abs_Cfun_inverse2";
   1.161  
   1.162  (* ------------------------------------------------------------------------ *)
   1.163  (* simplification of application                                            *)
   1.164  (* ------------------------------------------------------------------------ *)
   1.165  
   1.166 -qed_goal "Cfunapp2" thy "cont f ==> (Abs_CFun f)`x = f x"
   1.167 -(fn prems =>
   1.168 -        [
   1.169 -        (cut_facts_tac prems 1),
   1.170 -        (etac (Abs_Cfun_inverse2 RS fun_cong) 1)
   1.171 -        ]);
   1.172 +val prems = goal thy "cont f ==> (Abs_CFun f)`x = f x";
   1.173 +by (cut_facts_tac prems 1);
   1.174 +by (etac (Abs_Cfun_inverse2 RS fun_cong) 1);
   1.175 +qed "Cfunapp2";
   1.176  
   1.177  (* ------------------------------------------------------------------------ *)
   1.178  (* beta - equality for continuous functions                                 *)
   1.179  (* ------------------------------------------------------------------------ *)
   1.180  
   1.181 -qed_goal "beta_cfun" thy 
   1.182 -        "cont(c1) ==> (LAM x .c1 x)`u = c1 u"
   1.183 -(fn prems =>
   1.184 -        [
   1.185 -        (cut_facts_tac prems 1),
   1.186 -        (rtac Cfunapp2 1),
   1.187 -        (atac 1)
   1.188 -        ]);
   1.189 +val prems = goal thy 
   1.190 +        "cont(c1) ==> (LAM x .c1 x)`u = c1 u";
   1.191 +by (cut_facts_tac prems 1);
   1.192 +by (rtac Cfunapp2 1);
   1.193 +by (atac 1);
   1.194 +qed "beta_cfun";
     2.1 --- a/src/HOLCF/Cfun2.ML	Tue Jul 04 14:58:40 2000 +0200
     2.2 +++ b/src/HOLCF/Cfun2.ML	Tue Jul 04 15:58:11 2000 +0200
     2.3 @@ -1,52 +1,42 @@
     2.4 -(*  Title:      HOLCF/cfun2.thy
     2.5 +(*  Title:      HOLCF/Cfun2
     2.6      ID:         $Id$
     2.7      Author:     Franz Regensburger
     2.8      Copyright   1993 Technische Universitaet Muenchen
     2.9  
    2.10 -Lemmas for cfun2.thy 
    2.11 +Class Instance ->::(cpo,cpo)po
    2.12  *)
    2.13  
    2.14 -open Cfun2;
    2.15 -
    2.16  (* for compatibility with old HOLCF-Version *)
    2.17 -qed_goal "inst_cfun_po" thy "(op <<)=(%f1 f2. Rep_CFun f1 << Rep_CFun f2)"
    2.18 - (fn prems => 
    2.19 -        [
    2.20 -	(fold_goals_tac [less_cfun_def]),
    2.21 -	(rtac refl 1)
    2.22 -        ]);
    2.23 +val prems = goal thy "(op <<)=(%f1 f2. Rep_CFun f1 << Rep_CFun f2)";
    2.24 +by (fold_goals_tac [less_cfun_def]);
    2.25 +by (rtac refl 1);
    2.26 +qed "inst_cfun_po";
    2.27  
    2.28  (* ------------------------------------------------------------------------ *)
    2.29  (* access to less_cfun in class po                                          *)
    2.30  (* ------------------------------------------------------------------------ *)
    2.31  
    2.32 -qed_goal "less_cfun" thy "( f1 << f2 ) = (Rep_CFun(f1) << Rep_CFun(f2))"
    2.33 -(fn prems =>
    2.34 -        [
    2.35 -        (simp_tac (simpset() addsimps [inst_cfun_po]) 1)
    2.36 -        ]);
    2.37 +val prems = goal thy "( f1 << f2 ) = (Rep_CFun(f1) << Rep_CFun(f2))";
    2.38 +by (simp_tac (simpset() addsimps [inst_cfun_po]) 1);
    2.39 +qed "less_cfun";
    2.40  
    2.41  (* ------------------------------------------------------------------------ *)
    2.42  (* Type 'a ->'b  is pointed                                                 *)
    2.43  (* ------------------------------------------------------------------------ *)
    2.44  
    2.45 -qed_goal "minimal_cfun" thy "Abs_CFun(% x. UU) << f"
    2.46 -(fn prems =>
    2.47 -        [
    2.48 -        (stac less_cfun 1),
    2.49 -        (stac Abs_Cfun_inverse2 1),
    2.50 -        (rtac cont_const 1),
    2.51 -        (rtac minimal_fun 1)
    2.52 -        ]);
    2.53 +val prems = goal thy "Abs_CFun(% x. UU) << f";
    2.54 +by (stac less_cfun 1);
    2.55 +by (stac Abs_Cfun_inverse2 1);
    2.56 +by (rtac cont_const 1);
    2.57 +by (rtac minimal_fun 1);
    2.58 +qed "minimal_cfun";
    2.59  
    2.60  bind_thm ("UU_cfun_def",minimal_cfun RS minimal2UU RS sym);
    2.61  
    2.62 -qed_goal "least_cfun" thy "? x::'a->'b::pcpo.!y. x<<y"
    2.63 -(fn prems =>
    2.64 -        [
    2.65 -        (res_inst_tac [("x","Abs_CFun(% x. UU)")] exI 1),
    2.66 -        (rtac (minimal_cfun RS allI) 1)
    2.67 -        ]);
    2.68 +val prems = goal thy "? x::'a->'b::pcpo.!y. x<<y";
    2.69 +by (res_inst_tac [("x","Abs_CFun(% x. UU)")] exI 1);
    2.70 +by (rtac (minimal_cfun RS allI) 1);
    2.71 +qed "least_cfun";
    2.72  
    2.73  (* ------------------------------------------------------------------------ *)
    2.74  (* Rep_CFun yields continuous functions in 'a => 'b                             *)
    2.75 @@ -54,13 +44,11 @@
    2.76  (* cont_Rep_CFun2 ==> monofun_Rep_CFun2 & contlub_Rep_CFun2                            *)
    2.77  (* ------------------------------------------------------------------------ *)
    2.78  
    2.79 -qed_goal "cont_Rep_CFun2" thy "cont(Rep_CFun(fo))"
    2.80 -(fn prems =>
    2.81 -        [
    2.82 -        (res_inst_tac [("P","cont")] CollectD 1),
    2.83 -        (fold_goals_tac [CFun_def]),
    2.84 -        (rtac Rep_Cfun 1)
    2.85 -        ]);
    2.86 +val prems = goal thy "cont(Rep_CFun(fo))";
    2.87 +by (res_inst_tac [("P","cont")] CollectD 1);
    2.88 +by (fold_goals_tac [CFun_def]);
    2.89 +by (rtac Rep_Cfun 1);
    2.90 +qed "cont_Rep_CFun2";
    2.91  
    2.92  bind_thm ("monofun_Rep_CFun2", cont_Rep_CFun2 RS cont2mono);
    2.93  (* monofun(Rep_CFun(?fo1)) *)
    2.94 @@ -85,26 +73,22 @@
    2.95  (* Rep_CFun is monotone in its 'first' argument                                 *)
    2.96  (* ------------------------------------------------------------------------ *)
    2.97  
    2.98 -qed_goalw "monofun_Rep_CFun1" thy [monofun] "monofun(Rep_CFun)"
    2.99 -(fn prems =>
   2.100 -        [
   2.101 -        (strip_tac 1),
   2.102 -        (etac (less_cfun RS subst) 1)
   2.103 -        ]);
   2.104 +val prems = goalw thy [monofun] "monofun(Rep_CFun)";
   2.105 +by (strip_tac 1);
   2.106 +by (etac (less_cfun RS subst) 1);
   2.107 +qed "monofun_Rep_CFun1";
   2.108  
   2.109  
   2.110  (* ------------------------------------------------------------------------ *)
   2.111  (* monotonicity of application Rep_CFun in mixfix syntax [_]_                   *)
   2.112  (* ------------------------------------------------------------------------ *)
   2.113  
   2.114 -qed_goal "monofun_cfun_fun" thy  "f1 << f2 ==> f1`x << f2`x"
   2.115 -(fn prems =>
   2.116 -        [
   2.117 -        (cut_facts_tac prems 1),
   2.118 -        (res_inst_tac [("x","x")] spec 1),
   2.119 -        (rtac (less_fun RS subst) 1),
   2.120 -        (etac (monofun_Rep_CFun1 RS monofunE RS spec RS spec RS mp) 1)
   2.121 -        ]);
   2.122 +val prems = goal thy  "f1 << f2 ==> f1`x << f2`x";
   2.123 +by (cut_facts_tac prems 1);
   2.124 +by (res_inst_tac [("x","x")] spec 1);
   2.125 +by (rtac (less_fun RS subst) 1);
   2.126 +by (etac (monofun_Rep_CFun1 RS monofunE RS spec RS spec RS mp) 1);
   2.127 +qed "monofun_cfun_fun";
   2.128  
   2.129  
   2.130  bind_thm ("monofun_cfun_arg", monofun_Rep_CFun2 RS monofunE RS spec RS spec RS mp);
   2.131 @@ -114,22 +98,20 @@
   2.132  (* monotonicity of Rep_CFun in both arguments in mixfix syntax [_]_             *)
   2.133  (* ------------------------------------------------------------------------ *)
   2.134  
   2.135 -qed_goal "monofun_cfun" thy
   2.136 -        "[|f1<<f2;x1<<x2|] ==> f1`x1 << f2`x2"
   2.137 -(fn prems =>
   2.138 -        [
   2.139 -        (cut_facts_tac prems 1),
   2.140 -        (rtac trans_less 1),
   2.141 -        (etac monofun_cfun_arg 1),
   2.142 -        (etac monofun_cfun_fun 1)
   2.143 -        ]);
   2.144 +val prems = goal thy
   2.145 +        "[|f1<<f2;x1<<x2|] ==> f1`x1 << f2`x2";
   2.146 +by (cut_facts_tac prems 1);
   2.147 +by (rtac trans_less 1);
   2.148 +by (etac monofun_cfun_arg 1);
   2.149 +by (etac monofun_cfun_fun 1);
   2.150 +qed "monofun_cfun";
   2.151  
   2.152  
   2.153 -qed_goal "strictI" thy "f`x = UU ==> f`UU = UU" (fn prems => [
   2.154 -        cut_facts_tac prems 1,
   2.155 -        rtac (eq_UU_iff RS iffD2) 1,
   2.156 -        etac subst 1,
   2.157 -        rtac (minimal RS monofun_cfun_arg) 1]);
   2.158 +Goal "f`x = UU ==> f`UU = UU";
   2.159 +by (rtac (eq_UU_iff RS iffD2) 1);
   2.160 +by (etac subst 1);
   2.161 +by (rtac (minimal RS monofun_cfun_arg) 1);
   2.162 +qed "strictI";
   2.163  
   2.164  
   2.165  (* ------------------------------------------------------------------------ *)
   2.166 @@ -137,13 +119,11 @@
   2.167  (* use MF2 lemmas from Cont.ML                                              *)
   2.168  (* ------------------------------------------------------------------------ *)
   2.169  
   2.170 -qed_goal "ch2ch_Rep_CFunR" thy 
   2.171 - "chain(Y) ==> chain(%i. f`(Y i))"
   2.172 -(fn prems =>
   2.173 -        [
   2.174 -        (cut_facts_tac prems 1),
   2.175 -        (etac (monofun_Rep_CFun2 RS ch2ch_MF2R) 1)
   2.176 -        ]);
   2.177 +val prems = goal thy 
   2.178 + "chain(Y) ==> chain(%i. f`(Y i))";
   2.179 +by (cut_facts_tac prems 1);
   2.180 +by (etac (monofun_Rep_CFun2 RS ch2ch_MF2R) 1);
   2.181 +qed "ch2ch_Rep_CFunR";
   2.182  
   2.183  
   2.184  bind_thm ("ch2ch_Rep_CFunL", monofun_Rep_CFun1 RS ch2ch_MF2L);
   2.185 @@ -155,142 +135,126 @@
   2.186  (* use MF2 lemmas from Cont.ML                                              *)
   2.187  (* ------------------------------------------------------------------------ *)
   2.188  
   2.189 -qed_goal "lub_cfun_mono" thy 
   2.190 -        "chain(F) ==> monofun(% x. lub(range(% j.(F j)`x)))"
   2.191 -(fn prems =>
   2.192 -        [
   2.193 -        (cut_facts_tac prems 1),
   2.194 -        (rtac lub_MF2_mono 1),
   2.195 -        (rtac monofun_Rep_CFun1 1),
   2.196 -        (rtac (monofun_Rep_CFun2 RS allI) 1),
   2.197 -        (atac 1)
   2.198 -        ]);
   2.199 +val prems = goal thy 
   2.200 +        "chain(F) ==> monofun(% x. lub(range(% j.(F j)`x)))";
   2.201 +by (cut_facts_tac prems 1);
   2.202 +by (rtac lub_MF2_mono 1);
   2.203 +by (rtac monofun_Rep_CFun1 1);
   2.204 +by (rtac (monofun_Rep_CFun2 RS allI) 1);
   2.205 +by (atac 1);
   2.206 +qed "lub_cfun_mono";
   2.207  
   2.208  (* ------------------------------------------------------------------------ *)
   2.209  (* a lemma about the exchange of lubs for type 'a -> 'b                     *)
   2.210  (* use MF2 lemmas from Cont.ML                                              *)
   2.211  (* ------------------------------------------------------------------------ *)
   2.212  
   2.213 -qed_goal "ex_lubcfun" thy
   2.214 +val prems = goal thy
   2.215          "[| chain(F); chain(Y) |] ==>\
   2.216  \               lub(range(%j. lub(range(%i. F(j)`(Y i))))) =\
   2.217 -\               lub(range(%i. lub(range(%j. F(j)`(Y i)))))"
   2.218 -(fn prems =>
   2.219 -        [
   2.220 -        (cut_facts_tac prems 1),
   2.221 -        (rtac ex_lubMF2 1),
   2.222 -        (rtac monofun_Rep_CFun1 1),
   2.223 -        (rtac (monofun_Rep_CFun2 RS allI) 1),
   2.224 -        (atac 1),
   2.225 -        (atac 1)
   2.226 -        ]);
   2.227 +\               lub(range(%i. lub(range(%j. F(j)`(Y i)))))";
   2.228 +by (cut_facts_tac prems 1);
   2.229 +by (rtac ex_lubMF2 1);
   2.230 +by (rtac monofun_Rep_CFun1 1);
   2.231 +by (rtac (monofun_Rep_CFun2 RS allI) 1);
   2.232 +by (atac 1);
   2.233 +by (atac 1);
   2.234 +qed "ex_lubcfun";
   2.235  
   2.236  (* ------------------------------------------------------------------------ *)
   2.237  (* the lub of a chain of cont. functions is continuous                      *)
   2.238  (* ------------------------------------------------------------------------ *)
   2.239  
   2.240 -qed_goal "cont_lubcfun" thy 
   2.241 -        "chain(F) ==> cont(% x. lub(range(% j. F(j)`x)))"
   2.242 -(fn prems =>
   2.243 -        [
   2.244 -        (cut_facts_tac prems 1),
   2.245 -        (rtac monocontlub2cont 1),
   2.246 -        (etac lub_cfun_mono 1),
   2.247 -        (rtac contlubI 1),
   2.248 -        (strip_tac 1),
   2.249 -        (stac (contlub_cfun_arg RS ext) 1),
   2.250 -        (atac 1),
   2.251 -        (etac ex_lubcfun 1),
   2.252 -        (atac 1)
   2.253 -        ]);
   2.254 +val prems = goal thy 
   2.255 +        "chain(F) ==> cont(% x. lub(range(% j. F(j)`x)))";
   2.256 +by (cut_facts_tac prems 1);
   2.257 +by (rtac monocontlub2cont 1);
   2.258 +by (etac lub_cfun_mono 1);
   2.259 +by (rtac contlubI 1);
   2.260 +by (strip_tac 1);
   2.261 +by (stac (contlub_cfun_arg RS ext) 1);
   2.262 +by (atac 1);
   2.263 +by (etac ex_lubcfun 1);
   2.264 +by (atac 1);
   2.265 +qed "cont_lubcfun";
   2.266  
   2.267  (* ------------------------------------------------------------------------ *)
   2.268  (* type 'a -> 'b is chain complete                                          *)
   2.269  (* ------------------------------------------------------------------------ *)
   2.270  
   2.271 -qed_goal "lub_cfun" thy 
   2.272 -  "chain(CCF) ==> range(CCF) <<| (LAM x. lub(range(% i. CCF(i)`x)))"
   2.273 -(fn prems =>
   2.274 -        [
   2.275 -        (cut_facts_tac prems 1),
   2.276 -        (rtac is_lubI 1),
   2.277 -        (rtac conjI 1),
   2.278 -        (rtac ub_rangeI 1),  
   2.279 -        (rtac allI 1),
   2.280 -        (stac less_cfun 1),
   2.281 -        (stac Abs_Cfun_inverse2 1),
   2.282 -        (etac cont_lubcfun 1),
   2.283 -        (rtac (lub_fun RS is_lubE RS conjunct1 RS ub_rangeE RS spec) 1),
   2.284 -        (etac (monofun_Rep_CFun1 RS ch2ch_monofun) 1),
   2.285 -        (strip_tac 1),
   2.286 -        (stac less_cfun 1),
   2.287 -        (stac Abs_Cfun_inverse2 1),
   2.288 -        (etac cont_lubcfun 1),
   2.289 -        (rtac (lub_fun RS is_lubE RS conjunct2 RS spec RS mp) 1),
   2.290 -        (etac (monofun_Rep_CFun1 RS ch2ch_monofun) 1),
   2.291 -        (etac (monofun_Rep_CFun1 RS ub2ub_monofun) 1)
   2.292 -        ]);
   2.293 +val prems = goal thy 
   2.294 +  "chain(CCF) ==> range(CCF) <<| (LAM x. lub(range(% i. CCF(i)`x)))";
   2.295 +by (cut_facts_tac prems 1);
   2.296 +by (rtac is_lubI 1);
   2.297 +by (rtac conjI 1);
   2.298 +by (rtac ub_rangeI 1);
   2.299 +by (rtac allI 1);
   2.300 +by (stac less_cfun 1);
   2.301 +by (stac Abs_Cfun_inverse2 1);
   2.302 +by (etac cont_lubcfun 1);
   2.303 +by (rtac (lub_fun RS is_lubE RS conjunct1 RS ub_rangeE RS spec) 1);
   2.304 +by (etac (monofun_Rep_CFun1 RS ch2ch_monofun) 1);
   2.305 +by (strip_tac 1);
   2.306 +by (stac less_cfun 1);
   2.307 +by (stac Abs_Cfun_inverse2 1);
   2.308 +by (etac cont_lubcfun 1);
   2.309 +by (rtac (lub_fun RS is_lubE RS conjunct2 RS spec RS mp) 1);
   2.310 +by (etac (monofun_Rep_CFun1 RS ch2ch_monofun) 1);
   2.311 +by (etac (monofun_Rep_CFun1 RS ub2ub_monofun) 1);
   2.312 +qed "lub_cfun";
   2.313  
   2.314  bind_thm ("thelub_cfun", lub_cfun RS thelubI);
   2.315  (* 
   2.316  chain(?CCF1) ==>  lub (range ?CCF1) = (LAM x. lub (range (%i. ?CCF1 i`x)))
   2.317  *)
   2.318  
   2.319 -qed_goal "cpo_cfun" thy 
   2.320 -  "chain(CCF::nat=>('a->'b)) ==> ? x. range(CCF) <<| x"
   2.321 -(fn prems =>
   2.322 -        [
   2.323 -        (cut_facts_tac prems 1),
   2.324 -        (rtac exI 1),
   2.325 -        (etac lub_cfun 1)
   2.326 -        ]);
   2.327 +val prems = goal thy 
   2.328 +  "chain(CCF::nat=>('a->'b)) ==> ? x. range(CCF) <<| x";
   2.329 +by (cut_facts_tac prems 1);
   2.330 +by (rtac exI 1);
   2.331 +by (etac lub_cfun 1);
   2.332 +qed "cpo_cfun";
   2.333  
   2.334  
   2.335  (* ------------------------------------------------------------------------ *)
   2.336  (* Extensionality in 'a -> 'b                                               *)
   2.337  (* ------------------------------------------------------------------------ *)
   2.338  
   2.339 -qed_goal "ext_cfun" Cfun1.thy "(!!x. f`x = g`x) ==> f = g"
   2.340 - (fn prems =>
   2.341 -        [
   2.342 -        (res_inst_tac [("t","f")] (Rep_Cfun_inverse RS subst) 1),
   2.343 -        (res_inst_tac [("t","g")] (Rep_Cfun_inverse RS subst) 1),
   2.344 -        (res_inst_tac [("f","Abs_CFun")] arg_cong 1),
   2.345 -        (rtac ext 1),
   2.346 -        (resolve_tac prems 1)
   2.347 -        ]);
   2.348 +val prems = goal Cfun1.thy "(!!x. f`x = g`x) ==> f = g";
   2.349 +by (res_inst_tac [("t","f")] (Rep_Cfun_inverse RS subst) 1);
   2.350 +by (res_inst_tac [("t","g")] (Rep_Cfun_inverse RS subst) 1);
   2.351 +by (res_inst_tac [("f","Abs_CFun")] arg_cong 1);
   2.352 +by (rtac ext 1);
   2.353 +by (resolve_tac prems 1);
   2.354 +qed "ext_cfun";
   2.355  
   2.356  (* ------------------------------------------------------------------------ *)
   2.357  (* Monotonicity of Abs_CFun                                                     *)
   2.358  (* ------------------------------------------------------------------------ *)
   2.359  
   2.360 -qed_goal "semi_monofun_Abs_CFun" thy 
   2.361 -        "[|cont(f);cont(g);f<<g|]==>Abs_CFun(f)<<Abs_CFun(g)"
   2.362 - (fn prems =>
   2.363 -        [
   2.364 -        (rtac (less_cfun RS iffD2) 1),
   2.365 -        (stac Abs_Cfun_inverse2 1),
   2.366 -        (resolve_tac prems 1),
   2.367 -        (stac Abs_Cfun_inverse2 1),
   2.368 -        (resolve_tac prems 1),
   2.369 -        (resolve_tac prems 1)
   2.370 -        ]);
   2.371 +val prems = goal thy 
   2.372 +        "[|cont(f);cont(g);f<<g|]==>Abs_CFun(f)<<Abs_CFun(g)";
   2.373 +by (rtac (less_cfun RS iffD2) 1);
   2.374 +by (stac Abs_Cfun_inverse2 1);
   2.375 +by (resolve_tac prems 1);
   2.376 +by (stac Abs_Cfun_inverse2 1);
   2.377 +by (resolve_tac prems 1);
   2.378 +by (resolve_tac prems 1);
   2.379 +qed "semi_monofun_Abs_CFun";
   2.380  
   2.381  (* ------------------------------------------------------------------------ *)
   2.382  (* Extenionality wrt. << in 'a -> 'b                                        *)
   2.383  (* ------------------------------------------------------------------------ *)
   2.384  
   2.385 -qed_goal "less_cfun2" thy "(!!x. f`x << g`x) ==> f << g"
   2.386 - (fn prems =>
   2.387 -        [
   2.388 -        (res_inst_tac [("t","f")] (Rep_Cfun_inverse RS subst) 1),
   2.389 -        (res_inst_tac [("t","g")] (Rep_Cfun_inverse RS subst) 1),
   2.390 -        (rtac semi_monofun_Abs_CFun 1),
   2.391 -        (rtac cont_Rep_CFun2 1),
   2.392 -        (rtac cont_Rep_CFun2 1),
   2.393 -        (rtac (less_fun RS iffD2) 1),
   2.394 -        (rtac allI 1),
   2.395 -        (resolve_tac prems 1)
   2.396 -        ]);
   2.397 +val prems = goal thy "(!!x. f`x << g`x) ==> f << g";
   2.398 +by (res_inst_tac [("t","f")] (Rep_Cfun_inverse RS subst) 1);
   2.399 +by (res_inst_tac [("t","g")] (Rep_Cfun_inverse RS subst) 1);
   2.400 +by (rtac semi_monofun_Abs_CFun 1);
   2.401 +by (rtac cont_Rep_CFun2 1);
   2.402 +by (rtac cont_Rep_CFun2 1);
   2.403 +by (rtac (less_fun RS iffD2) 1);
   2.404 +by (rtac allI 1);
   2.405 +by (resolve_tac prems 1);
   2.406 +qed "less_cfun2";
   2.407  
   2.408  
     3.1 --- a/src/HOLCF/Cfun3.ML	Tue Jul 04 14:58:40 2000 +0200
     3.2 +++ b/src/HOLCF/Cfun3.ML	Tue Jul 04 15:58:11 2000 +0200
     3.3 @@ -1,134 +1,111 @@
     3.4 -(*  Title:      HOLCF/cfun3.ML
     3.5 +(*  Title:      HOLCF/Cfun3
     3.6      ID:         $Id$
     3.7      Author:     Franz Regensburger
     3.8      Copyright   1993 Technische Universitaet Muenchen
     3.9 +
    3.10 +Class instance of  -> for class pcpo
    3.11  *)
    3.12  
    3.13 -open Cfun3;
    3.14 -
    3.15  (* for compatibility with old HOLCF-Version *)
    3.16 -qed_goal "inst_cfun_pcpo" thy "UU = Abs_CFun(%x. UU)"
    3.17 - (fn prems => 
    3.18 -        [
    3.19 -        (simp_tac (HOL_ss addsimps [UU_def,UU_cfun_def]) 1)
    3.20 -        ]);
    3.21 +val prems = goal thy "UU = Abs_CFun(%x. UU)";
    3.22 +by (simp_tac (HOL_ss addsimps [UU_def,UU_cfun_def]) 1);
    3.23 +qed "inst_cfun_pcpo";
    3.24  
    3.25  (* ------------------------------------------------------------------------ *)
    3.26  (* the contlub property for Rep_CFun its 'first' argument                       *)
    3.27  (* ------------------------------------------------------------------------ *)
    3.28  
    3.29 -qed_goal "contlub_Rep_CFun1" thy "contlub(Rep_CFun)"
    3.30 -(fn prems =>
    3.31 -        [
    3.32 -        (rtac contlubI 1),
    3.33 -        (strip_tac 1),
    3.34 -        (rtac (expand_fun_eq RS iffD2) 1),
    3.35 -        (strip_tac 1),
    3.36 -        (stac thelub_cfun 1),
    3.37 -        (atac 1),
    3.38 -        (stac Cfunapp2 1),
    3.39 -        (etac cont_lubcfun 1),
    3.40 -        (stac thelub_fun 1),
    3.41 -        (etac (monofun_Rep_CFun1 RS ch2ch_monofun) 1),
    3.42 -        (rtac refl 1)
    3.43 -        ]);
    3.44 +val prems = goal thy "contlub(Rep_CFun)";
    3.45 +by (rtac contlubI 1);
    3.46 +by (strip_tac 1);
    3.47 +by (rtac (expand_fun_eq RS iffD2) 1);
    3.48 +by (strip_tac 1);
    3.49 +by (stac thelub_cfun 1);
    3.50 +by (atac 1);
    3.51 +by (stac Cfunapp2 1);
    3.52 +by (etac cont_lubcfun 1);
    3.53 +by (stac thelub_fun 1);
    3.54 +by (etac (monofun_Rep_CFun1 RS ch2ch_monofun) 1);
    3.55 +by (rtac refl 1);
    3.56 +qed "contlub_Rep_CFun1";
    3.57  
    3.58  
    3.59  (* ------------------------------------------------------------------------ *)
    3.60  (* the cont property for Rep_CFun in its first argument                        *)
    3.61  (* ------------------------------------------------------------------------ *)
    3.62  
    3.63 -qed_goal "cont_Rep_CFun1" thy "cont(Rep_CFun)"
    3.64 -(fn prems =>
    3.65 -        [
    3.66 -        (rtac monocontlub2cont 1),
    3.67 -        (rtac monofun_Rep_CFun1 1),
    3.68 -        (rtac contlub_Rep_CFun1 1)
    3.69 -        ]);
    3.70 +val prems = goal thy "cont(Rep_CFun)";
    3.71 +by (rtac monocontlub2cont 1);
    3.72 +by (rtac monofun_Rep_CFun1 1);
    3.73 +by (rtac contlub_Rep_CFun1 1);
    3.74 +qed "cont_Rep_CFun1";
    3.75  
    3.76  
    3.77  (* ------------------------------------------------------------------------ *)
    3.78  (* contlub, cont properties of Rep_CFun in its first argument in mixfix _[_]   *)
    3.79  (* ------------------------------------------------------------------------ *)
    3.80  
    3.81 -qed_goal "contlub_cfun_fun" thy 
    3.82 +val prems = goal thy 
    3.83  "chain(FY) ==>\
    3.84 -\ lub(range FY)`x = lub(range (%i. FY(i)`x))"
    3.85 -(fn prems =>
    3.86 -        [
    3.87 -        (cut_facts_tac prems 1),
    3.88 -        (rtac trans 1),
    3.89 -        (etac (contlub_Rep_CFun1 RS contlubE RS spec RS mp RS fun_cong) 1),
    3.90 -        (stac thelub_fun 1),
    3.91 -        (etac (monofun_Rep_CFun1 RS ch2ch_monofun) 1),
    3.92 -        (rtac refl 1)
    3.93 -        ]);
    3.94 +\ lub(range FY)`x = lub(range (%i. FY(i)`x))";
    3.95 +by (cut_facts_tac prems 1);
    3.96 +by (rtac trans 1);
    3.97 +by (etac (contlub_Rep_CFun1 RS contlubE RS spec RS mp RS fun_cong) 1);
    3.98 +by (stac thelub_fun 1);
    3.99 +by (etac (monofun_Rep_CFun1 RS ch2ch_monofun) 1);
   3.100 +by (rtac refl 1);
   3.101 +qed "contlub_cfun_fun";
   3.102  
   3.103  
   3.104 -qed_goal "cont_cfun_fun" thy 
   3.105 +val prems = goal thy 
   3.106  "chain(FY) ==>\
   3.107 -\ range(%i. FY(i)`x) <<| lub(range FY)`x"
   3.108 -(fn prems =>
   3.109 -        [
   3.110 -        (cut_facts_tac prems 1),
   3.111 -        (rtac thelubE 1),
   3.112 -        (etac ch2ch_Rep_CFunL 1),
   3.113 -        (etac (contlub_cfun_fun RS sym) 1)
   3.114 -        ]);
   3.115 +\ range(%i. FY(i)`x) <<| lub(range FY)`x";
   3.116 +by (cut_facts_tac prems 1);
   3.117 +by (rtac thelubE 1);
   3.118 +by (etac ch2ch_Rep_CFunL 1);
   3.119 +by (etac (contlub_cfun_fun RS sym) 1);
   3.120 +qed "cont_cfun_fun";
   3.121  
   3.122  
   3.123  (* ------------------------------------------------------------------------ *)
   3.124  (* contlub, cont  properties of Rep_CFun in both argument in mixfix _[_]       *)
   3.125  (* ------------------------------------------------------------------------ *)
   3.126  
   3.127 -qed_goal "contlub_cfun" thy 
   3.128 +val prems = goal thy 
   3.129  "[|chain(FY);chain(TY)|] ==>\
   3.130 -\ (lub(range FY))`(lub(range TY)) = lub(range(%i. FY(i)`(TY i)))"
   3.131 -(fn prems =>
   3.132 -        [
   3.133 -        (cut_facts_tac prems 1),
   3.134 -        (rtac contlub_CF2 1),
   3.135 -        (rtac cont_Rep_CFun1 1),
   3.136 -        (rtac allI 1),
   3.137 -        (rtac cont_Rep_CFun2 1),
   3.138 -        (atac 1),
   3.139 -        (atac 1)
   3.140 -        ]);
   3.141 +\ (lub(range FY))`(lub(range TY)) = lub(range(%i. FY(i)`(TY i)))";
   3.142 +by (cut_facts_tac prems 1);
   3.143 +by (rtac contlub_CF2 1);
   3.144 +by (rtac cont_Rep_CFun1 1);
   3.145 +by (rtac allI 1);
   3.146 +by (rtac cont_Rep_CFun2 1);
   3.147 +by (atac 1);
   3.148 +by (atac 1);
   3.149 +qed "contlub_cfun";
   3.150  
   3.151 -qed_goal "cont_cfun" thy 
   3.152 +val prems = goal thy 
   3.153  "[|chain(FY);chain(TY)|] ==>\
   3.154 -\ range(%i.(FY i)`(TY i)) <<| (lub (range FY))`(lub(range TY))"
   3.155 -(fn prems =>
   3.156 -        [
   3.157 -        (cut_facts_tac prems 1),
   3.158 -        (rtac thelubE 1),
   3.159 -        (rtac (monofun_Rep_CFun1 RS ch2ch_MF2LR) 1),
   3.160 -        (rtac allI 1),
   3.161 -        (rtac monofun_Rep_CFun2 1),
   3.162 -        (atac 1),
   3.163 -        (atac 1),
   3.164 -        (etac (contlub_cfun RS sym) 1),
   3.165 -        (atac 1)
   3.166 -        ]);
   3.167 +\ range(%i.(FY i)`(TY i)) <<| (lub (range FY))`(lub(range TY))";
   3.168 +by (cut_facts_tac prems 1);
   3.169 +by (rtac thelubE 1);
   3.170 +by (rtac (monofun_Rep_CFun1 RS ch2ch_MF2LR) 1);
   3.171 +by (rtac allI 1);
   3.172 +by (rtac monofun_Rep_CFun2 1);
   3.173 +by (atac 1);
   3.174 +by (atac 1);
   3.175 +by (etac (contlub_cfun RS sym) 1);
   3.176 +by (atac 1);
   3.177 +qed "cont_cfun";
   3.178  
   3.179  
   3.180  (* ------------------------------------------------------------------------ *)
   3.181  (* cont2cont lemma for Rep_CFun                                               *)
   3.182  (* ------------------------------------------------------------------------ *)
   3.183  
   3.184 -qed_goal "cont2cont_Rep_CFun" thy 
   3.185 -        "[|cont(%x. ft x);cont(%x. tt x)|] ==> cont(%x. (ft x)`(tt x))"
   3.186 - (fn prems =>
   3.187 -        [
   3.188 -        (cut_facts_tac prems 1),
   3.189 -        (rtac cont2cont_app2 1),
   3.190 -        (rtac cont2cont_app2 1),
   3.191 -        (rtac cont_const 1),
   3.192 -        (rtac cont_Rep_CFun1 1),
   3.193 -        (atac 1),
   3.194 -        (rtac cont_Rep_CFun2 1),
   3.195 -        (atac 1)
   3.196 -        ]);
   3.197 +Goal "[|cont(%x. ft x);cont(%x. tt x)|] ==> cont(%x. (ft x)`(tt x))";
   3.198 +by (best_tac (claset() addIs [cont2cont_app2, cont_const, cont_Rep_CFun1,
   3.199 +	                      cont_Rep_CFun2]) 1);
   3.200 +qed "cont2cont_Rep_CFun";
   3.201  
   3.202  
   3.203  
   3.204 @@ -136,44 +113,40 @@
   3.205  (* cont2mono Lemma for %x. LAM y. c1(x)(y)                                  *)
   3.206  (* ------------------------------------------------------------------------ *)
   3.207  
   3.208 -qed_goal "cont2mono_LAM" thy 
   3.209 - "[| !!x. cont(c1 x); !!y. monofun(%x. c1 x y)|] ==> monofun(%x. LAM y. c1 x y)"
   3.210 -(fn [p1,p2] =>
   3.211 -        [
   3.212 -        (rtac monofunI 1),
   3.213 -        (strip_tac 1),
   3.214 -        (stac less_cfun 1),
   3.215 -        (stac less_fun 1),
   3.216 -        (rtac allI 1),
   3.217 -        (stac beta_cfun 1),
   3.218 -	(rtac p1 1),
   3.219 -        (stac beta_cfun 1),
   3.220 -	(rtac p1 1),
   3.221 -        (etac (p2 RS monofunE RS spec RS spec RS mp) 1)
   3.222 -        ]);
   3.223 +val [p1,p2] = goal thy 
   3.224 + "[| !!x. cont(c1 x); !!y. monofun(%x. c1 x y)|] ==> monofun(%x. LAM y. c1 x y)";
   3.225 +by (rtac monofunI 1);
   3.226 +by (strip_tac 1);
   3.227 +by (stac less_cfun 1);
   3.228 +by (stac less_fun 1);
   3.229 +by (rtac allI 1);
   3.230 +by (stac beta_cfun 1);
   3.231 +by (rtac p1 1);
   3.232 +by (stac beta_cfun 1);
   3.233 +by (rtac p1 1);
   3.234 +by (etac (p2 RS monofunE RS spec RS spec RS mp) 1);
   3.235 +qed "cont2mono_LAM";
   3.236  
   3.237  (* ------------------------------------------------------------------------ *)
   3.238  (* cont2cont Lemma for %x. LAM y. c1 x y)                                 *)
   3.239  (* ------------------------------------------------------------------------ *)
   3.240  
   3.241 -qed_goal "cont2cont_LAM" thy 
   3.242 - "[| !!x. cont(c1 x); !!y. cont(%x. c1 x y) |] ==> cont(%x. LAM y. c1 x y)"
   3.243 -(fn [p1,p2] =>
   3.244 -        [
   3.245 -        (rtac monocontlub2cont 1),
   3.246 -        (rtac (p1 RS cont2mono_LAM) 1),
   3.247 -        (rtac (p2 RS cont2mono) 1),
   3.248 -        (rtac contlubI 1),
   3.249 -        (strip_tac 1),
   3.250 -        (stac thelub_cfun 1),
   3.251 -        (rtac (p1 RS cont2mono_LAM RS ch2ch_monofun) 1),
   3.252 -        (rtac (p2 RS cont2mono) 1),
   3.253 -        (atac 1),
   3.254 -        (res_inst_tac [("f","Abs_CFun")] arg_cong 1),
   3.255 -        (rtac ext 1),
   3.256 -        (stac (p1 RS beta_cfun RS ext) 1),
   3.257 -        (etac (p2 RS cont2contlub RS contlubE RS spec RS mp) 1)
   3.258 -        ]);
   3.259 +val [p1,p2] = goal thy 
   3.260 + "[| !!x. cont(c1 x); !!y. cont(%x. c1 x y) |] ==> cont(%x. LAM y. c1 x y)";
   3.261 +by (rtac monocontlub2cont 1);
   3.262 +by (rtac (p1 RS cont2mono_LAM) 1);
   3.263 +by (rtac (p2 RS cont2mono) 1);
   3.264 +by (rtac contlubI 1);
   3.265 +by (strip_tac 1);
   3.266 +by (stac thelub_cfun 1);
   3.267 +by (rtac (p1 RS cont2mono_LAM RS ch2ch_monofun) 1);
   3.268 +by (rtac (p2 RS cont2mono) 1);
   3.269 +by (atac 1);
   3.270 +by (res_inst_tac [("f","Abs_CFun")] arg_cong 1);
   3.271 +by (rtac ext 1);
   3.272 +by (stac (p1 RS beta_cfun RS ext) 1);
   3.273 +by (etac (p2 RS cont2contlub RS contlubE RS spec RS mp) 1);
   3.274 +qed "cont2cont_LAM";
   3.275  
   3.276  (* ------------------------------------------------------------------------ *)
   3.277  (* cont2cont tactic                                                       *)
   3.278 @@ -193,141 +166,107 @@
   3.279  (* function application _[_]  is strict in its first arguments              *)
   3.280  (* ------------------------------------------------------------------------ *)
   3.281  
   3.282 -qed_goal "strict_Rep_CFun1" thy "(UU::'a::cpo->'b)`x = (UU::'b)"
   3.283 - (fn prems =>
   3.284 -        [
   3.285 -        (stac inst_cfun_pcpo 1),
   3.286 -        (stac beta_cfun 1),
   3.287 -        (Simp_tac 1),
   3.288 -        (rtac refl 1)
   3.289 -        ]);
   3.290 +val prems = goal thy "(UU::'a::cpo->'b)`x = (UU::'b)";
   3.291 +by (stac inst_cfun_pcpo 1);
   3.292 +by (stac beta_cfun 1);
   3.293 +by (Simp_tac 1);
   3.294 +by (rtac refl 1);
   3.295 +qed "strict_Rep_CFun1";
   3.296  
   3.297  
   3.298  (* ------------------------------------------------------------------------ *)
   3.299  (* results about strictify                                                  *)
   3.300  (* ------------------------------------------------------------------------ *)
   3.301  
   3.302 -qed_goalw "Istrictify1" thy [Istrictify_def]
   3.303 -        "Istrictify(f)(UU)= (UU)"
   3.304 - (fn prems =>
   3.305 -        [
   3.306 -        (Simp_tac 1)
   3.307 -        ]);
   3.308 +val prems = goalw thy [Istrictify_def]
   3.309 +        "Istrictify(f)(UU)= (UU)";
   3.310 +by (Simp_tac 1);
   3.311 +qed "Istrictify1";
   3.312  
   3.313 -qed_goalw "Istrictify2" thy [Istrictify_def]
   3.314 -        "~x=UU ==> Istrictify(f)(x)=f`x"
   3.315 - (fn prems =>
   3.316 -        [
   3.317 -        (cut_facts_tac prems 1),
   3.318 -        (Asm_simp_tac 1)
   3.319 -        ]);
   3.320 +val prems = goalw thy [Istrictify_def]
   3.321 +        "~x=UU ==> Istrictify(f)(x)=f`x";
   3.322 +by (cut_facts_tac prems 1);
   3.323 +by (Asm_simp_tac 1);
   3.324 +qed "Istrictify2";
   3.325  
   3.326 -qed_goal "monofun_Istrictify1" thy "monofun(Istrictify)"
   3.327 - (fn prems =>
   3.328 -        [
   3.329 -        (rtac monofunI 1),
   3.330 -        (strip_tac 1),
   3.331 -        (rtac (less_fun RS iffD2) 1),
   3.332 -        (strip_tac 1),
   3.333 -        (res_inst_tac [("Q","xa=UU")] (excluded_middle RS disjE) 1),
   3.334 -        (stac Istrictify2 1),
   3.335 -        (atac 1),
   3.336 -        (stac Istrictify2 1),
   3.337 -        (atac 1),
   3.338 -        (rtac monofun_cfun_fun 1),
   3.339 -        (atac 1),
   3.340 -        (hyp_subst_tac 1),
   3.341 -        (stac Istrictify1 1),
   3.342 -        (stac Istrictify1 1),
   3.343 -        (rtac refl_less 1)
   3.344 -        ]);
   3.345 +val prems = goal thy "monofun(Istrictify)";
   3.346 +by (rtac monofunI 1);
   3.347 +by (strip_tac 1);
   3.348 +by (rtac (less_fun RS iffD2) 1);
   3.349 +by (strip_tac 1);
   3.350 +by (res_inst_tac [("Q","xa=UU")] (excluded_middle RS disjE) 1);
   3.351 +by (stac Istrictify2 1);
   3.352 +by (atac 1);
   3.353 +by (stac Istrictify2 1);
   3.354 +by (atac 1);
   3.355 +by (rtac monofun_cfun_fun 1);
   3.356 +by (atac 1);
   3.357 +by (hyp_subst_tac 1);
   3.358 +by (stac Istrictify1 1);
   3.359 +by (stac Istrictify1 1);
   3.360 +by (rtac refl_less 1);
   3.361 +qed "monofun_Istrictify1";
   3.362  
   3.363 -qed_goal "monofun_Istrictify2" thy "monofun(Istrictify(f))"
   3.364 - (fn prems =>
   3.365 -        [
   3.366 -        (rtac monofunI 1),
   3.367 -        (strip_tac 1),
   3.368 -        (res_inst_tac [("Q","x=UU")] (excluded_middle RS disjE) 1),
   3.369 -        (stac Istrictify2 1),
   3.370 -        (etac notUU_I 1),
   3.371 -        (atac 1),
   3.372 -        (stac Istrictify2 1),
   3.373 -        (atac 1),
   3.374 -        (rtac monofun_cfun_arg 1),
   3.375 -        (atac 1),
   3.376 -        (hyp_subst_tac 1),
   3.377 -        (stac Istrictify1 1),
   3.378 -        (rtac minimal 1)
   3.379 -        ]);
   3.380 +val prems = goal thy "monofun(Istrictify(f))";
   3.381 +by (rtac monofunI 1);
   3.382 +by (strip_tac 1);
   3.383 +by (res_inst_tac [("Q","x=UU")] (excluded_middle RS disjE) 1);
   3.384 +by (stac Istrictify2 1);
   3.385 +by (etac notUU_I 1);
   3.386 +by (atac 1);
   3.387 +by (stac Istrictify2 1);
   3.388 +by (atac 1);
   3.389 +by (rtac monofun_cfun_arg 1);
   3.390 +by (atac 1);
   3.391 +by (hyp_subst_tac 1);
   3.392 +by (stac Istrictify1 1);
   3.393 +by (rtac minimal 1);
   3.394 +qed "monofun_Istrictify2";
   3.395  
   3.396  
   3.397 -qed_goal "contlub_Istrictify1" thy "contlub(Istrictify)"
   3.398 - (fn prems =>
   3.399 -        [
   3.400 -        (rtac contlubI 1),
   3.401 -        (strip_tac 1),
   3.402 -        (rtac (expand_fun_eq RS iffD2) 1),
   3.403 -        (strip_tac 1),
   3.404 -        (stac thelub_fun 1),
   3.405 -        (etac (monofun_Istrictify1 RS ch2ch_monofun) 1),
   3.406 -        (res_inst_tac [("Q","x=UU")] (excluded_middle RS disjE) 1),
   3.407 -        (stac Istrictify2 1),
   3.408 -        (atac 1),
   3.409 -        (stac (Istrictify2 RS ext) 1),
   3.410 -        (atac 1),
   3.411 -        (stac thelub_cfun 1),
   3.412 -        (atac 1),
   3.413 -        (stac beta_cfun 1),
   3.414 -        (rtac cont_lubcfun 1),
   3.415 -        (atac 1),
   3.416 -        (rtac refl 1),
   3.417 -        (hyp_subst_tac 1),
   3.418 -        (stac Istrictify1 1),
   3.419 -        (stac (Istrictify1 RS ext) 1),
   3.420 -        (rtac (chain_UU_I_inverse RS sym) 1),
   3.421 -        (rtac (refl RS allI) 1)
   3.422 -        ]);
   3.423 +val prems = goal thy "contlub(Istrictify)";
   3.424 +by (rtac contlubI 1);
   3.425 +by (strip_tac 1);
   3.426 +by (rtac (expand_fun_eq RS iffD2) 1);
   3.427 +by (strip_tac 1);
   3.428 +by (stac thelub_fun 1);
   3.429 +by (etac (monofun_Istrictify1 RS ch2ch_monofun) 1);
   3.430 +by (res_inst_tac [("Q","x=UU")] (excluded_middle RS disjE) 1);
   3.431 +by (stac Istrictify2 1);
   3.432 +by (atac 1);
   3.433 +by (stac (Istrictify2 RS ext) 1);
   3.434 +by (atac 1);
   3.435 +by (stac thelub_cfun 1);
   3.436 +by (atac 1);
   3.437 +by (stac beta_cfun 1);
   3.438 +by (rtac cont_lubcfun 1);
   3.439 +by (atac 1);
   3.440 +by (rtac refl 1);
   3.441 +by (hyp_subst_tac 1);
   3.442 +by (stac Istrictify1 1);
   3.443 +by (stac (Istrictify1 RS ext) 1);
   3.444 +by (rtac (chain_UU_I_inverse RS sym) 1);
   3.445 +by (rtac (refl RS allI) 1);
   3.446 +qed "contlub_Istrictify1";
   3.447  
   3.448 -qed_goal "contlub_Istrictify2" thy "contlub(Istrictify(f::'a -> 'b))"
   3.449 - (fn prems =>
   3.450 -        [
   3.451 -        (rtac contlubI 1),
   3.452 -        (strip_tac 1),
   3.453 -        (case_tac "lub(range(Y))=(UU::'a)" 1),
   3.454 -        (res_inst_tac [("t","lub(range(Y))")] subst 1),
   3.455 -        (rtac sym 1),
   3.456 -        (atac 1),
   3.457 -        (stac Istrictify1 1),
   3.458 -        (rtac sym 1),
   3.459 -        (rtac chain_UU_I_inverse 1),
   3.460 -        (strip_tac 1),
   3.461 -        (res_inst_tac [("t","Y(i)"),("s","UU::'a")] subst 1),
   3.462 -        (rtac sym 1),
   3.463 -        (rtac (chain_UU_I RS spec) 1),
   3.464 -        (atac 1),
   3.465 -        (atac 1),
   3.466 -        (rtac Istrictify1 1),
   3.467 -        (stac Istrictify2 1),
   3.468 -        (atac 1),
   3.469 -        (res_inst_tac [("s","lub(range(%i. f`(Y i)))")] trans 1),
   3.470 -        (rtac contlub_cfun_arg 1),
   3.471 -        (atac 1),
   3.472 -        (rtac lub_equal2 1),
   3.473 -        (rtac (chain_mono2 RS exE) 1),
   3.474 -        (atac 2),
   3.475 -        (rtac chain_UU_I_inverse2 1),
   3.476 -        (atac 1),
   3.477 -        (rtac exI 1),
   3.478 -        (strip_tac 1),
   3.479 -        (rtac (Istrictify2 RS sym) 1),
   3.480 -        (fast_tac HOL_cs 1),
   3.481 -        (rtac ch2ch_monofun 1),
   3.482 -        (rtac monofun_Rep_CFun2 1),
   3.483 -        (atac 1),
   3.484 -        (rtac ch2ch_monofun 1),
   3.485 -        (rtac monofun_Istrictify2 1),
   3.486 -        (atac 1)
   3.487 -        ]);
   3.488 +Goal "contlub(Istrictify(f::'a -> 'b))";
   3.489 +by (rtac contlubI 1);
   3.490 +by (strip_tac 1);
   3.491 +by (case_tac "lub(range(Y))=(UU::'a)" 1);
   3.492 +by (asm_simp_tac (simpset() addsimps [Istrictify1, chain_UU_I_inverse, chain_UU_I, Istrictify1]) 1);
   3.493 +by (stac Istrictify2 1);
   3.494 +by (atac 1);
   3.495 +by (res_inst_tac [("s","lub(range(%i. f`(Y i)))")] trans 1);
   3.496 +by (rtac contlub_cfun_arg 1);
   3.497 +by (atac 1);
   3.498 +by (rtac lub_equal2 1);
   3.499 +by (best_tac (claset() addIs [ch2ch_monofun, monofun_Istrictify2]) 3);
   3.500 +by (best_tac (claset() addIs [ch2ch_monofun, monofun_Rep_CFun2]) 2);
   3.501 +by (rtac (chain_mono2 RS exE) 1);
   3.502 +by (atac 2);
   3.503 +by (etac chain_UU_I_inverse2 1);
   3.504 +by (blast_tac (claset() addIs [Istrictify2 RS sym]) 1);
   3.505 +qed "contlub_Istrictify2";
   3.506  
   3.507  
   3.508  bind_thm ("cont_Istrictify1", contlub_Istrictify1 RS 
   3.509 @@ -337,25 +276,23 @@
   3.510          (monofun_Istrictify2 RS monocontlub2cont)); 
   3.511  
   3.512  
   3.513 -qed_goalw "strictify1" thy [strictify_def] "strictify`f`UU=UU" (fn _ => [
   3.514 -        (stac beta_cfun 1),
   3.515 -         (simp_tac (simpset() addsimps [cont_Istrictify2,cont_Istrictify1,
   3.516 -					cont2cont_CF1L]) 1),
   3.517 -        (stac beta_cfun 1),
   3.518 -        (rtac cont_Istrictify2 1),
   3.519 -        (rtac Istrictify1 1)
   3.520 -        ]);
   3.521 +val _ = goalw thy [strictify_def] "strictify`f`UU=UU";
   3.522 +by (stac beta_cfun 1);
   3.523 +by (simp_tac (simpset() addsimps [cont_Istrictify2,cont_Istrictify1, cont2cont_CF1L]) 1);
   3.524 +by (stac beta_cfun 1);
   3.525 +by (rtac cont_Istrictify2 1);
   3.526 +by (rtac Istrictify1 1);
   3.527 +qed "strictify1";
   3.528  
   3.529 -qed_goalw "strictify2" thy [strictify_def]
   3.530 -        "~x=UU ==> strictify`f`x=f`x"  (fn prems => [
   3.531 -        (stac beta_cfun 1),
   3.532 -         (simp_tac (simpset() addsimps [cont_Istrictify2,cont_Istrictify1,
   3.533 -					cont2cont_CF1L]) 1),
   3.534 -        (stac beta_cfun 1),
   3.535 -        (rtac cont_Istrictify2 1),
   3.536 -        (rtac Istrictify2 1),
   3.537 -        (resolve_tac prems 1)
   3.538 -        ]);
   3.539 +val prems = goalw thy [strictify_def]
   3.540 +        "~x=UU ==> strictify`f`x=f`x";
   3.541 +by (stac beta_cfun 1);
   3.542 +by (simp_tac (simpset() addsimps [cont_Istrictify2,cont_Istrictify1, cont2cont_CF1L]) 1);
   3.543 +by (stac beta_cfun 1);
   3.544 +by (rtac cont_Istrictify2 1);
   3.545 +by (rtac Istrictify2 1);
   3.546 +by (resolve_tac prems 1);
   3.547 +qed "strictify2";
   3.548  
   3.549  
   3.550  (* ------------------------------------------------------------------------ *)
   3.551 @@ -376,149 +313,134 @@
   3.552  (* some lemmata for functions with flat/chfin domain/range types	    *)
   3.553  (* ------------------------------------------------------------------------ *)
   3.554  
   3.555 -qed_goal "chfin_Rep_CFunR" thy 
   3.556 -    "chain (Y::nat => 'a::cpo->'b::chfin)==> !s. ? n. lub(range(Y))`s = Y n`s" 
   3.557 -(fn prems => 
   3.558 -	[
   3.559 -	cut_facts_tac prems 1,
   3.560 -	rtac allI 1,
   3.561 -	stac contlub_cfun_fun 1,
   3.562 -	 atac 1,
   3.563 -	fast_tac (HOL_cs addSIs [thelubI,chfin,lub_finch2,chfin2finch,ch2ch_Rep_CFunL])1
   3.564 -	]);
   3.565 +Goal "chain (Y::nat => 'a::cpo->'b::chfin) \
   3.566 +\     ==> !s. ? n. lub(range(Y))`s = Y n`s";
   3.567 +by (rtac allI 1);
   3.568 +by (stac contlub_cfun_fun 1);
   3.569 +by (atac 1);
   3.570 +by (fast_tac (HOL_cs addSIs [thelubI,chfin,lub_finch2,chfin2finch,ch2ch_Rep_CFunL])1);
   3.571 +qed "chfin_Rep_CFunR";
   3.572  
   3.573  (* ------------------------------------------------------------------------ *)
   3.574  (* continuous isomorphisms are strict                                       *)
   3.575  (* a prove for embedding projection pairs is similar                        *)
   3.576  (* ------------------------------------------------------------------------ *)
   3.577  
   3.578 -qed_goal "iso_strict"  thy  
   3.579 +val prems = goal  thy  
   3.580  "!!f g.[|!y. f`(g`y)=(y::'b) ; !x. g`(f`x)=(x::'a) |] \
   3.581 -\ ==> f`UU=UU & g`UU=UU"
   3.582 - (fn prems =>
   3.583 -        [
   3.584 -        (rtac conjI 1),
   3.585 -        (rtac UU_I 1),
   3.586 -        (res_inst_tac [("s","f`(g`(UU::'b))"),("t","UU::'b")] subst 1),
   3.587 -        (etac spec 1),
   3.588 -        (rtac (minimal RS monofun_cfun_arg) 1),
   3.589 -        (rtac UU_I 1),
   3.590 -        (res_inst_tac [("s","g`(f`(UU::'a))"),("t","UU::'a")] subst 1),
   3.591 -        (etac spec 1),
   3.592 -        (rtac (minimal RS monofun_cfun_arg) 1)
   3.593 -        ]);
   3.594 +\ ==> f`UU=UU & g`UU=UU";
   3.595 +by (rtac conjI 1);
   3.596 +by (rtac UU_I 1);
   3.597 +by (res_inst_tac [("s","f`(g`(UU::'b))"),("t","UU::'b")] subst 1);
   3.598 +by (etac spec 1);
   3.599 +by (rtac (minimal RS monofun_cfun_arg) 1);
   3.600 +by (rtac UU_I 1);
   3.601 +by (res_inst_tac [("s","g`(f`(UU::'a))"),("t","UU::'a")] subst 1);
   3.602 +by (etac spec 1);
   3.603 +by (rtac (minimal RS monofun_cfun_arg) 1);
   3.604 +qed "iso_strict";
   3.605  
   3.606  
   3.607 -qed_goal "isorep_defined" thy 
   3.608 -        "[|!x. rep`(ab`x)=x;!y. ab`(rep`y)=y; z~=UU|] ==> rep`z ~= UU"
   3.609 - (fn prems =>
   3.610 -        [
   3.611 -        (cut_facts_tac prems 1),
   3.612 -        (etac swap 1),
   3.613 -        (dtac notnotD 1),
   3.614 -        (dres_inst_tac [("f","ab")] cfun_arg_cong 1),
   3.615 -        (etac box_equals 1),
   3.616 -        (fast_tac HOL_cs 1),
   3.617 -        (etac (iso_strict RS conjunct1) 1),
   3.618 -        (atac 1)
   3.619 -        ]);
   3.620 +val prems = goal thy 
   3.621 +        "[|!x. rep`(ab`x)=x;!y. ab`(rep`y)=y; z~=UU|] ==> rep`z ~= UU";
   3.622 +by (cut_facts_tac prems 1);
   3.623 +by (etac swap 1);
   3.624 +by (dtac notnotD 1);
   3.625 +by (dres_inst_tac [("f","ab")] cfun_arg_cong 1);
   3.626 +by (etac box_equals 1);
   3.627 +by (fast_tac HOL_cs 1);
   3.628 +by (etac (iso_strict RS conjunct1) 1);
   3.629 +by (atac 1);
   3.630 +qed "isorep_defined";
   3.631  
   3.632 -qed_goal "isoabs_defined" thy 
   3.633 -        "[|!x. rep`(ab`x) = x;!y. ab`(rep`y)=y ; z~=UU|] ==> ab`z ~= UU"
   3.634 - (fn prems =>
   3.635 -        [
   3.636 -        (cut_facts_tac prems 1),
   3.637 -        (etac swap 1),
   3.638 -        (dtac notnotD 1),
   3.639 -        (dres_inst_tac [("f","rep")] cfun_arg_cong 1),
   3.640 -        (etac box_equals 1),
   3.641 -        (fast_tac HOL_cs 1),
   3.642 -        (etac (iso_strict RS conjunct2) 1),
   3.643 -        (atac 1)
   3.644 -        ]);
   3.645 +val prems = goal thy 
   3.646 +        "[|!x. rep`(ab`x) = x;!y. ab`(rep`y)=y ; z~=UU|] ==> ab`z ~= UU";
   3.647 +by (cut_facts_tac prems 1);
   3.648 +by (etac swap 1);
   3.649 +by (dtac notnotD 1);
   3.650 +by (dres_inst_tac [("f","rep")] cfun_arg_cong 1);
   3.651 +by (etac box_equals 1);
   3.652 +by (fast_tac HOL_cs 1);
   3.653 +by (etac (iso_strict RS conjunct2) 1);
   3.654 +by (atac 1);
   3.655 +qed "isoabs_defined";
   3.656  
   3.657  (* ------------------------------------------------------------------------ *)
   3.658  (* propagation of flatness and chainfiniteness by continuous isomorphisms   *)
   3.659  (* ------------------------------------------------------------------------ *)
   3.660  
   3.661 -qed_goal "chfin2chfin" thy "!!f g.[|! Y::nat=>'a. chain Y --> (? n. max_in_chain n Y); \
   3.662 +val prems = goal thy "!!f g.[|! Y::nat=>'a. chain Y --> (? n. max_in_chain n Y); \
   3.663  \ !y. f`(g`y)=(y::'b) ; !x. g`(f`x)=(x::'a::chfin) |] \
   3.664 -\ ==> ! Y::nat=>'b. chain Y --> (? n. max_in_chain n Y)"
   3.665 - (fn prems =>
   3.666 -        [
   3.667 -        (rewtac max_in_chain_def),
   3.668 -        (strip_tac 1),
   3.669 -        (rtac exE 1),
   3.670 -        (res_inst_tac [("P","chain(%i. g`(Y i))")] mp 1),
   3.671 -        (etac spec 1),
   3.672 -        (etac ch2ch_Rep_CFunR 1),
   3.673 -        (rtac exI 1),
   3.674 -        (strip_tac 1),
   3.675 -        (res_inst_tac [("s","f`(g`(Y x))"),("t","Y(x)")] subst 1),
   3.676 -        (etac spec 1),
   3.677 -        (res_inst_tac [("s","f`(g`(Y j))"),("t","Y(j)")] subst 1),
   3.678 -        (etac spec 1),
   3.679 -        (rtac cfun_arg_cong 1),
   3.680 -        (rtac mp 1),
   3.681 -        (etac spec 1),
   3.682 -        (atac 1)
   3.683 -        ]);
   3.684 +\ ==> ! Y::nat=>'b. chain Y --> (? n. max_in_chain n Y)";
   3.685 +by (rewtac max_in_chain_def);
   3.686 +by (strip_tac 1);
   3.687 +by (rtac exE 1);
   3.688 +by (res_inst_tac [("P","chain(%i. g`(Y i))")] mp 1);
   3.689 +by (etac spec 1);
   3.690 +by (etac ch2ch_Rep_CFunR 1);
   3.691 +by (rtac exI 1);
   3.692 +by (strip_tac 1);
   3.693 +by (res_inst_tac [("s","f`(g`(Y x))"),("t","Y(x)")] subst 1);
   3.694 +by (etac spec 1);
   3.695 +by (res_inst_tac [("s","f`(g`(Y j))"),("t","Y(j)")] subst 1);
   3.696 +by (etac spec 1);
   3.697 +by (rtac cfun_arg_cong 1);
   3.698 +by (rtac mp 1);
   3.699 +by (etac spec 1);
   3.700 +by (atac 1);
   3.701 +qed "chfin2chfin";
   3.702  
   3.703  
   3.704 -qed_goal "flat2flat" thy "!!f g.[|!x y::'a. x<<y --> x=UU | x=y; \
   3.705 -\ !y. f`(g`y)=(y::'b); !x. g`(f`x)=(x::'a)|] ==> !x y::'b. x<<y --> x=UU | x=y"
   3.706 - (fn prems =>
   3.707 -        [
   3.708 -        (strip_tac 1),
   3.709 -        (rtac disjE 1),
   3.710 -        (res_inst_tac [("P","g`x<<g`y")] mp 1),
   3.711 -        (etac monofun_cfun_arg 2),
   3.712 -        (dtac spec 1),
   3.713 -        (etac spec 1),
   3.714 -        (rtac disjI1 1),
   3.715 -        (rtac trans 1),
   3.716 -        (res_inst_tac [("s","f`(g`x)"),("t","x")] subst 1),
   3.717 -        (etac spec 1),
   3.718 -        (etac cfun_arg_cong 1),
   3.719 -        (rtac (iso_strict RS conjunct1) 1),
   3.720 -        (atac 1),
   3.721 -        (atac 1),
   3.722 -        (rtac disjI2 1),
   3.723 -        (res_inst_tac [("s","f`(g`x)"),("t","x")] subst 1),
   3.724 -        (etac spec 1),
   3.725 -        (res_inst_tac [("s","f`(g`y)"),("t","y")] subst 1),
   3.726 -        (etac spec 1),
   3.727 -        (etac cfun_arg_cong 1)
   3.728 -        ]);
   3.729 +val prems = goal thy "!!f g.[|!x y::'a. x<<y --> x=UU | x=y; \
   3.730 +\ !y. f`(g`y)=(y::'b); !x. g`(f`x)=(x::'a)|] ==> !x y::'b. x<<y --> x=UU | x=y";
   3.731 +by (strip_tac 1);
   3.732 +by (rtac disjE 1);
   3.733 +by (res_inst_tac [("P","g`x<<g`y")] mp 1);
   3.734 +by (etac monofun_cfun_arg 2);
   3.735 +by (dtac spec 1);
   3.736 +by (etac spec 1);
   3.737 +by (rtac disjI1 1);
   3.738 +by (rtac trans 1);
   3.739 +by (res_inst_tac [("s","f`(g`x)"),("t","x")] subst 1);
   3.740 +by (etac spec 1);
   3.741 +by (etac cfun_arg_cong 1);
   3.742 +by (rtac (iso_strict RS conjunct1) 1);
   3.743 +by (atac 1);
   3.744 +by (atac 1);
   3.745 +by (rtac disjI2 1);
   3.746 +by (res_inst_tac [("s","f`(g`x)"),("t","x")] subst 1);
   3.747 +by (etac spec 1);
   3.748 +by (res_inst_tac [("s","f`(g`y)"),("t","y")] subst 1);
   3.749 +by (etac spec 1);
   3.750 +by (etac cfun_arg_cong 1);
   3.751 +qed "flat2flat";
   3.752  
   3.753  (* ------------------------------------------------------------------------- *)
   3.754  (* a result about functions with flat codomain                               *)
   3.755  (* ------------------------------------------------------------------------- *)
   3.756  
   3.757 -qed_goal "flat_codom" thy 
   3.758 -"f`(x::'a)=(c::'b::flat) ==> f`(UU::'a)=(UU::'b) | (!z. f`(z::'a)=c)"
   3.759 - (fn prems =>
   3.760 -        [
   3.761 -        (cut_facts_tac prems 1),
   3.762 -        (case_tac "f`(x::'a)=(UU::'b)" 1),
   3.763 -        (rtac disjI1 1),
   3.764 -        (rtac UU_I 1),
   3.765 -        (res_inst_tac [("s","f`(x)"),("t","UU::'b")] subst 1),
   3.766 -        (atac 1),
   3.767 -        (rtac (minimal RS monofun_cfun_arg) 1),
   3.768 -        (case_tac "f`(UU::'a)=(UU::'b)" 1),
   3.769 -        (etac disjI1 1),
   3.770 -        (rtac disjI2 1),
   3.771 -        (rtac allI 1),
   3.772 -        (hyp_subst_tac 1),
   3.773 -        (res_inst_tac [("a","f`(UU::'a)")] (refl RS box_equals) 1),
   3.774 -        (res_inst_tac [("fo5","f")] ((minimal RS monofun_cfun_arg) RS 
   3.775 -		(ax_flat RS spec RS spec RS mp) RS disjE) 1),
   3.776 -	(contr_tac 1),(atac 1),
   3.777 -        (res_inst_tac [("fo5","f")] ((minimal RS monofun_cfun_arg) RS 
   3.778 -		(ax_flat RS spec RS spec RS mp) RS disjE) 1),
   3.779 -	(contr_tac 1),(atac 1)
   3.780 -]);
   3.781 +val prems = goal thy 
   3.782 +"f`(x::'a)=(c::'b::flat) ==> f`(UU::'a)=(UU::'b) | (!z. f`(z::'a)=c)";
   3.783 +by (cut_facts_tac prems 1);
   3.784 +by (case_tac "f`(x::'a)=(UU::'b)" 1);
   3.785 +by (rtac disjI1 1);
   3.786 +by (rtac UU_I 1);
   3.787 +by (res_inst_tac [("s","f`(x)"),("t","UU::'b")] subst 1);
   3.788 +by (atac 1);
   3.789 +by (rtac (minimal RS monofun_cfun_arg) 1);
   3.790 +by (case_tac "f`(UU::'a)=(UU::'b)" 1);
   3.791 +by (etac disjI1 1);
   3.792 +by (rtac disjI2 1);
   3.793 +by (rtac allI 1);
   3.794 +by (hyp_subst_tac 1);
   3.795 +by (res_inst_tac [("a","f`(UU::'a)")] (refl RS box_equals) 1);
   3.796 +by (res_inst_tac [("fo5","f")] ((minimal RS monofun_cfun_arg) RS (ax_flat RS spec RS spec RS mp) RS disjE) 1);
   3.797 +by (contr_tac 1);
   3.798 +by (atac 1);
   3.799 +by (res_inst_tac [("fo5","f")] ((minimal RS monofun_cfun_arg) RS (ax_flat RS spec RS spec RS mp) RS disjE) 1);
   3.800 +by (contr_tac 1);
   3.801 +by (atac 1);
   3.802 +qed "flat_codom";
   3.803  
   3.804  
   3.805  (* ------------------------------------------------------------------------ *)
   3.806 @@ -526,28 +448,26 @@
   3.807  (* ------------------------------------------------------------------------ *)
   3.808  
   3.809  
   3.810 -qed_goalw "ID1" thy [ID_def] "ID`x=x"
   3.811 - (fn prems =>
   3.812 -        [
   3.813 -        (stac beta_cfun 1),
   3.814 -        (rtac cont_id 1),
   3.815 -        (rtac refl 1)
   3.816 -        ]);
   3.817 +val prems = goalw thy [ID_def] "ID`x=x";
   3.818 +by (stac beta_cfun 1);
   3.819 +by (rtac cont_id 1);
   3.820 +by (rtac refl 1);
   3.821 +qed "ID1";
   3.822  
   3.823 -qed_goalw "cfcomp1" thy [oo_def] "(f oo g)=(LAM x. f`(g`x))" (fn _ => [
   3.824 -        (stac beta_cfun 1),
   3.825 -        (Simp_tac 1),
   3.826 -        (stac beta_cfun 1),
   3.827 -        (Simp_tac 1),
   3.828 -	(rtac refl 1)
   3.829 -        ]);
   3.830 +val _ = goalw thy [oo_def] "(f oo g)=(LAM x. f`(g`x))";
   3.831 +by (stac beta_cfun 1);
   3.832 +by (Simp_tac 1);
   3.833 +by (stac beta_cfun 1);
   3.834 +by (Simp_tac 1);
   3.835 +by (rtac refl 1);
   3.836 +qed "cfcomp1";
   3.837  
   3.838 -qed_goal "cfcomp2" thy  "(f oo g)`x=f`(g`x)" (fn _ => [
   3.839 -        (stac cfcomp1 1),
   3.840 -        (stac beta_cfun 1),
   3.841 -        (Simp_tac 1),
   3.842 -	(rtac refl 1)
   3.843 -        ]);
   3.844 +val _ = goal thy  "(f oo g)`x=f`(g`x)";
   3.845 +by (stac cfcomp1 1);
   3.846 +by (stac beta_cfun 1);
   3.847 +by (Simp_tac 1);
   3.848 +by (rtac refl 1);
   3.849 +qed "cfcomp2";
   3.850  
   3.851  
   3.852  (* ------------------------------------------------------------------------ *)
   3.853 @@ -559,37 +479,31 @@
   3.854  (* ------------------------------------------------------------------------ *)
   3.855  
   3.856  
   3.857 -qed_goal "ID2" thy "f oo ID = f "
   3.858 - (fn prems =>
   3.859 -        [
   3.860 -        (rtac ext_cfun 1),
   3.861 -        (stac cfcomp2 1),
   3.862 -        (stac ID1 1),
   3.863 -        (rtac refl 1)
   3.864 -        ]);
   3.865 +val prems = goal thy "f oo ID = f ";
   3.866 +by (rtac ext_cfun 1);
   3.867 +by (stac cfcomp2 1);
   3.868 +by (stac ID1 1);
   3.869 +by (rtac refl 1);
   3.870 +qed "ID2";
   3.871  
   3.872 -qed_goal "ID3" thy "ID oo f = f "
   3.873 - (fn prems =>
   3.874 -        [
   3.875 -        (rtac ext_cfun 1),
   3.876 -        (stac cfcomp2 1),
   3.877 -        (stac ID1 1),
   3.878 -        (rtac refl 1)
   3.879 -        ]);
   3.880 +val prems = goal thy "ID oo f = f ";
   3.881 +by (rtac ext_cfun 1);
   3.882 +by (stac cfcomp2 1);
   3.883 +by (stac ID1 1);
   3.884 +by (rtac refl 1);
   3.885 +qed "ID3";
   3.886  
   3.887  
   3.888 -qed_goal "assoc_oo" thy "f oo (g oo h) = (f oo g) oo h"
   3.889 - (fn prems =>
   3.890 -        [
   3.891 -        (rtac ext_cfun 1),
   3.892 -        (res_inst_tac [("s","f`(g`(h`x))")] trans  1),
   3.893 -        (stac cfcomp2 1),
   3.894 -        (stac cfcomp2 1),
   3.895 -        (rtac refl 1),
   3.896 -        (stac cfcomp2 1),
   3.897 -        (stac cfcomp2 1),
   3.898 -        (rtac refl 1)
   3.899 -        ]);
   3.900 +val prems = goal thy "f oo (g oo h) = (f oo g) oo h";
   3.901 +by (rtac ext_cfun 1);
   3.902 +by (res_inst_tac [("s","f`(g`(h`x))")] trans  1);
   3.903 +by (stac cfcomp2 1);
   3.904 +by (stac cfcomp2 1);
   3.905 +by (rtac refl 1);
   3.906 +by (stac cfcomp2 1);
   3.907 +by (stac cfcomp2 1);
   3.908 +by (rtac refl 1);
   3.909 +qed "assoc_oo";
   3.910  
   3.911  (* ------------------------------------------------------------------------ *)
   3.912  (* Merge the different rewrite rules for the simplifier                     *)
     4.1 --- a/src/HOLCF/Cont.ML	Tue Jul 04 14:58:40 2000 +0200
     4.2 +++ b/src/HOLCF/Cont.ML	Tue Jul 04 15:58:11 2000 +0200
     4.3 @@ -10,57 +10,45 @@
     4.4  (* access to definition                                                     *)
     4.5  (* ------------------------------------------------------------------------ *)
     4.6  
     4.7 -qed_goalw "contlubI" thy [contlub]
     4.8 +val prems = goalw thy [contlub]
     4.9          "! Y. chain(Y) --> f(lub(range(Y))) = lub(range(%i. f(Y(i))))==>\
    4.10 -\        contlub(f)"
    4.11 -(fn prems =>
    4.12 -        [
    4.13 -        (cut_facts_tac prems 1),
    4.14 -        (atac 1)
    4.15 -        ]);
    4.16 +\        contlub(f)";
    4.17 +by (cut_facts_tac prems 1);
    4.18 +by (atac 1);
    4.19 +qed "contlubI";
    4.20  
    4.21 -qed_goalw "contlubE" thy [contlub]
    4.22 +val prems = goalw thy [contlub]
    4.23          " contlub(f)==>\
    4.24 -\         ! Y. chain(Y) --> f(lub(range(Y))) = lub(range(%i. f(Y(i))))"
    4.25 -(fn prems =>
    4.26 -        [
    4.27 -        (cut_facts_tac prems 1),
    4.28 -        (atac 1)
    4.29 -        ]);
    4.30 +\         ! Y. chain(Y) --> f(lub(range(Y))) = lub(range(%i. f(Y(i))))";
    4.31 +by (cut_facts_tac prems 1);
    4.32 +by (atac 1);
    4.33 +qed "contlubE";
    4.34  
    4.35  
    4.36 -qed_goalw "contI" thy [cont]
    4.37 - "! Y. chain(Y) --> range(% i. f(Y(i))) <<| f(lub(range(Y))) ==> cont(f)"
    4.38 -(fn prems =>
    4.39 -        [
    4.40 -        (cut_facts_tac prems 1),
    4.41 -        (atac 1)
    4.42 -        ]);
    4.43 +val prems = goalw thy [cont]
    4.44 + "! Y. chain(Y) --> range(% i. f(Y(i))) <<| f(lub(range(Y))) ==> cont(f)";
    4.45 +by (cut_facts_tac prems 1);
    4.46 +by (atac 1);
    4.47 +qed "contI";
    4.48  
    4.49 -qed_goalw "contE" thy [cont]
    4.50 - "cont(f) ==> ! Y. chain(Y) --> range(% i. f(Y(i))) <<| f(lub(range(Y)))"
    4.51 -(fn prems =>
    4.52 -        [
    4.53 -        (cut_facts_tac prems 1),
    4.54 -        (atac 1)
    4.55 -        ]);
    4.56 +val prems = goalw thy [cont]
    4.57 + "cont(f) ==> ! Y. chain(Y) --> range(% i. f(Y(i))) <<| f(lub(range(Y)))";
    4.58 +by (cut_facts_tac prems 1);
    4.59 +by (atac 1);
    4.60 +qed "contE";
    4.61  
    4.62  
    4.63 -qed_goalw "monofunI" thy [monofun]
    4.64 -        "! x y. x << y --> f(x) << f(y) ==> monofun(f)"
    4.65 -(fn prems =>
    4.66 -        [
    4.67 -        (cut_facts_tac prems 1),
    4.68 -        (atac 1)
    4.69 -        ]);
    4.70 +val prems = goalw thy [monofun]
    4.71 +        "! x y. x << y --> f(x) << f(y) ==> monofun(f)";
    4.72 +by (cut_facts_tac prems 1);
    4.73 +by (atac 1);
    4.74 +qed "monofunI";
    4.75  
    4.76 -qed_goalw "monofunE" thy [monofun]
    4.77 -        "monofun(f) ==> ! x y. x << y --> f(x) << f(y)"
    4.78 -(fn prems =>
    4.79 -        [
    4.80 -        (cut_facts_tac prems 1),
    4.81 -        (atac 1)
    4.82 -        ]);
    4.83 +val prems = goalw thy [monofun]
    4.84 +        "monofun(f) ==> ! x y. x << y --> f(x) << f(y)";
    4.85 +by (cut_facts_tac prems 1);
    4.86 +by (atac 1);
    4.87 +qed "monofunE";
    4.88  
    4.89  (* ------------------------------------------------------------------------ *)
    4.90  (* the main purpose of cont.thy is to show:                                 *)
    4.91 @@ -71,115 +59,91 @@
    4.92  (* monotone functions map chains to chains                                  *)
    4.93  (* ------------------------------------------------------------------------ *)
    4.94  
    4.95 -qed_goal "ch2ch_monofun" thy 
    4.96 -        "[| monofun(f); chain(Y) |] ==> chain(%i. f(Y(i)))"
    4.97 -(fn prems =>
    4.98 -        [
    4.99 -        (cut_facts_tac prems 1),
   4.100 -        (rtac chainI 1),
   4.101 -        (rtac allI 1),
   4.102 -        (etac (monofunE RS spec RS spec RS mp) 1),
   4.103 -        (etac (chainE RS spec) 1)
   4.104 -        ]);
   4.105 +val prems = goal thy 
   4.106 +        "[| monofun(f); chain(Y) |] ==> chain(%i. f(Y(i)))";
   4.107 +by (cut_facts_tac prems 1);
   4.108 +by (rtac chainI 1);
   4.109 +by (rtac allI 1);
   4.110 +by (etac (monofunE RS spec RS spec RS mp) 1);
   4.111 +by (etac (chainE RS spec) 1);
   4.112 +qed "ch2ch_monofun";
   4.113  
   4.114  (* ------------------------------------------------------------------------ *)
   4.115  (* monotone functions map upper bound to upper bounds                       *)
   4.116  (* ------------------------------------------------------------------------ *)
   4.117  
   4.118 -qed_goal "ub2ub_monofun" thy 
   4.119 - "[| monofun(f); range(Y) <| u|]  ==> range(%i. f(Y(i))) <| f(u)"
   4.120 -(fn prems =>
   4.121 -        [
   4.122 -        (cut_facts_tac prems 1),
   4.123 -        (rtac ub_rangeI 1),
   4.124 -        (rtac allI 1),
   4.125 -        (etac (monofunE RS spec RS spec RS mp) 1),
   4.126 -        (etac (ub_rangeE RS spec) 1)
   4.127 -        ]);
   4.128 +val prems = goal thy 
   4.129 + "[| monofun(f); range(Y) <| u|]  ==> range(%i. f(Y(i))) <| f(u)";
   4.130 +by (cut_facts_tac prems 1);
   4.131 +by (rtac ub_rangeI 1);
   4.132 +by (rtac allI 1);
   4.133 +by (etac (monofunE RS spec RS spec RS mp) 1);
   4.134 +by (etac (ub_rangeE RS spec) 1);
   4.135 +qed "ub2ub_monofun";
   4.136  
   4.137  (* ------------------------------------------------------------------------ *)
   4.138  (* left to right: monofun(f) & contlub(f)  ==> cont(f)                     *)
   4.139  (* ------------------------------------------------------------------------ *)
   4.140  
   4.141 -qed_goalw "monocontlub2cont" thy [cont]
   4.142 -        "[|monofun(f);contlub(f)|] ==> cont(f)"
   4.143 -(fn prems =>
   4.144 -        [
   4.145 -        (cut_facts_tac prems 1),
   4.146 -        (strip_tac 1),
   4.147 -        (rtac thelubE 1),
   4.148 -        (etac ch2ch_monofun 1),
   4.149 -        (atac 1),
   4.150 -        (etac (contlubE RS spec RS mp RS sym) 1),
   4.151 -        (atac 1)
   4.152 -        ]);
   4.153 +val prems = goalw thy [cont]
   4.154 +        "[|monofun(f);contlub(f)|] ==> cont(f)";
   4.155 +by (cut_facts_tac prems 1);
   4.156 +by (strip_tac 1);
   4.157 +by (rtac thelubE 1);
   4.158 +by (etac ch2ch_monofun 1);
   4.159 +by (atac 1);
   4.160 +by (etac (contlubE RS spec RS mp RS sym) 1);
   4.161 +by (atac 1);
   4.162 +qed "monocontlub2cont";
   4.163  
   4.164  (* ------------------------------------------------------------------------ *)
   4.165  (* first a lemma about binary chains                                        *)
   4.166  (* ------------------------------------------------------------------------ *)
   4.167  
   4.168 -qed_goal "binchain_cont" thy
   4.169 -"[| cont(f); x << y |]  ==> range(%i::nat. f(if i = 0 then x else y)) <<| f(y)"
   4.170 -(fn prems => 
   4.171 -        [
   4.172 -        (cut_facts_tac prems 1),
   4.173 -        (rtac subst 1), 
   4.174 -        (etac (contE RS spec RS mp) 2),
   4.175 -        (etac bin_chain 2),
   4.176 -        (res_inst_tac [("y","y")] arg_cong 1),
   4.177 -        (etac (lub_bin_chain RS thelubI) 1)
   4.178 -        ]);
   4.179 +Goal "[| cont(f); x << y |]  \
   4.180 +\     ==> range(%i::nat. f(if i = 0 then x else y)) <<| f(y)";
   4.181 +by (rtac subst 1);
   4.182 +by (etac (contE RS spec RS mp) 2);
   4.183 +by (etac bin_chain 2);
   4.184 +by (res_inst_tac [("y","y")] arg_cong 1);
   4.185 +by (etac (lub_bin_chain RS thelubI) 1);
   4.186 +qed "binchain_cont";
   4.187  
   4.188  (* ------------------------------------------------------------------------ *)
   4.189  (* right to left: cont(f) ==> monofun(f) & contlub(f)                      *)
   4.190  (* part1:         cont(f) ==> monofun(f                                    *)
   4.191  (* ------------------------------------------------------------------------ *)
   4.192  
   4.193 -qed_goalw "cont2mono" thy [monofun]
   4.194 -        "cont(f) ==> monofun(f)"
   4.195 -(fn prems =>
   4.196 -        [
   4.197 -        (cut_facts_tac prems 1),
   4.198 -        (strip_tac 1),
   4.199 -        (res_inst_tac [("s","if 0 = 0 then x else y")] subst 1),
   4.200 -        (rtac (binchain_cont RS is_ub_lub) 2),
   4.201 -        (atac 2),
   4.202 -        (atac 2),
   4.203 -        (Simp_tac 1)
   4.204 -        ]);
   4.205 +Goalw [monofun] "cont(f) ==> monofun(f)";
   4.206 +by (strip_tac 1);
   4.207 +by (dtac (binchain_cont RS is_ub_lub) 1);
   4.208 +by (auto_tac (claset(), simpset() addsplits [split_if_asm]));
   4.209 +qed "cont2mono";
   4.210  
   4.211  (* ------------------------------------------------------------------------ *)
   4.212  (* right to left: cont(f) ==> monofun(f) & contlub(f)                      *)
   4.213  (* part2:         cont(f) ==>              contlub(f)                      *)
   4.214  (* ------------------------------------------------------------------------ *)
   4.215  
   4.216 -qed_goalw "cont2contlub" thy [contlub]
   4.217 -        "cont(f) ==> contlub(f)"
   4.218 -(fn prems =>
   4.219 -        [
   4.220 -        (cut_facts_tac prems 1),
   4.221 -        (strip_tac 1),
   4.222 -        (rtac (thelubI RS sym) 1),
   4.223 -        (etac (contE RS spec RS mp) 1),
   4.224 -        (atac 1)
   4.225 -        ]);
   4.226 +Goalw [contlub] "cont(f) ==> contlub(f)";
   4.227 +by (strip_tac 1);
   4.228 +by (rtac (thelubI RS sym) 1);
   4.229 +by (etac (contE RS spec RS mp) 1);
   4.230 +by (atac 1);
   4.231 +qed "cont2contlub";
   4.232  
   4.233  (* ------------------------------------------------------------------------ *)
   4.234 -(* monotone functions map finite chains to finite chains              	    *)
   4.235 +(* monotone functions map finite chains to finite chains                    *)
   4.236  (* ------------------------------------------------------------------------ *)
   4.237  
   4.238 -qed_goalw "monofun_finch2finch" thy [finite_chain_def]
   4.239 -  "[| monofun f; finite_chain Y |] ==> finite_chain (%n. f (Y n))" 
   4.240 -(fn prems => 
   4.241 -	[
   4.242 -	cut_facts_tac prems 1,
   4.243 -	safe_tac HOL_cs,
   4.244 -	fast_tac (HOL_cs addSEs [ch2ch_monofun]) 1,
   4.245 -	fast_tac (HOL_cs addss (HOL_ss addsimps [max_in_chain_def])) 1
   4.246 -	]);
   4.247 +Goalw [finite_chain_def]
   4.248 +  "[| monofun f; finite_chain Y |] ==> finite_chain (%n. f (Y n))";
   4.249 +by (force_tac (claset()  addSEs [ch2ch_monofun],
   4.250 +	       simpset() addsimps [max_in_chain_def]) 1);
   4.251 +qed "monofun_finch2finch";
   4.252  
   4.253  (* ------------------------------------------------------------------------ *)
   4.254 -(* The same holds for continuous functions				    *)
   4.255 +(* The same holds for continuous functions                                  *)
   4.256  (* ------------------------------------------------------------------------ *)
   4.257  
   4.258  bind_thm ("cont_finch2finch", cont2mono RS monofun_finch2finch);
   4.259 @@ -191,199 +155,181 @@
   4.260  (* in both arguments                                                        *)
   4.261  (* ------------------------------------------------------------------------ *)
   4.262  
   4.263 -qed_goal "ch2ch_MF2L" thy 
   4.264 -"[|monofun(MF2); chain(F)|] ==> chain(%i. MF2 (F i) x)"
   4.265 -(fn prems =>
   4.266 -        [
   4.267 -        (cut_facts_tac prems 1),
   4.268 -        (etac (ch2ch_monofun RS ch2ch_fun) 1),
   4.269 -        (atac 1)
   4.270 -        ]);
   4.271 +val prems = goal thy 
   4.272 +"[|monofun(MF2); chain(F)|] ==> chain(%i. MF2 (F i) x)";
   4.273 +by (cut_facts_tac prems 1);
   4.274 +by (etac (ch2ch_monofun RS ch2ch_fun) 1);
   4.275 +by (atac 1);
   4.276 +qed "ch2ch_MF2L";
   4.277  
   4.278  
   4.279 -qed_goal "ch2ch_MF2R" thy 
   4.280 -"[|monofun(MF2(f)); chain(Y)|] ==> chain(%i. MF2 f (Y i))"
   4.281 -(fn prems =>
   4.282 -        [
   4.283 -        (cut_facts_tac prems 1),
   4.284 -        (etac ch2ch_monofun 1),
   4.285 -        (atac 1)
   4.286 -        ]);
   4.287 +val prems = goal thy 
   4.288 +"[|monofun(MF2(f)); chain(Y)|] ==> chain(%i. MF2 f (Y i))";
   4.289 +by (cut_facts_tac prems 1);
   4.290 +by (etac ch2ch_monofun 1);
   4.291 +by (atac 1);
   4.292 +qed "ch2ch_MF2R";
   4.293  
   4.294 -qed_goal "ch2ch_MF2LR" thy 
   4.295 +val prems = goal thy 
   4.296  "[|monofun(MF2); !f. monofun(MF2(f)); chain(F); chain(Y)|] ==> \
   4.297 -\  chain(%i. MF2(F(i))(Y(i)))"
   4.298 - (fn prems =>
   4.299 -        [
   4.300 -        (cut_facts_tac prems 1),
   4.301 -        (rtac chainI 1),
   4.302 -        (strip_tac 1 ),
   4.303 -        (rtac trans_less 1),
   4.304 -        (etac (ch2ch_MF2L RS chainE RS spec) 1),
   4.305 -        (atac 1),
   4.306 -        ((rtac (monofunE RS spec RS spec RS mp) 1) THEN (etac spec 1)),
   4.307 -        (etac (chainE RS spec) 1)
   4.308 -        ]);
   4.309 +\  chain(%i. MF2(F(i))(Y(i)))";
   4.310 +by (cut_facts_tac prems 1);
   4.311 +by (rtac chainI 1);
   4.312 +by (strip_tac 1 );
   4.313 +by (rtac trans_less 1);
   4.314 +by (etac (ch2ch_MF2L RS chainE RS spec) 1);
   4.315 +by (atac 1);
   4.316 +by ((rtac (monofunE RS spec RS spec RS mp) 1) THEN (etac spec 1));
   4.317 +by (etac (chainE RS spec) 1);
   4.318 +qed "ch2ch_MF2LR";
   4.319  
   4.320  
   4.321 -qed_goal "ch2ch_lubMF2R" thy 
   4.322 +val prems = goal thy 
   4.323  "[|monofun(MF2::('a::po=>'b::po=>'c::cpo));\
   4.324  \  !f. monofun(MF2(f)::('b::po=>'c::cpo));\
   4.325  \       chain(F);chain(Y)|] ==> \
   4.326 -\       chain(%j. lub(range(%i. MF2 (F j) (Y i))))"
   4.327 -(fn prems =>
   4.328 -        [
   4.329 -        (cut_facts_tac prems 1),
   4.330 -        (rtac (lub_mono RS allI RS chainI) 1),
   4.331 -        ((rtac ch2ch_MF2R 1) THEN (etac spec 1)),
   4.332 -        (atac 1),
   4.333 -        ((rtac ch2ch_MF2R 1) THEN (etac spec 1)),
   4.334 -        (atac 1),
   4.335 -        (strip_tac 1),
   4.336 -        (rtac (chainE RS spec) 1),
   4.337 -        (etac ch2ch_MF2L 1),
   4.338 -        (atac 1)
   4.339 -        ]);
   4.340 +\       chain(%j. lub(range(%i. MF2 (F j) (Y i))))";
   4.341 +by (cut_facts_tac prems 1);
   4.342 +by (rtac (lub_mono RS allI RS chainI) 1);
   4.343 +by ((rtac ch2ch_MF2R 1) THEN (etac spec 1));
   4.344 +by (atac 1);
   4.345 +by ((rtac ch2ch_MF2R 1) THEN (etac spec 1));
   4.346 +by (atac 1);
   4.347 +by (strip_tac 1);
   4.348 +by (rtac (chainE RS spec) 1);
   4.349 +by (etac ch2ch_MF2L 1);
   4.350 +by (atac 1);
   4.351 +qed "ch2ch_lubMF2R";
   4.352  
   4.353  
   4.354 -qed_goal "ch2ch_lubMF2L" thy 
   4.355 +val prems = goal thy 
   4.356  "[|monofun(MF2::('a::po=>'b::po=>'c::cpo));\
   4.357  \  !f. monofun(MF2(f)::('b::po=>'c::cpo));\
   4.358  \       chain(F);chain(Y)|] ==> \
   4.359 -\       chain(%i. lub(range(%j. MF2 (F j) (Y i))))"
   4.360 -(fn prems =>
   4.361 -        [
   4.362 -        (cut_facts_tac prems 1),
   4.363 -        (rtac (lub_mono RS allI RS chainI) 1),
   4.364 -        (etac ch2ch_MF2L 1),
   4.365 -        (atac 1),
   4.366 -        (etac ch2ch_MF2L 1),
   4.367 -        (atac 1),
   4.368 -        (strip_tac 1),
   4.369 -        (rtac (chainE RS spec) 1),
   4.370 -        ((rtac ch2ch_MF2R 1) THEN (etac spec 1)),
   4.371 -        (atac 1)
   4.372 -        ]);
   4.373 +\       chain(%i. lub(range(%j. MF2 (F j) (Y i))))";
   4.374 +by (cut_facts_tac prems 1);
   4.375 +by (rtac (lub_mono RS allI RS chainI) 1);
   4.376 +by (etac ch2ch_MF2L 1);
   4.377 +by (atac 1);
   4.378 +by (etac ch2ch_MF2L 1);
   4.379 +by (atac 1);
   4.380 +by (strip_tac 1);
   4.381 +by (rtac (chainE RS spec) 1);
   4.382 +by ((rtac ch2ch_MF2R 1) THEN (etac spec 1));
   4.383 +by (atac 1);
   4.384 +qed "ch2ch_lubMF2L";
   4.385  
   4.386  
   4.387 -qed_goal "lub_MF2_mono" thy 
   4.388 +val prems = goal thy 
   4.389  "[|monofun(MF2::('a::po=>'b::po=>'c::cpo));\
   4.390  \  !f. monofun(MF2(f)::('b::po=>'c::cpo));\
   4.391  \       chain(F)|] ==> \
   4.392 -\       monofun(% x. lub(range(% j. MF2 (F j) (x))))"
   4.393 -(fn prems =>
   4.394 -        [
   4.395 -        (cut_facts_tac prems 1),
   4.396 -        (rtac monofunI 1),
   4.397 -        (strip_tac 1),
   4.398 -        (rtac lub_mono 1),
   4.399 -        (etac ch2ch_MF2L 1),
   4.400 -        (atac 1),
   4.401 -        (etac ch2ch_MF2L 1),
   4.402 -        (atac 1),
   4.403 -        (strip_tac 1),
   4.404 -        ((rtac (monofunE RS spec RS spec RS mp) 1) THEN (etac spec 1)),
   4.405 -        (atac 1)
   4.406 -        ]);
   4.407 +\       monofun(% x. lub(range(% j. MF2 (F j) (x))))";
   4.408 +by (cut_facts_tac prems 1);
   4.409 +by (rtac monofunI 1);
   4.410 +by (strip_tac 1);
   4.411 +by (rtac lub_mono 1);
   4.412 +by (etac ch2ch_MF2L 1);
   4.413 +by (atac 1);
   4.414 +by (etac ch2ch_MF2L 1);
   4.415 +by (atac 1);
   4.416 +by (strip_tac 1);
   4.417 +by ((rtac (monofunE RS spec RS spec RS mp) 1) THEN (etac spec 1));
   4.418 +by (atac 1);
   4.419 +qed "lub_MF2_mono";
   4.420  
   4.421 -qed_goal "ex_lubMF2" thy 
   4.422 +val prems = goal thy 
   4.423  "[|monofun(MF2::('a::po=>'b::po=>'c::cpo));\
   4.424  \  !f. monofun(MF2(f)::('b::po=>'c::cpo));\
   4.425  \       chain(F); chain(Y)|] ==> \
   4.426  \               lub(range(%j. lub(range(%i. MF2(F j) (Y i))))) =\
   4.427 -\               lub(range(%i. lub(range(%j. MF2(F j) (Y i)))))"
   4.428 - (fn prems =>
   4.429 -        [
   4.430 -        (cut_facts_tac prems 1),
   4.431 -        (rtac antisym_less 1),
   4.432 -        (rtac (ub_rangeI RSN (2,is_lub_thelub)) 1),
   4.433 -        (etac ch2ch_lubMF2R 1),
   4.434 -        (REPEAT (atac 1)),
   4.435 -        (strip_tac 1),
   4.436 -        (rtac lub_mono 1),
   4.437 -        ((rtac ch2ch_MF2R 1) THEN (etac spec 1)),
   4.438 -        (atac 1),
   4.439 -        (etac ch2ch_lubMF2L 1),
   4.440 -        (REPEAT (atac 1)),
   4.441 -        (strip_tac 1),
   4.442 -        (rtac is_ub_thelub 1),
   4.443 -        (etac ch2ch_MF2L 1),
   4.444 -        (atac 1),
   4.445 -        (rtac (ub_rangeI RSN (2,is_lub_thelub)) 1),
   4.446 -        (etac ch2ch_lubMF2L 1),
   4.447 -        (REPEAT (atac 1)),
   4.448 -        (strip_tac 1),
   4.449 -        (rtac lub_mono 1),
   4.450 -        (etac ch2ch_MF2L 1),
   4.451 -        (atac 1),
   4.452 -        (etac ch2ch_lubMF2R 1),
   4.453 -        (REPEAT (atac 1)),
   4.454 -        (strip_tac 1),
   4.455 -        (rtac is_ub_thelub 1),
   4.456 -        ((rtac ch2ch_MF2R 1) THEN (etac spec 1)),
   4.457 -        (atac 1)
   4.458 -        ]);
   4.459 +\               lub(range(%i. lub(range(%j. MF2(F j) (Y i)))))";
   4.460 +by (cut_facts_tac prems 1);
   4.461 +by (rtac antisym_less 1);
   4.462 +by (rtac (ub_rangeI RSN (2,is_lub_thelub)) 1);
   4.463 +by (etac ch2ch_lubMF2R 1);
   4.464 +by (REPEAT (atac 1));
   4.465 +by (strip_tac 1);
   4.466 +by (rtac lub_mono 1);
   4.467 +by ((rtac ch2ch_MF2R 1) THEN (etac spec 1));
   4.468 +by (atac 1);
   4.469 +by (etac ch2ch_lubMF2L 1);
   4.470 +by (REPEAT (atac 1));
   4.471 +by (strip_tac 1);
   4.472 +by (rtac is_ub_thelub 1);
   4.473 +by (etac ch2ch_MF2L 1);
   4.474 +by (atac 1);
   4.475 +by (rtac (ub_rangeI RSN (2,is_lub_thelub)) 1);
   4.476 +by (etac ch2ch_lubMF2L 1);
   4.477 +by (REPEAT (atac 1));
   4.478 +by (strip_tac 1);
   4.479 +by (rtac lub_mono 1);
   4.480 +by (etac ch2ch_MF2L 1);
   4.481 +by (atac 1);
   4.482 +by (etac ch2ch_lubMF2R 1);
   4.483 +by (REPEAT (atac 1));
   4.484 +by (strip_tac 1);
   4.485 +by (rtac is_ub_thelub 1);
   4.486 +by ((rtac ch2ch_MF2R 1) THEN (etac spec 1));
   4.487 +by (atac 1);
   4.488 +qed "ex_lubMF2";
   4.489  
   4.490  
   4.491 -qed_goal "diag_lubMF2_1" thy 
   4.492 +val prems = goal thy 
   4.493  "[|monofun(MF2::('a::po=>'b::po=>'c::cpo));\
   4.494  \  !f. monofun(MF2(f)::('b::po=>'c::cpo));\
   4.495  \  chain(FY);chain(TY)|] ==>\
   4.496  \ lub(range(%i. lub(range(%j. MF2(FY(j))(TY(i)))))) =\
   4.497 -\ lub(range(%i. MF2(FY(i))(TY(i))))"
   4.498 - (fn prems =>
   4.499 -        [
   4.500 -        (cut_facts_tac prems 1),
   4.501 -        (rtac antisym_less 1),
   4.502 -        (rtac (ub_rangeI RSN (2,is_lub_thelub)) 1),
   4.503 -        (etac ch2ch_lubMF2L 1),
   4.504 -        (REPEAT (atac 1)),
   4.505 -        (strip_tac 1 ),
   4.506 -        (rtac lub_mono3 1),
   4.507 -        (etac ch2ch_MF2L 1),
   4.508 -        (REPEAT (atac 1)),
   4.509 -        (etac ch2ch_MF2LR 1),
   4.510 -        (REPEAT (atac 1)),
   4.511 -        (rtac allI 1),
   4.512 -        (res_inst_tac [("m","i"),("n","ia")] nat_less_cases 1),
   4.513 -        (res_inst_tac [("x","ia")] exI 1),
   4.514 -        (rtac (chain_mono RS mp) 1),
   4.515 -        (etac allE 1),
   4.516 -        (etac ch2ch_MF2R 1),
   4.517 -        (REPEAT (atac 1)),
   4.518 -        (hyp_subst_tac 1),
   4.519 -        (res_inst_tac [("x","ia")] exI 1),
   4.520 -        (rtac refl_less 1),
   4.521 -        (res_inst_tac [("x","i")] exI 1),
   4.522 -        (rtac (chain_mono RS mp) 1),
   4.523 -        (etac ch2ch_MF2L 1),
   4.524 -        (REPEAT (atac 1)),
   4.525 -        (rtac lub_mono 1),
   4.526 -        (etac ch2ch_MF2LR 1),
   4.527 -        (REPEAT(atac 1)),
   4.528 -        (etac ch2ch_lubMF2L 1),
   4.529 -        (REPEAT (atac 1)),
   4.530 -        (strip_tac 1 ),
   4.531 -        (rtac is_ub_thelub 1),
   4.532 -        (etac ch2ch_MF2L 1),
   4.533 -        (atac 1)
   4.534 -        ]);
   4.535 +\ lub(range(%i. MF2(FY(i))(TY(i))))";
   4.536 +by (cut_facts_tac prems 1);
   4.537 +by (rtac antisym_less 1);
   4.538 +by (rtac (ub_rangeI RSN (2,is_lub_thelub)) 1);
   4.539 +by (etac ch2ch_lubMF2L 1);
   4.540 +by (REPEAT (atac 1));
   4.541 +by (strip_tac 1 );
   4.542 +by (rtac lub_mono3 1);
   4.543 +by (etac ch2ch_MF2L 1);
   4.544 +by (REPEAT (atac 1));
   4.545 +by (etac ch2ch_MF2LR 1);
   4.546 +by (REPEAT (atac 1));
   4.547 +by (rtac allI 1);
   4.548 +by (res_inst_tac [("m","i"),("n","ia")] nat_less_cases 1);
   4.549 +by (res_inst_tac [("x","ia")] exI 1);
   4.550 +by (rtac (chain_mono RS mp) 1);
   4.551 +by (etac allE 1);
   4.552 +by (etac ch2ch_MF2R 1);
   4.553 +by (REPEAT (atac 1));
   4.554 +by (hyp_subst_tac 1);
   4.555 +by (res_inst_tac [("x","ia")] exI 1);
   4.556 +by (rtac refl_less 1);
   4.557 +by (res_inst_tac [("x","i")] exI 1);
   4.558 +by (rtac (chain_mono RS mp) 1);
   4.559 +by (etac ch2ch_MF2L 1);
   4.560 +by (REPEAT (atac 1));
   4.561 +by (rtac lub_mono 1);
   4.562 +by (etac ch2ch_MF2LR 1);
   4.563 +by (REPEAT(atac 1));
   4.564 +by (etac ch2ch_lubMF2L 1);
   4.565 +by (REPEAT (atac 1));
   4.566 +by (strip_tac 1 );
   4.567 +by (rtac is_ub_thelub 1);
   4.568 +by (etac ch2ch_MF2L 1);
   4.569 +by (atac 1);
   4.570 +qed "diag_lubMF2_1";
   4.571  
   4.572 -qed_goal "diag_lubMF2_2" thy 
   4.573 +val prems = goal thy 
   4.574  "[|monofun(MF2::('a::po=>'b::po=>'c::cpo));\
   4.575  \  !f. monofun(MF2(f)::('b::po=>'c::cpo));\
   4.576  \  chain(FY);chain(TY)|] ==>\
   4.577  \ lub(range(%j. lub(range(%i. MF2(FY(j))(TY(i)))))) =\
   4.578 -\ lub(range(%i. MF2(FY(i))(TY(i))))"
   4.579 - (fn prems =>
   4.580 -        [
   4.581 -        (cut_facts_tac prems 1),
   4.582 -        (rtac trans 1),
   4.583 -        (rtac ex_lubMF2 1),
   4.584 -        (REPEAT (atac 1)),
   4.585 -        (etac diag_lubMF2_1 1),
   4.586 -        (REPEAT (atac 1))
   4.587 -        ]);
   4.588 +\ lub(range(%i. MF2(FY(i))(TY(i))))";
   4.589 +by (cut_facts_tac prems 1);
   4.590 +by (rtac trans 1);
   4.591 +by (rtac ex_lubMF2 1);
   4.592 +by (REPEAT (atac 1));
   4.593 +by (etac diag_lubMF2_1 1);
   4.594 +by (REPEAT (atac 1));
   4.595 +qed "diag_lubMF2_2";
   4.596  
   4.597  
   4.598  (* ------------------------------------------------------------------------ *)
   4.599 @@ -391,59 +337,51 @@
   4.600  (* in both arguments                                                        *)
   4.601  (* ------------------------------------------------------------------------ *)
   4.602  
   4.603 -qed_goal "contlub_CF2" thy 
   4.604 +val prems = goal thy 
   4.605  "[|cont(CF2);!f. cont(CF2(f));chain(FY);chain(TY)|] ==>\
   4.606 -\ CF2(lub(range(FY)))(lub(range(TY))) = lub(range(%i. CF2(FY(i))(TY(i))))"
   4.607 - (fn prems =>
   4.608 -        [
   4.609 -        (cut_facts_tac prems 1),
   4.610 -        (stac ((hd prems) RS cont2contlub RS contlubE RS spec RS mp) 1),
   4.611 -        (atac 1),
   4.612 -        (stac thelub_fun 1),
   4.613 -        (rtac ((hd prems) RS cont2mono RS ch2ch_monofun) 1),
   4.614 -        (atac 1),
   4.615 -        (rtac trans 1),
   4.616 -        (rtac (((hd (tl prems)) RS spec RS cont2contlub) RS contlubE RS                spec RS mp RS ext RS arg_cong RS arg_cong) 1),
   4.617 -        (atac 1),
   4.618 -        (rtac diag_lubMF2_2 1),
   4.619 -        (etac cont2mono 1),
   4.620 -        (rtac allI 1),
   4.621 -        (etac allE 1),
   4.622 -        (etac cont2mono 1),
   4.623 -        (REPEAT (atac 1))
   4.624 -        ]);
   4.625 +\ CF2(lub(range(FY)))(lub(range(TY))) = lub(range(%i. CF2(FY(i))(TY(i))))";
   4.626 +by (cut_facts_tac prems 1);
   4.627 +by (stac ((hd prems) RS cont2contlub RS contlubE RS spec RS mp) 1);
   4.628 +by (atac 1);
   4.629 +by (stac thelub_fun 1);
   4.630 +by (rtac ((hd prems) RS cont2mono RS ch2ch_monofun) 1);
   4.631 +by (atac 1);
   4.632 +by (rtac trans 1);
   4.633 +by (rtac (((hd (tl prems)) RS spec RS cont2contlub) RS contlubE RS                spec RS mp RS ext RS arg_cong RS arg_cong) 1);
   4.634 +by (atac 1);
   4.635 +by (rtac diag_lubMF2_2 1);
   4.636 +by (etac cont2mono 1);
   4.637 +by (rtac allI 1);
   4.638 +by (etac allE 1);
   4.639 +by (etac cont2mono 1);
   4.640 +by (REPEAT (atac 1));
   4.641 +qed "contlub_CF2";
   4.642  
   4.643  (* ------------------------------------------------------------------------ *)
   4.644  (* The following results are about application for functions in 'a=>'b      *)
   4.645  (* ------------------------------------------------------------------------ *)
   4.646  
   4.647 -qed_goal "monofun_fun_fun" thy 
   4.648 -        "f1 << f2 ==> f1(x) << f2(x)"
   4.649 -(fn prems =>
   4.650 -        [
   4.651 -        (cut_facts_tac prems 1),
   4.652 -        (etac (less_fun RS iffD1 RS spec) 1)
   4.653 -        ]);
   4.654 +val prems = goal thy 
   4.655 +        "f1 << f2 ==> f1(x) << f2(x)";
   4.656 +by (cut_facts_tac prems 1);
   4.657 +by (etac (less_fun RS iffD1 RS spec) 1);
   4.658 +qed "monofun_fun_fun";
   4.659  
   4.660 -qed_goal "monofun_fun_arg" thy 
   4.661 -        "[|monofun(f); x1 << x2|] ==> f(x1) << f(x2)"
   4.662 -(fn prems =>
   4.663 -        [
   4.664 -        (cut_facts_tac prems 1),
   4.665 -        (etac (monofunE RS spec RS spec RS mp) 1),
   4.666 -        (atac 1)
   4.667 -        ]);
   4.668 +val prems = goal thy 
   4.669 +        "[|monofun(f); x1 << x2|] ==> f(x1) << f(x2)";
   4.670 +by (cut_facts_tac prems 1);
   4.671 +by (etac (monofunE RS spec RS spec RS mp) 1);
   4.672 +by (atac 1);
   4.673 +qed "monofun_fun_arg";
   4.674  
   4.675 -qed_goal "monofun_fun" thy 
   4.676 -"[|monofun(f1); monofun(f2); f1 << f2; x1 << x2|] ==> f1(x1) << f2(x2)"
   4.677 -(fn prems =>
   4.678 -        [
   4.679 -        (cut_facts_tac prems 1),
   4.680 -        (rtac trans_less 1),
   4.681 -        (etac monofun_fun_arg 1),
   4.682 -        (atac 1),
   4.683 -        (etac monofun_fun_fun 1)
   4.684 -        ]);
   4.685 +val prems = goal thy 
   4.686 +"[|monofun(f1); monofun(f2); f1 << f2; x1 << x2|] ==> f1(x1) << f2(x2)";
   4.687 +by (cut_facts_tac prems 1);
   4.688 +by (rtac trans_less 1);
   4.689 +by (etac monofun_fun_arg 1);
   4.690 +by (atac 1);
   4.691 +by (etac monofun_fun_fun 1);
   4.692 +qed "monofun_fun";
   4.693  
   4.694  
   4.695  (* ------------------------------------------------------------------------ *)
   4.696 @@ -451,147 +389,115 @@
   4.697  (* continuity                                                               *)
   4.698  (* ------------------------------------------------------------------------ *)
   4.699  
   4.700 -qed_goal "mono2mono_MF1L" thy 
   4.701 -        "[|monofun(c1)|] ==> monofun(%x. c1 x y)"
   4.702 -(fn prems =>
   4.703 -        [
   4.704 -        (cut_facts_tac prems 1),
   4.705 -        (rtac monofunI 1),
   4.706 -        (strip_tac 1),
   4.707 -        (etac (monofun_fun_arg RS monofun_fun_fun) 1),
   4.708 -        (atac 1)
   4.709 -        ]);
   4.710 +val prems = goal thy 
   4.711 +        "[|monofun(c1)|] ==> monofun(%x. c1 x y)";
   4.712 +by (cut_facts_tac prems 1);
   4.713 +by (rtac monofunI 1);
   4.714 +by (strip_tac 1);
   4.715 +by (etac (monofun_fun_arg RS monofun_fun_fun) 1);
   4.716 +by (atac 1);
   4.717 +qed "mono2mono_MF1L";
   4.718  
   4.719 -qed_goal "cont2cont_CF1L" thy 
   4.720 -        "[|cont(c1)|] ==> cont(%x. c1 x y)"
   4.721 -(fn prems =>
   4.722 -        [
   4.723 -        (cut_facts_tac prems 1),
   4.724 -        (rtac monocontlub2cont 1),
   4.725 -        (etac (cont2mono RS mono2mono_MF1L) 1),
   4.726 -        (rtac contlubI 1),
   4.727 -        (strip_tac 1),
   4.728 -        (rtac ((hd prems) RS cont2contlub RS 
   4.729 -                contlubE RS spec RS mp RS ssubst) 1),
   4.730 -        (atac 1),
   4.731 -        (stac thelub_fun 1),
   4.732 -        (rtac ch2ch_monofun 1),
   4.733 -        (etac cont2mono 1),
   4.734 -        (atac 1),
   4.735 -        (rtac refl 1)
   4.736 -        ]);
   4.737 +val prems = goal thy 
   4.738 +        "[|cont(c1)|] ==> cont(%x. c1 x y)";
   4.739 +by (cut_facts_tac prems 1);
   4.740 +by (rtac monocontlub2cont 1);
   4.741 +by (etac (cont2mono RS mono2mono_MF1L) 1);
   4.742 +by (rtac contlubI 1);
   4.743 +by (strip_tac 1);
   4.744 +by (rtac ((hd prems) RS cont2contlub RS contlubE RS spec RS mp RS ssubst) 1);
   4.745 +by (atac 1);
   4.746 +by (stac thelub_fun 1);
   4.747 +by (rtac ch2ch_monofun 1);
   4.748 +by (etac cont2mono 1);
   4.749 +by (atac 1);
   4.750 +by (rtac refl 1);
   4.751 +qed "cont2cont_CF1L";
   4.752  
   4.753  (*********  Note "(%x.%y.c1 x y) = c1" ***********)
   4.754  
   4.755 -qed_goal "mono2mono_MF1L_rev" thy
   4.756 -        "!y. monofun(%x. c1 x y) ==> monofun(c1)"
   4.757 -(fn prems =>
   4.758 -        [
   4.759 -        (cut_facts_tac prems 1),
   4.760 -        (rtac monofunI 1),
   4.761 -        (strip_tac 1),
   4.762 -        (rtac (less_fun RS iffD2) 1),
   4.763 -        (strip_tac 1),
   4.764 -        (rtac ((hd prems) RS spec RS monofunE RS spec RS spec RS mp) 1),
   4.765 -        (atac 1)
   4.766 -        ]);
   4.767 +val prems = goal thy
   4.768 +        "!y. monofun(%x. c1 x y) ==> monofun(c1)";
   4.769 +by (cut_facts_tac prems 1);
   4.770 +by (rtac monofunI 1);
   4.771 +by (strip_tac 1);
   4.772 +by (rtac (less_fun RS iffD2) 1);
   4.773 +by (strip_tac 1);
   4.774 +by (rtac ((hd prems) RS spec RS monofunE RS spec RS spec RS mp) 1);
   4.775 +by (atac 1);
   4.776 +qed "mono2mono_MF1L_rev";
   4.777  
   4.778 -qed_goal "cont2cont_CF1L_rev" thy
   4.779 -        "!y. cont(%x. c1 x y) ==> cont(c1)"
   4.780 -(fn prems =>
   4.781 -        [
   4.782 -        (cut_facts_tac prems 1),
   4.783 -        (rtac monocontlub2cont 1),
   4.784 -        (rtac (cont2mono RS allI RS mono2mono_MF1L_rev ) 1),
   4.785 -        (etac spec 1),
   4.786 -        (rtac contlubI 1),
   4.787 -        (strip_tac 1),
   4.788 -        (rtac ext 1),
   4.789 -        (stac thelub_fun 1),
   4.790 -        (rtac (cont2mono RS allI RS mono2mono_MF1L_rev RS ch2ch_monofun) 1),
   4.791 -        (etac spec 1),
   4.792 -        (atac 1),
   4.793 -        (rtac 
   4.794 -        ((hd prems) RS spec RS cont2contlub RS contlubE RS spec RS mp) 1),
   4.795 -        (atac 1)
   4.796 -        ]);
   4.797 +val prems = goal thy
   4.798 +        "!y. cont(%x. c1 x y) ==> cont(c1)";
   4.799 +by (cut_facts_tac prems 1);
   4.800 +by (rtac monocontlub2cont 1);
   4.801 +by (rtac (cont2mono RS allI RS mono2mono_MF1L_rev ) 1);
   4.802 +by (etac spec 1);
   4.803 +by (rtac contlubI 1);
   4.804 +by (strip_tac 1);
   4.805 +by (rtac ext 1);
   4.806 +by (stac thelub_fun 1);
   4.807 +by (rtac (cont2mono RS allI RS mono2mono_MF1L_rev RS ch2ch_monofun) 1);
   4.808 +by (etac spec 1);
   4.809 +by (atac 1);
   4.810 +by (rtac ((hd prems) RS spec RS cont2contlub RS contlubE RS spec RS mp) 1);
   4.811 +by (atac 1);
   4.812 +qed "cont2cont_CF1L_rev";
   4.813  
   4.814  (* ------------------------------------------------------------------------ *)
   4.815  (* What D.A.Schmidt calls continuity of abstraction                         *)
   4.816  (* never used here                                                          *)
   4.817  (* ------------------------------------------------------------------------ *)
   4.818  
   4.819 -qed_goal "contlub_abstraction" thy
   4.820 +val prems = goal thy
   4.821  "[|chain(Y::nat=>'a);!y. cont(%x.(c::'a::cpo=>'b::cpo=>'c::cpo) x y)|] ==>\
   4.822 -\ (%y. lub(range(%i. c (Y i) y))) = (lub(range(%i.%y. c (Y i) y)))"
   4.823 - (fn prems =>
   4.824 -        [
   4.825 -        (cut_facts_tac prems 1),
   4.826 -        (rtac trans 1),
   4.827 -        (rtac (cont2contlub RS contlubE RS spec RS mp) 2),
   4.828 -        (atac 3),
   4.829 -        (etac cont2cont_CF1L_rev 2),
   4.830 -        (rtac ext 1), 
   4.831 -        (rtac (cont2contlub RS contlubE RS spec RS mp RS sym) 1),
   4.832 -        (etac spec 1),
   4.833 -        (atac 1)
   4.834 -        ]);
   4.835 +\ (%y. lub(range(%i. c (Y i) y))) = (lub(range(%i.%y. c (Y i) y)))";
   4.836 +by (cut_facts_tac prems 1);
   4.837 +by (rtac trans 1);
   4.838 +by (rtac (cont2contlub RS contlubE RS spec RS mp) 2);
   4.839 +by (atac 3);
   4.840 +by (etac cont2cont_CF1L_rev 2);
   4.841 +by (rtac ext 1);
   4.842 +by (rtac (cont2contlub RS contlubE RS spec RS mp RS sym) 1);
   4.843 +by (etac spec 1);
   4.844 +by (atac 1);
   4.845 +qed "contlub_abstraction";
   4.846  
   4.847 -qed_goal "mono2mono_app" thy 
   4.848 +val prems = goal thy 
   4.849  "[|monofun(ft);!x. monofun(ft(x));monofun(tt)|] ==>\
   4.850 -\        monofun(%x.(ft(x))(tt(x)))"
   4.851 - (fn prems =>
   4.852 -        [
   4.853 -        (cut_facts_tac prems 1),
   4.854 -        (rtac monofunI 1),
   4.855 -        (strip_tac 1),
   4.856 -        (res_inst_tac [("f1.0","ft(x)"),("f2.0","ft(y)")] monofun_fun 1),
   4.857 -        (etac spec 1),
   4.858 -        (etac spec 1),
   4.859 -        (etac (monofunE RS spec RS spec RS mp) 1),
   4.860 -        (atac 1),
   4.861 -        (etac (monofunE RS spec RS spec RS mp) 1),
   4.862 -        (atac 1)
   4.863 -        ]);
   4.864 +\        monofun(%x.(ft(x))(tt(x)))";
   4.865 +by (cut_facts_tac prems 1);
   4.866 +by (rtac monofunI 1);
   4.867 +by (strip_tac 1);
   4.868 +by (res_inst_tac [("f1.0","ft(x)"),("f2.0","ft(y)")] monofun_fun 1);
   4.869 +by (etac spec 1);
   4.870 +by (etac spec 1);
   4.871 +by (etac (monofunE RS spec RS spec RS mp) 1);
   4.872 +by (atac 1);
   4.873 +by (etac (monofunE RS spec RS spec RS mp) 1);
   4.874 +by (atac 1);
   4.875 +qed "mono2mono_app";
   4.876  
   4.877  
   4.878 -qed_goal "cont2contlub_app" thy 
   4.879 -"[|cont(ft);!x. cont(ft(x));cont(tt)|] ==> contlub(%x.(ft(x))(tt(x)))"
   4.880 - (fn prems =>
   4.881 -        [
   4.882 -        (cut_facts_tac prems 1),
   4.883 -        (rtac contlubI 1),
   4.884 -        (strip_tac 1),
   4.885 -        (res_inst_tac [("f3","tt")] (contlubE RS spec RS mp RS ssubst) 1),
   4.886 -        (etac cont2contlub 1),
   4.887 -        (atac 1),
   4.888 -        (rtac contlub_CF2 1),
   4.889 -        (REPEAT (atac 1)),
   4.890 -        (etac (cont2mono RS ch2ch_monofun) 1),
   4.891 -        (atac 1)
   4.892 -        ]);
   4.893 +val prems = goal thy 
   4.894 +"[|cont(ft);!x. cont(ft(x));cont(tt)|] ==> contlub(%x.(ft(x))(tt(x)))";
   4.895 +by (cut_facts_tac prems 1);
   4.896 +by (rtac contlubI 1);
   4.897 +by (strip_tac 1);
   4.898 +by (res_inst_tac [("f3","tt")] (contlubE RS spec RS mp RS ssubst) 1);
   4.899 +by (etac cont2contlub 1);
   4.900 +by (atac 1);
   4.901 +by (rtac contlub_CF2 1);
   4.902 +by (REPEAT (atac 1));
   4.903 +by (etac (cont2mono RS ch2ch_monofun) 1);
   4.904 +by (atac 1);
   4.905 +qed "cont2contlub_app";
   4.906  
   4.907  
   4.908 -qed_goal "cont2cont_app" thy 
   4.909 -"[|cont(ft);!x. cont(ft(x));cont(tt)|] ==>\
   4.910 -\        cont(%x.(ft(x))(tt(x)))"
   4.911 - (fn prems =>
   4.912 -        [
   4.913 -        (rtac monocontlub2cont 1),
   4.914 -        (rtac mono2mono_app 1),
   4.915 -        (rtac cont2mono 1),
   4.916 -        (resolve_tac prems 1),
   4.917 -        (strip_tac 1),
   4.918 -        (rtac cont2mono 1),
   4.919 -        (cut_facts_tac prems 1),
   4.920 -        (etac spec 1),
   4.921 -        (rtac cont2mono 1),
   4.922 -        (resolve_tac prems 1),
   4.923 -        (rtac cont2contlub_app 1),
   4.924 -        (resolve_tac prems 1),
   4.925 -        (resolve_tac prems 1),
   4.926 -        (resolve_tac prems 1)
   4.927 -        ]);
   4.928 +Goal "[|cont(ft); !x. cont(ft(x)); cont(tt)|] ==> cont(%x.(ft(x))(tt(x)))";
   4.929 +by (blast_tac (claset() addIs [monocontlub2cont, mono2mono_app, cont2mono,
   4.930 +			       cont2contlub_app]) 1);
   4.931 +qed "cont2cont_app";
   4.932  
   4.933  
   4.934  bind_thm ("cont2cont_app2", allI RSN (2,cont2cont_app));
   4.935 @@ -603,69 +509,54 @@
   4.936  (* The identity function is continuous                                      *)
   4.937  (* ------------------------------------------------------------------------ *)
   4.938  
   4.939 -qed_goal "cont_id" thy "cont(% x. x)"
   4.940 - (fn prems =>
   4.941 -        [
   4.942 -        (rtac contI 1),
   4.943 -        (strip_tac 1),
   4.944 -        (etac thelubE 1),
   4.945 -        (rtac refl 1)
   4.946 -        ]);
   4.947 +val prems = goal thy "cont(% x. x)";
   4.948 +by (rtac contI 1);
   4.949 +by (strip_tac 1);
   4.950 +by (etac thelubE 1);
   4.951 +by (rtac refl 1);
   4.952 +qed "cont_id";
   4.953  
   4.954  (* ------------------------------------------------------------------------ *)
   4.955  (* constant functions are continuous                                        *)
   4.956  (* ------------------------------------------------------------------------ *)
   4.957  
   4.958 -qed_goalw "cont_const" thy [cont] "cont(%x. c)"
   4.959 - (fn prems =>
   4.960 -        [
   4.961 -        (strip_tac 1),
   4.962 -        (rtac is_lubI 1),
   4.963 -        (rtac conjI 1),
   4.964 -        (rtac ub_rangeI 1),
   4.965 -        (strip_tac 1),
   4.966 -        (rtac refl_less 1),
   4.967 -        (strip_tac 1),
   4.968 -        (dtac ub_rangeE 1),
   4.969 -        (etac spec 1)
   4.970 -        ]);
   4.971 +val prems = goalw thy [cont] "cont(%x. c)";
   4.972 +by (strip_tac 1);
   4.973 +by (rtac is_lubI 1);
   4.974 +by (rtac conjI 1);
   4.975 +by (rtac ub_rangeI 1);
   4.976 +by (strip_tac 1);
   4.977 +by (rtac refl_less 1);
   4.978 +by (strip_tac 1);
   4.979 +by (dtac ub_rangeE 1);
   4.980 +by (etac spec 1);
   4.981 +qed "cont_const";
   4.982  
   4.983  
   4.984 -qed_goal "cont2cont_app3" thy 
   4.985 - "[|cont(f);cont(t) |] ==> cont(%x. f(t(x)))"
   4.986 - (fn prems =>
   4.987 -        [
   4.988 -        (cut_facts_tac prems 1),
   4.989 -        (rtac cont2cont_app2 1),
   4.990 -        (rtac cont_const 1),
   4.991 -        (atac 1),
   4.992 -        (atac 1)
   4.993 -        ]);
   4.994 +Goal "[|cont(f); cont(t) |] ==> cont(%x. f(t(x)))";
   4.995 +by (best_tac (claset() addIs [ cont2cont_app2, cont_const]) 1);
   4.996 +qed "cont2cont_app3";
   4.997  
   4.998  (* ------------------------------------------------------------------------ *)
   4.999  (* A non-emptyness result for Cfun                                          *)
  4.1000  (* ------------------------------------------------------------------------ *)
  4.1001  
  4.1002 -qed_goal "CfunI" thy "?x:Collect cont"
  4.1003 - (fn prems =>
  4.1004 -        [
  4.1005 -        (rtac CollectI 1),
  4.1006 -        (rtac cont_const 1)
  4.1007 -        ]);
  4.1008 +val prems = goal thy "?x:Collect cont";
  4.1009 +by (rtac CollectI 1);
  4.1010 +by (rtac cont_const 1);
  4.1011 +qed "CfunI";
  4.1012  
  4.1013  (* ------------------------------------------------------------------------ *)
  4.1014 -(* some properties of flat			 			    *)
  4.1015 +(* some properties of flat                                                  *)
  4.1016  (* ------------------------------------------------------------------------ *)
  4.1017  
  4.1018 -qed_goalw "flatdom2monofun" thy [monofun]
  4.1019 -  "f UU = UU ==> monofun (f::'a::flat=>'b::pcpo)" 
  4.1020 -(fn prems => 
  4.1021 -	[
  4.1022 -	cut_facts_tac prems 1,
  4.1023 -	strip_tac 1,
  4.1024 -	dtac (ax_flat RS spec RS spec RS mp) 1,
  4.1025 -	fast_tac ((HOL_cs addss (simpset() addsimps [minimal]))) 1
  4.1026 -	]);
  4.1027 +val prems = goalw thy [monofun]
  4.1028 +  "f UU = UU ==> monofun (f::'a::flat=>'b::pcpo)";
  4.1029 +by (cut_facts_tac prems 1);
  4.1030 +by (strip_tac 1);
  4.1031 +by (dtac (ax_flat RS spec RS spec RS mp) 1);
  4.1032 +by (fast_tac ((HOL_cs addss (simpset() addsimps [minimal]))) 1);
  4.1033 +qed "flatdom2monofun";
  4.1034  
  4.1035  
  4.1036  Goal "monofun f ==> cont(f::'a::chfin=>'b::pcpo)";
     5.1 --- a/src/HOLCF/Cprod1.ML	Tue Jul 04 14:58:40 2000 +0200
     5.2 +++ b/src/HOLCF/Cprod1.ML	Tue Jul 04 15:58:11 2000 +0200
     5.3 @@ -3,46 +3,37 @@
     5.4      Author:     Franz Regensburger
     5.5      Copyright   1993  Technische Universitaet Muenchen
     5.6  
     5.7 -Lemmas for theory Cprod1.thy 
     5.8 +Partial ordering for cartesian product of HOL theory Prod.thy
     5.9  *)
    5.10  
    5.11 -open Cprod1;
    5.12 -
    5.13  
    5.14  (* ------------------------------------------------------------------------ *)
    5.15  (* less_cprod is a partial order on 'a * 'b                                 *)
    5.16  (* ------------------------------------------------------------------------ *)
    5.17  
    5.18 -qed_goal "Sel_injective_cprod" Prod.thy
    5.19 -        "[|fst x = fst y; snd x = snd y|] ==> x = y"
    5.20 -(fn prems =>
    5.21 -        [
    5.22 -        (cut_facts_tac prems 1),
    5.23 -        (subgoal_tac "(fst x,snd x)=(fst y,snd y)" 1),
    5.24 -        (rotate_tac ~1 1),
    5.25 -        (asm_full_simp_tac(HOL_ss addsimps[surjective_pairing RS sym])1),
    5.26 -        (asm_simp_tac (simpset_of Prod.thy) 1)
    5.27 -        ]);
    5.28 +val prems = goal Prod.thy
    5.29 +        "[|fst x = fst y; snd x = snd y|] ==> x = y";
    5.30 +by (cut_facts_tac prems 1);
    5.31 +by (subgoal_tac "(fst x,snd x)=(fst y,snd y)" 1);
    5.32 +by (rotate_tac ~1 1);
    5.33 +by (asm_full_simp_tac(HOL_ss addsimps[surjective_pairing RS sym])1);
    5.34 +by (asm_simp_tac (simpset_of Prod.thy) 1);
    5.35 +qed "Sel_injective_cprod";
    5.36  
    5.37 -qed_goalw "refl_less_cprod" Cprod1.thy [less_cprod_def] "(p::'a*'b) << p"
    5.38 - (fn prems => [Simp_tac 1]);
    5.39 +val prems = goalw Cprod1.thy [less_cprod_def] "(p::'a*'b) << p";
    5.40 +by (Simp_tac 1);
    5.41 +qed "refl_less_cprod";
    5.42  
    5.43 -qed_goalw "antisym_less_cprod" thy [less_cprod_def]
    5.44 -        "[|(p1::'a * 'b) << p2;p2 << p1|] ==> p1=p2"
    5.45 -(fn prems =>
    5.46 -        [
    5.47 -        (cut_facts_tac prems 1),
    5.48 -        (rtac Sel_injective_cprod 1),
    5.49 -        (fast_tac (HOL_cs addIs [antisym_less]) 1),
    5.50 -        (fast_tac (HOL_cs addIs [antisym_less]) 1)
    5.51 -        ]);
    5.52 +Goalw [less_cprod_def] "[|(p1::'a * 'b) << p2;p2 << p1|] ==> p1=p2";
    5.53 +by (rtac Sel_injective_cprod 1);
    5.54 +by (fast_tac (HOL_cs addIs [antisym_less]) 1);
    5.55 +by (fast_tac (HOL_cs addIs [antisym_less]) 1);
    5.56 +qed "antisym_less_cprod";
    5.57  
    5.58 -qed_goalw "trans_less_cprod" thy [less_cprod_def]
    5.59 -        "[|(p1::'a*'b) << p2;p2 << p3|] ==> p1 << p3"
    5.60 -(fn prems =>
    5.61 -        [
    5.62 -        (cut_facts_tac prems 1),
    5.63 -        (rtac conjI 1),
    5.64 -        (fast_tac (HOL_cs addIs [trans_less]) 1),
    5.65 -        (fast_tac (HOL_cs addIs [trans_less]) 1)
    5.66 -        ]);
    5.67 +val prems = goalw thy [less_cprod_def]
    5.68 +        "[|(p1::'a*'b) << p2;p2 << p3|] ==> p1 << p3";
    5.69 +by (cut_facts_tac prems 1);
    5.70 +by (rtac conjI 1);
    5.71 +by (fast_tac (HOL_cs addIs [trans_less]) 1);
    5.72 +by (fast_tac (HOL_cs addIs [trans_less]) 1);
    5.73 +qed "trans_less_cprod";
     6.1 --- a/src/HOLCF/Cprod2.ML	Tue Jul 04 14:58:40 2000 +0200
     6.2 +++ b/src/HOLCF/Cprod2.ML	Tue Jul 04 15:58:11 2000 +0200
     6.3 @@ -1,143 +1,120 @@
     6.4 -(*  Title:      HOLCF/cprod2.ML
     6.5 +(*  Title:      HOLCF/Cprod2
     6.6      ID:         $Id$
     6.7      Author:     Franz Regensburger
     6.8      Copyright   1993 Technische Universitaet Muenchen
     6.9  
    6.10 -Lemmas for cprod2.thy 
    6.11 +Class Instance *::(pcpo,pcpo)po
    6.12  *)
    6.13  
    6.14 -open Cprod2;
    6.15 -
    6.16  (* for compatibility with old HOLCF-Version *)
    6.17 -qed_goal "inst_cprod_po" thy "(op <<)=(%x y. fst x<<fst y & snd x<<snd y)"
    6.18 - (fn prems => 
    6.19 -        [
    6.20 -        (fold_goals_tac [less_cprod_def]),
    6.21 -        (rtac refl 1)
    6.22 -        ]);
    6.23 +val prems = goal thy "(op <<)=(%x y. fst x<<fst y & snd x<<snd y)";
    6.24 +by (fold_goals_tac [less_cprod_def]);
    6.25 +by (rtac refl 1);
    6.26 +qed "inst_cprod_po";
    6.27  
    6.28 -qed_goalw "less_cprod4c" thy [inst_cprod_po RS eq_reflection]
    6.29 - "(x1,y1) << (x2,y2) ==> x1 << x2 & y1 << y2"
    6.30 - (fn prems =>
    6.31 -        [
    6.32 -        (cut_facts_tac prems 1),
    6.33 -        (etac conjE 1),
    6.34 -        (dtac (fst_conv RS subst) 1),
    6.35 -        (dtac (fst_conv RS subst) 1),
    6.36 -        (dtac (fst_conv RS subst) 1),
    6.37 -        (dtac (snd_conv RS subst) 1),
    6.38 -        (dtac (snd_conv RS subst) 1),
    6.39 -        (dtac (snd_conv RS subst) 1),
    6.40 -        (rtac conjI 1),
    6.41 -        (atac 1),
    6.42 -        (atac 1)
    6.43 -        ]);
    6.44 +val prems = goalw thy [inst_cprod_po RS eq_reflection] 
    6.45 + "(x1,y1) << (x2,y2) ==> x1 << x2 & y1 << y2";
    6.46 +by (cut_facts_tac prems 1);
    6.47 +by (etac conjE 1);
    6.48 +by (dtac (fst_conv RS subst) 1);
    6.49 +by (dtac (fst_conv RS subst) 1);
    6.50 +by (dtac (fst_conv RS subst) 1);
    6.51 +by (dtac (snd_conv RS subst) 1);
    6.52 +by (dtac (snd_conv RS subst) 1);
    6.53 +by (dtac (snd_conv RS subst) 1);
    6.54 +by (rtac conjI 1);
    6.55 +by (atac 1);
    6.56 +by (atac 1);
    6.57 +qed "less_cprod4c";
    6.58  
    6.59  (* ------------------------------------------------------------------------ *)
    6.60  (* type cprod is pointed                                                    *)
    6.61  (* ------------------------------------------------------------------------ *)
    6.62  
    6.63 -qed_goal "minimal_cprod" thy  "(UU,UU)<<p"
    6.64 -(fn prems =>
    6.65 -        [
    6.66 -        (simp_tac(simpset() addsimps[inst_cprod_po])1)
    6.67 -        ]);
    6.68 +val prems = goal thy  "(UU,UU)<<p";
    6.69 +by (simp_tac(simpset() addsimps[inst_cprod_po])1);
    6.70 +qed "minimal_cprod";
    6.71  
    6.72  bind_thm ("UU_cprod_def",minimal_cprod RS minimal2UU RS sym);
    6.73  
    6.74 -qed_goal "least_cprod" thy "? x::'a*'b.!y. x<<y"
    6.75 -(fn prems =>
    6.76 -        [
    6.77 -        (res_inst_tac [("x","(UU,UU)")] exI 1),
    6.78 -        (rtac (minimal_cprod RS allI) 1)
    6.79 -        ]);
    6.80 +val prems = goal thy "? x::'a*'b.!y. x<<y";
    6.81 +by (res_inst_tac [("x","(UU,UU)")] exI 1);
    6.82 +by (rtac (minimal_cprod RS allI) 1);
    6.83 +qed "least_cprod";
    6.84  
    6.85  (* ------------------------------------------------------------------------ *)
    6.86  (* Pair <_,_>  is monotone in both arguments                                *)
    6.87  (* ------------------------------------------------------------------------ *)
    6.88  
    6.89 -qed_goalw "monofun_pair1" thy [monofun] "monofun Pair"
    6.90 - (fn prems =>
    6.91 -        [
    6.92 -        (strip_tac 1),
    6.93 -        (rtac (less_fun RS iffD2) 1),
    6.94 -        (strip_tac 1),
    6.95 -        (asm_simp_tac (simpset() addsimps [inst_cprod_po]) 1)
    6.96 -        ]);
    6.97 +val prems = goalw thy [monofun]  "monofun Pair";
    6.98 +by (strip_tac 1);
    6.99 +by (rtac (less_fun RS iffD2) 1);
   6.100 +by (strip_tac 1);
   6.101 +by (asm_simp_tac (simpset() addsimps [inst_cprod_po]) 1);
   6.102 +qed "monofun_pair1";
   6.103  
   6.104 -qed_goalw "monofun_pair2" thy [monofun] "monofun(Pair x)"
   6.105 - (fn prems =>
   6.106 -        [
   6.107 -        (asm_simp_tac (simpset() addsimps [inst_cprod_po]) 1)
   6.108 -        ]);
   6.109 +val prems = goalw thy [monofun]  "monofun(Pair x)";
   6.110 +by (asm_simp_tac (simpset() addsimps [inst_cprod_po]) 1);
   6.111 +qed "monofun_pair2";
   6.112  
   6.113 -qed_goal "monofun_pair" thy "[|x1<<x2; y1<<y2|] ==> (x1::'a::cpo,y1::'b::cpo)<<(x2,y2)"
   6.114 - (fn prems =>
   6.115 -        [
   6.116 -        (cut_facts_tac prems 1),
   6.117 -        (rtac trans_less 1),
   6.118 -        (rtac (monofun_pair1 RS monofunE RS spec RS spec RS mp RS 
   6.119 -        (less_fun RS iffD1 RS spec)) 1),
   6.120 -        (rtac (monofun_pair2 RS monofunE RS spec RS spec RS mp) 2),
   6.121 -        (atac 1),
   6.122 -        (atac 1)
   6.123 -        ]);
   6.124 +val prems = goal thy "[|x1<<x2; y1<<y2|] ==> (x1::'a::cpo,y1::'b::cpo)<<(x2,y2)";
   6.125 +by (cut_facts_tac prems 1);
   6.126 +by (rtac trans_less 1);
   6.127 +by (rtac (monofun_pair1 RS monofunE RS spec RS spec RS mp RS (less_fun RS iffD1 RS spec)) 1);
   6.128 +by (rtac (monofun_pair2 RS monofunE RS spec RS spec RS mp) 2);
   6.129 +by (atac 1);
   6.130 +by (atac 1);
   6.131 +qed "monofun_pair";
   6.132  
   6.133  (* ------------------------------------------------------------------------ *)
   6.134  (* fst and snd are monotone                                                 *)
   6.135  (* ------------------------------------------------------------------------ *)
   6.136  
   6.137 -qed_goalw "monofun_fst" thy [monofun] "monofun fst"
   6.138 - (fn prems =>
   6.139 -        [
   6.140 -        (strip_tac 1),
   6.141 -        (res_inst_tac [("p","x")] PairE 1),
   6.142 -        (hyp_subst_tac 1),
   6.143 -        (res_inst_tac [("p","y")] PairE 1),
   6.144 -        (hyp_subst_tac 1),
   6.145 -        (Asm_simp_tac  1),
   6.146 -        (etac (less_cprod4c RS conjunct1) 1)
   6.147 -        ]);
   6.148 +val prems = goalw thy [monofun]  "monofun fst";
   6.149 +by (strip_tac 1);
   6.150 +by (res_inst_tac [("p","x")] PairE 1);
   6.151 +by (hyp_subst_tac 1);
   6.152 +by (res_inst_tac [("p","y")] PairE 1);
   6.153 +by (hyp_subst_tac 1);
   6.154 +by (Asm_simp_tac  1);
   6.155 +by (etac (less_cprod4c RS conjunct1) 1);
   6.156 +qed "monofun_fst";
   6.157  
   6.158 -qed_goalw "monofun_snd" thy [monofun] "monofun snd"
   6.159 - (fn prems =>
   6.160 -        [
   6.161 -        (strip_tac 1),
   6.162 -        (res_inst_tac [("p","x")] PairE 1),
   6.163 -        (hyp_subst_tac 1),
   6.164 -        (res_inst_tac [("p","y")] PairE 1),
   6.165 -        (hyp_subst_tac 1),
   6.166 -        (Asm_simp_tac  1),
   6.167 -        (etac (less_cprod4c RS conjunct2) 1)
   6.168 -        ]);
   6.169 +val prems = goalw thy [monofun]  "monofun snd";
   6.170 +by (strip_tac 1);
   6.171 +by (res_inst_tac [("p","x")] PairE 1);
   6.172 +by (hyp_subst_tac 1);
   6.173 +by (res_inst_tac [("p","y")] PairE 1);
   6.174 +by (hyp_subst_tac 1);
   6.175 +by (Asm_simp_tac  1);
   6.176 +by (etac (less_cprod4c RS conjunct2) 1);
   6.177 +qed "monofun_snd";
   6.178  
   6.179  (* ------------------------------------------------------------------------ *)
   6.180  (* the type 'a * 'b is a cpo                                                *)
   6.181  (* ------------------------------------------------------------------------ *)
   6.182  
   6.183 -qed_goal "lub_cprod" thy 
   6.184 -"chain S ==> range S<<|(lub(range(%i. fst(S i))),lub(range(%i. snd(S i))))"
   6.185 - (fn prems =>
   6.186 -        [
   6.187 -        (cut_facts_tac prems 1),
   6.188 -        (rtac (conjI RS is_lubI) 1),
   6.189 -        (rtac (allI RS ub_rangeI) 1),
   6.190 -        (res_inst_tac [("t","S i")] (surjective_pairing RS ssubst) 1),
   6.191 -        (rtac monofun_pair 1),
   6.192 -        (rtac is_ub_thelub 1),
   6.193 -        (etac (monofun_fst RS ch2ch_monofun) 1),
   6.194 -        (rtac is_ub_thelub 1),
   6.195 -        (etac (monofun_snd RS ch2ch_monofun) 1),
   6.196 -        (strip_tac 1),
   6.197 -        (res_inst_tac [("t","u")] (surjective_pairing RS ssubst) 1),
   6.198 -        (rtac monofun_pair 1),
   6.199 -        (rtac is_lub_thelub 1),
   6.200 -        (etac (monofun_fst RS ch2ch_monofun) 1),
   6.201 -        (etac (monofun_fst RS ub2ub_monofun) 1),
   6.202 -        (rtac is_lub_thelub 1),
   6.203 -        (etac (monofun_snd RS ch2ch_monofun) 1),
   6.204 -        (etac (monofun_snd RS ub2ub_monofun) 1)
   6.205 -        ]);
   6.206 +val prems = goal thy 
   6.207 +"chain S ==> range S<<|(lub(range(%i. fst(S i))),lub(range(%i. snd(S i))))";
   6.208 +by (cut_facts_tac prems 1);
   6.209 +by (rtac (conjI RS is_lubI) 1);
   6.210 +by (rtac (allI RS ub_rangeI) 1);
   6.211 +by (res_inst_tac [("t","S i")] (surjective_pairing RS ssubst) 1);
   6.212 +by (rtac monofun_pair 1);
   6.213 +by (rtac is_ub_thelub 1);
   6.214 +by (etac (monofun_fst RS ch2ch_monofun) 1);
   6.215 +by (rtac is_ub_thelub 1);
   6.216 +by (etac (monofun_snd RS ch2ch_monofun) 1);
   6.217 +by (strip_tac 1);
   6.218 +by (res_inst_tac [("t","u")] (surjective_pairing RS ssubst) 1);
   6.219 +by (rtac monofun_pair 1);
   6.220 +by (rtac is_lub_thelub 1);
   6.221 +by (etac (monofun_fst RS ch2ch_monofun) 1);
   6.222 +by (etac (monofun_fst RS ub2ub_monofun) 1);
   6.223 +by (rtac is_lub_thelub 1);
   6.224 +by (etac (monofun_snd RS ch2ch_monofun) 1);
   6.225 +by (etac (monofun_snd RS ub2ub_monofun) 1);
   6.226 +qed "lub_cprod";
   6.227  
   6.228  bind_thm ("thelub_cprod", lub_cprod RS thelubI);
   6.229  (*
   6.230 @@ -147,12 +124,10 @@
   6.231  
   6.232  *)
   6.233  
   6.234 -qed_goal "cpo_cprod" thy "chain(S::nat=>'a::cpo*'b::cpo)==>? x. range S<<| x"
   6.235 -(fn prems =>
   6.236 -        [
   6.237 -        (cut_facts_tac prems 1),
   6.238 -        (rtac exI 1),
   6.239 -        (etac lub_cprod 1)
   6.240 -        ]);
   6.241 +val prems = goal thy "chain(S::nat=>'a::cpo*'b::cpo)==>? x. range S<<| x";
   6.242 +by (cut_facts_tac prems 1);
   6.243 +by (rtac exI 1);
   6.244 +by (etac lub_cprod 1);
   6.245 +qed "cpo_cprod";
   6.246  
   6.247  
     7.1 --- a/src/HOLCF/Cprod3.ML	Tue Jul 04 14:58:40 2000 +0200
     7.2 +++ b/src/HOLCF/Cprod3.ML	Tue Jul 04 15:58:11 2000 +0200
     7.3 @@ -1,143 +1,119 @@
     7.4 -(*  Title:      HOLCF/cprod3.ML
     7.5 +(*  Title:      HOLCF/Cprod3
     7.6      ID:         $Id$
     7.7      Author:     Franz Regensburger
     7.8      Copyright   1993 Technische Universitaet Muenchen
     7.9  
    7.10 -Lemmas for Cprod3.thy 
    7.11 +Class instance of * for class pcpo and cpo.
    7.12  *)
    7.13  
    7.14 -open Cprod3;
    7.15 -
    7.16  (* for compatibility with old HOLCF-Version *)
    7.17 -qed_goal "inst_cprod_pcpo" thy "UU = (UU,UU)"
    7.18 - (fn prems => 
    7.19 -        [
    7.20 -        (simp_tac (HOL_ss addsimps [UU_def,UU_cprod_def]) 1)
    7.21 -        ]);
    7.22 +val prems = goal thy "UU = (UU,UU)";
    7.23 +by (simp_tac (HOL_ss addsimps [UU_def,UU_cprod_def]) 1);
    7.24 +qed "inst_cprod_pcpo";
    7.25  
    7.26  (* ------------------------------------------------------------------------ *)
    7.27  (* continuity of (_,_) , fst, snd                                           *)
    7.28  (* ------------------------------------------------------------------------ *)
    7.29  
    7.30 -qed_goal "Cprod3_lemma1" Cprod3.thy 
    7.31 +val prems = goal Cprod3.thy 
    7.32  "chain(Y::(nat=>'a::cpo)) ==>\
    7.33  \ (lub(range(Y)),(x::'b::cpo)) =\
    7.34 -\ (lub(range(%i. fst(Y i,x))),lub(range(%i. snd(Y i,x))))"
    7.35 - (fn prems =>
    7.36 -        [
    7.37 -        (cut_facts_tac prems 1),
    7.38 -        (res_inst_tac [("f1","Pair")] (arg_cong RS cong) 1),
    7.39 -        (rtac lub_equal 1),
    7.40 -        (atac 1),
    7.41 -        (rtac (monofun_fst RS ch2ch_monofun) 1),
    7.42 -        (rtac ch2ch_fun 1),
    7.43 -        (rtac (monofun_pair1 RS ch2ch_monofun) 1),
    7.44 -        (atac 1),
    7.45 -        (rtac allI 1),
    7.46 -        (Simp_tac 1),
    7.47 -        (rtac sym 1),
    7.48 -        (Simp_tac 1),
    7.49 -        (rtac (lub_const RS thelubI) 1)
    7.50 -        ]);
    7.51 +\ (lub(range(%i. fst(Y i,x))),lub(range(%i. snd(Y i,x))))";
    7.52 +by (cut_facts_tac prems 1);
    7.53 +by (res_inst_tac [("f1","Pair")] (arg_cong RS cong) 1);
    7.54 +by (rtac lub_equal 1);
    7.55 +by (atac 1);
    7.56 +by (rtac (monofun_fst RS ch2ch_monofun) 1);
    7.57 +by (rtac ch2ch_fun 1);
    7.58 +by (rtac (monofun_pair1 RS ch2ch_monofun) 1);
    7.59 +by (atac 1);
    7.60 +by (rtac allI 1);
    7.61 +by (Simp_tac 1);
    7.62 +by (rtac sym 1);
    7.63 +by (Simp_tac 1);
    7.64 +by (rtac (lub_const RS thelubI) 1);
    7.65 +qed "Cprod3_lemma1";
    7.66  
    7.67 -qed_goal "contlub_pair1" Cprod3.thy "contlub(Pair)"
    7.68 - (fn prems =>
    7.69 -        [
    7.70 -        (rtac contlubI 1),
    7.71 -        (strip_tac 1),
    7.72 -        (rtac (expand_fun_eq RS iffD2) 1),
    7.73 -        (strip_tac 1),
    7.74 -        (stac (lub_fun RS thelubI) 1),
    7.75 -        (etac (monofun_pair1 RS ch2ch_monofun) 1),
    7.76 -        (rtac trans 1),
    7.77 -        (rtac (thelub_cprod RS sym) 2),
    7.78 -        (rtac ch2ch_fun 2),
    7.79 -        (etac (monofun_pair1 RS ch2ch_monofun) 2),
    7.80 -        (etac Cprod3_lemma1 1)
    7.81 -        ]);
    7.82 +val prems = goal Cprod3.thy "contlub(Pair)";
    7.83 +by (rtac contlubI 1);
    7.84 +by (strip_tac 1);
    7.85 +by (rtac (expand_fun_eq RS iffD2) 1);
    7.86 +by (strip_tac 1);
    7.87 +by (stac (lub_fun RS thelubI) 1);
    7.88 +by (etac (monofun_pair1 RS ch2ch_monofun) 1);
    7.89 +by (rtac trans 1);
    7.90 +by (rtac (thelub_cprod RS sym) 2);
    7.91 +by (rtac ch2ch_fun 2);
    7.92 +by (etac (monofun_pair1 RS ch2ch_monofun) 2);
    7.93 +by (etac Cprod3_lemma1 1);
    7.94 +qed "contlub_pair1";
    7.95  
    7.96 -qed_goal "Cprod3_lemma2" Cprod3.thy 
    7.97 +val prems = goal Cprod3.thy 
    7.98  "chain(Y::(nat=>'a::cpo)) ==>\
    7.99  \ ((x::'b::cpo),lub(range Y)) =\
   7.100 -\ (lub(range(%i. fst(x,Y i))),lub(range(%i. snd(x, Y i))))"
   7.101 - (fn prems =>
   7.102 -        [
   7.103 -        (cut_facts_tac prems 1),
   7.104 -        (res_inst_tac [("f1","Pair")] (arg_cong RS cong) 1),
   7.105 -        (rtac sym 1),
   7.106 -        (Simp_tac 1),
   7.107 -        (rtac (lub_const RS thelubI) 1),
   7.108 -        (rtac lub_equal 1),
   7.109 -        (atac 1),
   7.110 -        (rtac (monofun_snd RS ch2ch_monofun) 1),
   7.111 -        (rtac (monofun_pair2 RS ch2ch_monofun) 1),
   7.112 -        (atac 1),
   7.113 -        (rtac allI 1),
   7.114 -        (Simp_tac 1)
   7.115 -        ]);
   7.116 +\ (lub(range(%i. fst(x,Y i))),lub(range(%i. snd(x, Y i))))";
   7.117 +by (cut_facts_tac prems 1);
   7.118 +by (res_inst_tac [("f1","Pair")] (arg_cong RS cong) 1);
   7.119 +by (rtac sym 1);
   7.120 +by (Simp_tac 1);
   7.121 +by (rtac (lub_const RS thelubI) 1);
   7.122 +by (rtac lub_equal 1);
   7.123 +by (atac 1);
   7.124 +by (rtac (monofun_snd RS ch2ch_monofun) 1);
   7.125 +by (rtac (monofun_pair2 RS ch2ch_monofun) 1);
   7.126 +by (atac 1);
   7.127 +by (rtac allI 1);
   7.128 +by (Simp_tac 1);
   7.129 +qed "Cprod3_lemma2";
   7.130  
   7.131 -qed_goal "contlub_pair2" Cprod3.thy "contlub(Pair(x))"
   7.132 - (fn prems =>
   7.133 -        [
   7.134 -        (rtac contlubI 1),
   7.135 -        (strip_tac 1),
   7.136 -        (rtac trans 1),
   7.137 -        (rtac (thelub_cprod RS sym) 2),
   7.138 -        (etac (monofun_pair2 RS ch2ch_monofun) 2),
   7.139 -        (etac Cprod3_lemma2 1)
   7.140 -        ]);
   7.141 +val prems = goal Cprod3.thy "contlub(Pair(x))";
   7.142 +by (rtac contlubI 1);
   7.143 +by (strip_tac 1);
   7.144 +by (rtac trans 1);
   7.145 +by (rtac (thelub_cprod RS sym) 2);
   7.146 +by (etac (monofun_pair2 RS ch2ch_monofun) 2);
   7.147 +by (etac Cprod3_lemma2 1);
   7.148 +qed "contlub_pair2";
   7.149  
   7.150 -qed_goal "cont_pair1" Cprod3.thy "cont(Pair)"
   7.151 -(fn prems =>
   7.152 -        [
   7.153 -        (rtac monocontlub2cont 1),
   7.154 -        (rtac monofun_pair1 1),
   7.155 -        (rtac contlub_pair1 1)
   7.156 -        ]);
   7.157 +val prems = goal Cprod3.thy "cont(Pair)";
   7.158 +by (rtac monocontlub2cont 1);
   7.159 +by (rtac monofun_pair1 1);
   7.160 +by (rtac contlub_pair1 1);
   7.161 +qed "cont_pair1";
   7.162  
   7.163 -qed_goal "cont_pair2" Cprod3.thy "cont(Pair(x))"
   7.164 -(fn prems =>
   7.165 -        [
   7.166 -        (rtac monocontlub2cont 1),
   7.167 -        (rtac monofun_pair2 1),
   7.168 -        (rtac contlub_pair2 1)
   7.169 -        ]);
   7.170 +val prems = goal Cprod3.thy "cont(Pair(x))";
   7.171 +by (rtac monocontlub2cont 1);
   7.172 +by (rtac monofun_pair2 1);
   7.173 +by (rtac contlub_pair2 1);
   7.174 +qed "cont_pair2";
   7.175  
   7.176 -qed_goal "contlub_fst" Cprod3.thy "contlub(fst)"
   7.177 - (fn prems =>
   7.178 -        [
   7.179 -        (rtac contlubI 1),
   7.180 -        (strip_tac 1),
   7.181 -        (stac (lub_cprod RS thelubI) 1),
   7.182 -        (atac 1),
   7.183 -        (Simp_tac 1)
   7.184 -        ]);
   7.185 +val prems = goal Cprod3.thy "contlub(fst)";
   7.186 +by (rtac contlubI 1);
   7.187 +by (strip_tac 1);
   7.188 +by (stac (lub_cprod RS thelubI) 1);
   7.189 +by (atac 1);
   7.190 +by (Simp_tac 1);
   7.191 +qed "contlub_fst";
   7.192  
   7.193 -qed_goal "contlub_snd" Cprod3.thy "contlub(snd)"
   7.194 - (fn prems =>
   7.195 -        [
   7.196 -        (rtac contlubI 1),
   7.197 -        (strip_tac 1),
   7.198 -        (stac (lub_cprod RS thelubI) 1),
   7.199 -        (atac 1),
   7.200 -        (Simp_tac 1)
   7.201 -        ]);
   7.202 +val prems = goal Cprod3.thy "contlub(snd)";
   7.203 +by (rtac contlubI 1);
   7.204 +by (strip_tac 1);
   7.205 +by (stac (lub_cprod RS thelubI) 1);
   7.206 +by (atac 1);
   7.207 +by (Simp_tac 1);
   7.208 +qed "contlub_snd";
   7.209  
   7.210 -qed_goal "cont_fst" Cprod3.thy "cont(fst)"
   7.211 -(fn prems =>
   7.212 -        [
   7.213 -        (rtac monocontlub2cont 1),
   7.214 -        (rtac monofun_fst 1),
   7.215 -        (rtac contlub_fst 1)
   7.216 -        ]);
   7.217 +val prems = goal Cprod3.thy "cont(fst)";
   7.218 +by (rtac monocontlub2cont 1);
   7.219 +by (rtac monofun_fst 1);
   7.220 +by (rtac contlub_fst 1);
   7.221 +qed "cont_fst";
   7.222  
   7.223 -qed_goal "cont_snd" Cprod3.thy "cont(snd)"
   7.224 -(fn prems =>
   7.225 -        [
   7.226 -        (rtac monocontlub2cont 1),
   7.227 -        (rtac monofun_snd 1),
   7.228 -        (rtac contlub_snd 1)
   7.229 -        ]);
   7.230 +val prems = goal Cprod3.thy "cont(snd)";
   7.231 +by (rtac monocontlub2cont 1);
   7.232 +by (rtac monofun_snd 1);
   7.233 +by (rtac contlub_snd 1);
   7.234 +qed "cont_snd";
   7.235  
   7.236  (* 
   7.237   -------------------------------------------------------------------------- 
   7.238 @@ -150,130 +126,109 @@
   7.239  (* convert all lemmas to the continuous versions                            *)
   7.240  (* ------------------------------------------------------------------------ *)
   7.241  
   7.242 -qed_goalw "beta_cfun_cprod" Cprod3.thy [cpair_def]
   7.243 -        "(LAM x y.(x,y))`a`b = (a,b)"
   7.244 - (fn prems =>
   7.245 -        [
   7.246 -        (stac beta_cfun 1),
   7.247 -        (simp_tac (simpset() addsimps [cont_pair1,cont_pair2,cont2cont_CF1L]) 1),
   7.248 -        (stac beta_cfun 1),
   7.249 -        (rtac cont_pair2 1),
   7.250 -        (rtac refl 1)
   7.251 -        ]);
   7.252 +val prems = goalw Cprod3.thy [cpair_def]
   7.253 +        "(LAM x y.(x,y))`a`b = (a,b)";
   7.254 +by (stac beta_cfun 1);
   7.255 +by (simp_tac (simpset() addsimps [cont_pair1,cont_pair2,cont2cont_CF1L]) 1);
   7.256 +by (stac beta_cfun 1);
   7.257 +by (rtac cont_pair2 1);
   7.258 +by (rtac refl 1);
   7.259 +qed "beta_cfun_cprod";
   7.260  
   7.261 -qed_goalw "inject_cpair" Cprod3.thy [cpair_def]
   7.262 -        " <a,b>=<aa,ba>  ==> a=aa & b=ba"
   7.263 - (fn prems =>
   7.264 -        [
   7.265 -        (cut_facts_tac prems 1),
   7.266 -        (dtac (beta_cfun_cprod RS subst) 1),
   7.267 -        (dtac (beta_cfun_cprod RS subst) 1),
   7.268 -        (etac Pair_inject 1),
   7.269 -        (fast_tac HOL_cs 1)
   7.270 -        ]);
   7.271 +val prems = goalw Cprod3.thy [cpair_def]
   7.272 +        " <a,b>=<aa,ba>  ==> a=aa & b=ba";
   7.273 +by (cut_facts_tac prems 1);
   7.274 +by (dtac (beta_cfun_cprod RS subst) 1);
   7.275 +by (dtac (beta_cfun_cprod RS subst) 1);
   7.276 +by (etac Pair_inject 1);
   7.277 +by (fast_tac HOL_cs 1);
   7.278 +qed "inject_cpair";
   7.279  
   7.280 -qed_goalw "inst_cprod_pcpo2" Cprod3.thy [cpair_def] "UU = <UU,UU>"
   7.281 - (fn prems =>
   7.282 -        [
   7.283 -        (rtac sym 1),
   7.284 -        (rtac trans 1),
   7.285 -        (rtac beta_cfun_cprod 1),
   7.286 -        (rtac sym 1),
   7.287 -        (rtac inst_cprod_pcpo 1)
   7.288 -        ]);
   7.289 +val prems = goalw Cprod3.thy [cpair_def] "UU = <UU,UU>";
   7.290 +by (rtac sym 1);
   7.291 +by (rtac trans 1);
   7.292 +by (rtac beta_cfun_cprod 1);
   7.293 +by (rtac sym 1);
   7.294 +by (rtac inst_cprod_pcpo 1);
   7.295 +qed "inst_cprod_pcpo2";
   7.296  
   7.297 -qed_goal "defined_cpair_rev" Cprod3.thy
   7.298 - "<a,b> = UU ==> a = UU & b = UU"
   7.299 - (fn prems =>
   7.300 -        [
   7.301 -        (cut_facts_tac prems 1),
   7.302 -        (dtac (inst_cprod_pcpo2 RS subst) 1),
   7.303 -        (etac inject_cpair 1)
   7.304 -        ]);
   7.305 +val prems = goal Cprod3.thy
   7.306 + "<a,b> = UU ==> a = UU & b = UU";
   7.307 +by (cut_facts_tac prems 1);
   7.308 +by (dtac (inst_cprod_pcpo2 RS subst) 1);
   7.309 +by (etac inject_cpair 1);
   7.310 +qed "defined_cpair_rev";
   7.311  
   7.312 -qed_goalw "Exh_Cprod2" Cprod3.thy [cpair_def]
   7.313 -        "? a b. z=<a,b>"
   7.314 - (fn prems =>
   7.315 -        [
   7.316 -        (rtac PairE 1),
   7.317 -        (rtac exI 1),
   7.318 -        (rtac exI 1),
   7.319 -        (etac (beta_cfun_cprod RS ssubst) 1)
   7.320 -        ]);
   7.321 +val prems = goalw Cprod3.thy [cpair_def]
   7.322 +        "? a b. z=<a,b>";
   7.323 +by (rtac PairE 1);
   7.324 +by (rtac exI 1);
   7.325 +by (rtac exI 1);
   7.326 +by (etac (beta_cfun_cprod RS ssubst) 1);
   7.327 +qed "Exh_Cprod2";
   7.328  
   7.329 -qed_goalw "cprodE" Cprod3.thy [cpair_def]
   7.330 -"[|!!x y. [|p=<x,y> |] ==> Q|] ==> Q"
   7.331 - (fn prems =>
   7.332 -        [
   7.333 -        (rtac PairE 1),
   7.334 -        (resolve_tac prems 1),
   7.335 -        (etac (beta_cfun_cprod RS ssubst) 1)
   7.336 -        ]);
   7.337 +val prems = goalw Cprod3.thy [cpair_def]
   7.338 +"[|!!x y. [|p=<x,y> |] ==> Q|] ==> Q";
   7.339 +by (rtac PairE 1);
   7.340 +by (resolve_tac prems 1);
   7.341 +by (etac (beta_cfun_cprod RS ssubst) 1);
   7.342 +qed "cprodE";
   7.343  
   7.344 -qed_goalw "cfst2" Cprod3.thy [cfst_def,cpair_def] 
   7.345 -        "cfst`<x,y>=x"
   7.346 - (fn prems =>
   7.347 -        [
   7.348 -        (cut_facts_tac prems 1),
   7.349 -        (stac beta_cfun_cprod 1),
   7.350 -        (stac beta_cfun 1),
   7.351 -        (rtac cont_fst 1),
   7.352 -        (Simp_tac  1)
   7.353 -        ]);
   7.354 +val prems = goalw Cprod3.thy [cfst_def,cpair_def] 
   7.355 +        "cfst`<x,y>=x";
   7.356 +by (cut_facts_tac prems 1);
   7.357 +by (stac beta_cfun_cprod 1);
   7.358 +by (stac beta_cfun 1);
   7.359 +by (rtac cont_fst 1);
   7.360 +by (Simp_tac  1);
   7.361 +qed "cfst2";
   7.362  
   7.363 -qed_goalw "csnd2" Cprod3.thy [csnd_def,cpair_def] 
   7.364 -        "csnd`<x,y>=y"
   7.365 - (fn prems =>
   7.366 -        [
   7.367 -        (cut_facts_tac prems 1),
   7.368 -        (stac beta_cfun_cprod 1),
   7.369 -        (stac beta_cfun 1),
   7.370 -        (rtac cont_snd 1),
   7.371 -        (Simp_tac  1)
   7.372 -        ]);
   7.373 +val prems = goalw Cprod3.thy [csnd_def,cpair_def] 
   7.374 +        "csnd`<x,y>=y";
   7.375 +by (cut_facts_tac prems 1);
   7.376 +by (stac beta_cfun_cprod 1);
   7.377 +by (stac beta_cfun 1);
   7.378 +by (rtac cont_snd 1);
   7.379 +by (Simp_tac  1);
   7.380 +qed "csnd2";
   7.381  
   7.382 -qed_goal "cfst_strict" Cprod3.thy "cfst`UU = UU" (fn _ => [
   7.383 -             (simp_tac (HOL_ss addsimps [inst_cprod_pcpo2,cfst2]) 1)]);
   7.384 -qed_goal "csnd_strict" Cprod3.thy "csnd`UU = UU" (fn _ => [
   7.385 -             (simp_tac (HOL_ss addsimps [inst_cprod_pcpo2,csnd2]) 1)]);
   7.386 +val _ = goal Cprod3.thy "cfst`UU = UU";
   7.387 +by (simp_tac (HOL_ss addsimps [inst_cprod_pcpo2,cfst2]) 1);
   7.388 +qed "cfst_strict";
   7.389 +val _ = goal Cprod3.thy "csnd`UU = UU";
   7.390 +by (simp_tac (HOL_ss addsimps [inst_cprod_pcpo2,csnd2]) 1);
   7.391 +qed "csnd_strict";
   7.392  
   7.393 -qed_goalw "surjective_pairing_Cprod2" Cprod3.thy 
   7.394 -        [cfst_def,csnd_def,cpair_def] "<cfst`p , csnd`p> = p"
   7.395 - (fn prems =>
   7.396 -        [
   7.397 -        (stac beta_cfun_cprod 1),
   7.398 -        (stac beta_cfun 1),
   7.399 -        (rtac cont_snd 1),
   7.400 -        (stac beta_cfun 1),
   7.401 -        (rtac cont_fst 1),
   7.402 -        (rtac (surjective_pairing RS sym) 1)
   7.403 -        ]);
   7.404 +val prems = goalw Cprod3.thy [cfst_def,csnd_def,cpair_def] "<cfst`p , csnd`p> = p";
   7.405 +by (stac beta_cfun_cprod 1);
   7.406 +by (stac beta_cfun 1);
   7.407 +by (rtac cont_snd 1);
   7.408 +by (stac beta_cfun 1);
   7.409 +by (rtac cont_fst 1);
   7.410 +by (rtac (surjective_pairing RS sym) 1);
   7.411 +qed "surjective_pairing_Cprod2";
   7.412  
   7.413 -qed_goalw "less_cprod5c" Cprod3.thy [cfst_def,csnd_def,cpair_def]
   7.414 - "<xa,ya> << <x,y> ==> xa<<x & ya << y"
   7.415 - (fn prems =>
   7.416 -        [
   7.417 -        (cut_facts_tac prems 1),
   7.418 -        (rtac less_cprod4c 1),
   7.419 -        (dtac (beta_cfun_cprod RS subst) 1),
   7.420 -        (dtac (beta_cfun_cprod RS subst) 1),
   7.421 -        (atac 1)
   7.422 -        ]);
   7.423 +val prems = goalw Cprod3.thy [cfst_def,csnd_def,cpair_def]
   7.424 + "<xa,ya> << <x,y> ==> xa<<x & ya << y";
   7.425 +by (cut_facts_tac prems 1);
   7.426 +by (rtac less_cprod4c 1);
   7.427 +by (dtac (beta_cfun_cprod RS subst) 1);
   7.428 +by (dtac (beta_cfun_cprod RS subst) 1);
   7.429 +by (atac 1);
   7.430 +qed "less_cprod5c";
   7.431  
   7.432 -qed_goalw "lub_cprod2" Cprod3.thy [cfst_def,csnd_def,cpair_def]
   7.433 +val prems = goalw Cprod3.thy [cfst_def,csnd_def,cpair_def]
   7.434  "[|chain(S)|] ==> range(S) <<| \
   7.435 -\ <(lub(range(%i. cfst`(S i)))) , lub(range(%i. csnd`(S i)))>"
   7.436 - (fn prems =>
   7.437 -        [
   7.438 -        (cut_facts_tac prems 1),
   7.439 -        (stac beta_cfun_cprod 1),
   7.440 -        (stac (beta_cfun RS ext) 1),
   7.441 -        (rtac cont_snd 1),
   7.442 -        (stac (beta_cfun RS ext) 1),
   7.443 -        (rtac cont_fst 1),
   7.444 -        (rtac lub_cprod 1),
   7.445 -        (atac 1)
   7.446 -        ]);
   7.447 +\ <(lub(range(%i. cfst`(S i)))) , lub(range(%i. csnd`(S i)))>";
   7.448 +by (cut_facts_tac prems 1);
   7.449 +by (stac beta_cfun_cprod 1);
   7.450 +by (stac (beta_cfun RS ext) 1);
   7.451 +by (rtac cont_snd 1);
   7.452 +by (stac (beta_cfun RS ext) 1);
   7.453 +by (rtac cont_fst 1);
   7.454 +by (rtac lub_cprod 1);
   7.455 +by (atac 1);
   7.456 +qed "lub_cprod2";
   7.457  
   7.458  bind_thm ("thelub_cprod2", lub_cprod2 RS thelubI);
   7.459  (*
   7.460 @@ -281,23 +236,19 @@
   7.461   lub (range ?S1) =
   7.462   <lub (range (%i. cfst`(?S1 i))), lub (range (%i. csnd`(?S1 i)))>" 
   7.463  *)
   7.464 -qed_goalw "csplit2" Cprod3.thy [csplit_def]
   7.465 -        "csplit`f`<x,y> = f`x`y"
   7.466 - (fn prems =>
   7.467 -        [
   7.468 -        (stac beta_cfun 1),
   7.469 -        (Simp_tac 1),
   7.470 -        (simp_tac (simpset() addsimps [cfst2,csnd2]) 1)
   7.471 -        ]);
   7.472 +val prems = goalw Cprod3.thy [csplit_def]
   7.473 +        "csplit`f`<x,y> = f`x`y";
   7.474 +by (stac beta_cfun 1);
   7.475 +by (Simp_tac 1);
   7.476 +by (simp_tac (simpset() addsimps [cfst2,csnd2]) 1);
   7.477 +qed "csplit2";
   7.478  
   7.479 -qed_goalw "csplit3" Cprod3.thy [csplit_def]
   7.480 -  "csplit`cpair`z=z"
   7.481 - (fn prems =>
   7.482 -        [
   7.483 -        (stac beta_cfun 1),
   7.484 -        (Simp_tac 1),
   7.485 -        (simp_tac (simpset() addsimps [surjective_pairing_Cprod2]) 1)
   7.486 -        ]);
   7.487 +val prems = goalw Cprod3.thy [csplit_def]
   7.488 +  "csplit`cpair`z=z";
   7.489 +by (stac beta_cfun 1);
   7.490 +by (Simp_tac 1);
   7.491 +by (simp_tac (simpset() addsimps [surjective_pairing_Cprod2]) 1);
   7.492 +qed "csplit3";
   7.493  
   7.494  (* ------------------------------------------------------------------------ *)
   7.495  (* install simplifier for Cprod                                             *)
     8.1 --- a/src/HOLCF/Fix.ML	Tue Jul 04 14:58:40 2000 +0200
     8.2 +++ b/src/HOLCF/Fix.ML	Tue Jul 04 15:58:11 2000 +0200
     8.3 @@ -3,52 +3,44 @@
     8.4      Author:     Franz Regensburger
     8.5      Copyright   1993  Technische Universitaet Muenchen
     8.6  
     8.7 -Lemmas for Fix.thy 
     8.8 +fixed point operator and admissibility
     8.9  *)
    8.10  
    8.11 -open Fix;
    8.12 -
    8.13  (* ------------------------------------------------------------------------ *)
    8.14  (* derive inductive properties of iterate from primitive recursion          *)
    8.15  (* ------------------------------------------------------------------------ *)
    8.16  
    8.17 -qed_goal "iterate_Suc2" thy "iterate (Suc n) F x = iterate n F (F`x)"
    8.18 - (fn prems =>
    8.19 -        [
    8.20 -        (induct_tac "n" 1),
    8.21 -        (Simp_tac 1),
    8.22 -        (stac iterate_Suc 1),
    8.23 -        (stac iterate_Suc 1),
    8.24 -        (etac ssubst 1),
    8.25 -        (rtac refl 1)
    8.26 -        ]);
    8.27 +val prems = goal thy "iterate (Suc n) F x = iterate n F (F`x)";
    8.28 +by (induct_tac "n" 1);
    8.29 +by (Simp_tac 1);
    8.30 +by (stac iterate_Suc 1);
    8.31 +by (stac iterate_Suc 1);
    8.32 +by (etac ssubst 1);
    8.33 +by (rtac refl 1);
    8.34 +qed "iterate_Suc2";
    8.35  
    8.36  (* ------------------------------------------------------------------------ *)
    8.37  (* the sequence of function itertaions is a chain                           *)
    8.38  (* This property is essential since monotonicity of iterate makes no sense  *)
    8.39  (* ------------------------------------------------------------------------ *)
    8.40  
    8.41 -qed_goalw "chain_iterate2" thy [chain] 
    8.42 -        " x << F`x ==> chain (%i. iterate i F x)"
    8.43 - (fn prems =>
    8.44 -        [
    8.45 -        (cut_facts_tac prems 1),
    8.46 -        (strip_tac 1),
    8.47 -        (Simp_tac 1),
    8.48 -        (induct_tac "i" 1),
    8.49 -        (Asm_simp_tac 1),
    8.50 -        (Asm_simp_tac 1),
    8.51 -        (etac monofun_cfun_arg 1)
    8.52 -        ]);
    8.53 +val prems = goalw thy [chain] 
    8.54 +        " x << F`x ==> chain (%i. iterate i F x)";
    8.55 +by (cut_facts_tac prems 1);
    8.56 +by (strip_tac 1);
    8.57 +by (Simp_tac 1);
    8.58 +by (induct_tac "i" 1);
    8.59 +by (Asm_simp_tac 1);
    8.60 +by (Asm_simp_tac 1);
    8.61 +by (etac monofun_cfun_arg 1);
    8.62 +qed "chain_iterate2";
    8.63  
    8.64  
    8.65 -qed_goal "chain_iterate" thy  
    8.66 -        "chain (%i. iterate i F UU)"
    8.67 - (fn prems =>
    8.68 -        [
    8.69 -        (rtac chain_iterate2 1),
    8.70 -        (rtac minimal 1)
    8.71 -        ]);
    8.72 +val prems = goal thy  
    8.73 +        "chain (%i. iterate i F UU)";
    8.74 +by (rtac chain_iterate2 1);
    8.75 +by (rtac minimal 1);
    8.76 +qed "chain_iterate";
    8.77  
    8.78  
    8.79  (* ------------------------------------------------------------------------ *)
    8.80 @@ -57,65 +49,53 @@
    8.81  (* ------------------------------------------------------------------------ *)
    8.82  
    8.83  
    8.84 -qed_goalw "Ifix_eq" thy  [Ifix_def] "Ifix F =F`(Ifix F)"
    8.85 - (fn prems =>
    8.86 -        [
    8.87 -        (stac contlub_cfun_arg 1),
    8.88 -        (rtac chain_iterate 1),
    8.89 -        (rtac antisym_less 1),
    8.90 -        (rtac lub_mono 1),
    8.91 -        (rtac chain_iterate 1),
    8.92 -        (rtac ch2ch_Rep_CFunR 1),
    8.93 -        (rtac chain_iterate 1),
    8.94 -        (rtac allI 1),
    8.95 -        (rtac (iterate_Suc RS subst) 1),
    8.96 -        (rtac (chain_iterate RS chainE RS spec) 1),
    8.97 -        (rtac is_lub_thelub 1),
    8.98 -        (rtac ch2ch_Rep_CFunR 1),
    8.99 -        (rtac chain_iterate 1),
   8.100 -        (rtac ub_rangeI 1),
   8.101 -        (rtac allI 1),
   8.102 -        (rtac (iterate_Suc RS subst) 1),
   8.103 -        (rtac is_ub_thelub 1),
   8.104 -        (rtac chain_iterate 1)
   8.105 -        ]);
   8.106 +val prems = goalw thy [Ifix_def] "Ifix F =F`(Ifix F)";
   8.107 +by (stac contlub_cfun_arg 1);
   8.108 +by (rtac chain_iterate 1);
   8.109 +by (rtac antisym_less 1);
   8.110 +by (rtac lub_mono 1);
   8.111 +by (rtac chain_iterate 1);
   8.112 +by (rtac ch2ch_Rep_CFunR 1);
   8.113 +by (rtac chain_iterate 1);
   8.114 +by (rtac allI 1);
   8.115 +by (rtac (iterate_Suc RS subst) 1);
   8.116 +by (rtac (chain_iterate RS chainE RS spec) 1);
   8.117 +by (rtac is_lub_thelub 1);
   8.118 +by (rtac ch2ch_Rep_CFunR 1);
   8.119 +by (rtac chain_iterate 1);
   8.120 +by (rtac ub_rangeI 1);
   8.121 +by (rtac allI 1);
   8.122 +by (rtac (iterate_Suc RS subst) 1);
   8.123 +by (rtac is_ub_thelub 1);
   8.124 +by (rtac chain_iterate 1);
   8.125 +qed "Ifix_eq";
   8.126  
   8.127  
   8.128 -qed_goalw "Ifix_least" thy [Ifix_def] "F`x=x ==> Ifix(F) << x"
   8.129 - (fn prems =>
   8.130 -        [
   8.131 -        (cut_facts_tac prems 1),
   8.132 -        (rtac is_lub_thelub 1),
   8.133 -        (rtac chain_iterate 1),
   8.134 -        (rtac ub_rangeI 1),
   8.135 -        (strip_tac 1),
   8.136 -        (induct_tac "i" 1),
   8.137 -        (Asm_simp_tac 1),
   8.138 -        (Asm_simp_tac 1),
   8.139 -        (res_inst_tac [("t","x")] subst 1),
   8.140 -        (atac 1),
   8.141 -        (etac monofun_cfun_arg 1)
   8.142 -        ]);
   8.143 +val prems = goalw thy [Ifix_def] "F`x=x ==> Ifix(F) << x";
   8.144 +by (cut_facts_tac prems 1);
   8.145 +by (rtac is_lub_thelub 1);
   8.146 +by (rtac chain_iterate 1);
   8.147 +by (rtac ub_rangeI 1);
   8.148 +by (strip_tac 1);
   8.149 +by (induct_tac "i" 1);
   8.150 +by (Asm_simp_tac 1);
   8.151 +by (Asm_simp_tac 1);
   8.152 +by (res_inst_tac [("t","x")] subst 1);
   8.153 +by (atac 1);
   8.154 +by (etac monofun_cfun_arg 1);
   8.155 +qed "Ifix_least";
   8.156  
   8.157  
   8.158  (* ------------------------------------------------------------------------ *)
   8.159  (* monotonicity and continuity of iterate                                   *)
   8.160  (* ------------------------------------------------------------------------ *)
   8.161  
   8.162 -qed_goalw "monofun_iterate" thy  [monofun] "monofun(iterate(i))"
   8.163 - (fn prems =>
   8.164 -        [
   8.165 -        (strip_tac 1),
   8.166 -        (induct_tac "i" 1),
   8.167 -        (Asm_simp_tac 1),
   8.168 -        (Asm_simp_tac 1),
   8.169 -        (rtac (less_fun RS iffD2) 1),
   8.170 -        (rtac allI 1),
   8.171 -        (rtac monofun_cfun 1),
   8.172 -        (atac 1),
   8.173 -        (rtac (less_fun RS iffD1 RS spec) 1),
   8.174 -        (atac 1)
   8.175 -        ]);
   8.176 +Goalw [monofun] "monofun(iterate(i))";
   8.177 +by (strip_tac 1);
   8.178 +by (induct_tac "i" 1);
   8.179 +by (Asm_simp_tac 1);
   8.180 +by (asm_full_simp_tac (simpset() addsimps [less_fun, monofun_cfun]) 1);
   8.181 +qed "monofun_iterate";
   8.182  
   8.183  (* ------------------------------------------------------------------------ *)
   8.184  (* the following lemma uses contlub_cfun which itself is based on a         *)
   8.185 @@ -123,118 +103,103 @@
   8.186  (* In this special case it is the application function Rep_CFun                 *)
   8.187  (* ------------------------------------------------------------------------ *)
   8.188  
   8.189 -qed_goalw "contlub_iterate" thy  [contlub] "contlub(iterate(i))"
   8.190 - (fn prems =>
   8.191 -        [
   8.192 -        (strip_tac 1),
   8.193 -        (induct_tac "i" 1),
   8.194 -        (Asm_simp_tac 1),
   8.195 -        (rtac (lub_const RS thelubI RS sym) 1),
   8.196 -        (asm_simp_tac (simpset() delsimps [range_composition]) 1),
   8.197 -        (rtac ext 1),
   8.198 -        (stac thelub_fun 1),
   8.199 -        (rtac chainI 1),
   8.200 -        (rtac allI 1),
   8.201 -        (rtac (less_fun RS iffD2) 1),
   8.202 -        (rtac allI 1),
   8.203 -        (rtac (chainE RS spec) 1),
   8.204 -        (rtac (monofun_Rep_CFun1 RS ch2ch_MF2LR) 1),
   8.205 -        (rtac allI 1),
   8.206 -        (rtac monofun_Rep_CFun2 1),
   8.207 -        (atac 1),
   8.208 -        (rtac ch2ch_fun 1),
   8.209 -        (rtac (monofun_iterate RS ch2ch_monofun) 1),
   8.210 -        (atac 1),
   8.211 -        (stac thelub_fun 1),
   8.212 -        (rtac (monofun_iterate RS ch2ch_monofun) 1),
   8.213 -        (atac 1),
   8.214 -        (rtac contlub_cfun  1),
   8.215 -        (atac 1),
   8.216 -        (etac (monofun_iterate RS ch2ch_monofun RS ch2ch_fun) 1)
   8.217 -        ]);
   8.218 +val prems = goalw thy [contlub] "contlub(iterate(i))";
   8.219 +by (strip_tac 1);
   8.220 +by (induct_tac "i" 1);
   8.221 +by (Asm_simp_tac 1);
   8.222 +by (rtac (lub_const RS thelubI RS sym) 1);
   8.223 +by (asm_simp_tac (simpset() delsimps [range_composition]) 1);
   8.224 +by (rtac ext 1);
   8.225 +by (stac thelub_fun 1);
   8.226 +by (rtac chainI 1);
   8.227 +by (rtac allI 1);
   8.228 +by (rtac (less_fun RS iffD2) 1);
   8.229 +by (rtac allI 1);
   8.230 +by (rtac (chainE RS spec) 1);
   8.231 +by (rtac (monofun_Rep_CFun1 RS ch2ch_MF2LR) 1);
   8.232 +by (rtac allI 1);
   8.233 +by (rtac monofun_Rep_CFun2 1);
   8.234 +by (atac 1);
   8.235 +by (rtac ch2ch_fun 1);
   8.236 +by (rtac (monofun_iterate RS ch2ch_monofun) 1);
   8.237 +by (atac 1);
   8.238 +by (stac thelub_fun 1);
   8.239 +by (rtac (monofun_iterate RS ch2ch_monofun) 1);
   8.240 +by (atac 1);
   8.241 +by (rtac contlub_cfun  1);
   8.242 +by (atac 1);
   8.243 +by (etac (monofun_iterate RS ch2ch_monofun RS ch2ch_fun) 1);
   8.244 +qed "contlub_iterate";
   8.245  
   8.246  
   8.247 -qed_goal "cont_iterate" thy "cont(iterate(i))"
   8.248 - (fn prems =>
   8.249 -        [
   8.250 -        (rtac monocontlub2cont 1),
   8.251 -        (rtac monofun_iterate 1),
   8.252 -        (rtac contlub_iterate 1)
   8.253 -        ]);
   8.254 +val prems = goal thy "cont(iterate(i))";
   8.255 +by (rtac monocontlub2cont 1);
   8.256 +by (rtac monofun_iterate 1);
   8.257 +by (rtac contlub_iterate 1);
   8.258 +qed "cont_iterate";
   8.259  
   8.260  (* ------------------------------------------------------------------------ *)
   8.261  (* a lemma about continuity of iterate in its third argument                *)
   8.262  (* ------------------------------------------------------------------------ *)
   8.263  
   8.264 -qed_goal "monofun_iterate2" thy "monofun(iterate n F)"
   8.265 - (fn prems =>
   8.266 -        [
   8.267 -        (rtac monofunI 1),
   8.268 -        (strip_tac 1),
   8.269 -        (induct_tac "n" 1),
   8.270 -        (Asm_simp_tac 1),
   8.271 -        (Asm_simp_tac 1),
   8.272 -        (etac monofun_cfun_arg 1)
   8.273 -        ]);
   8.274 +val prems = goal thy "monofun(iterate n F)";
   8.275 +by (rtac monofunI 1);
   8.276 +by (strip_tac 1);
   8.277 +by (induct_tac "n" 1);
   8.278 +by (Asm_simp_tac 1);
   8.279 +by (Asm_simp_tac 1);
   8.280 +by (etac monofun_cfun_arg 1);
   8.281 +qed "monofun_iterate2";
   8.282  
   8.283 -qed_goal "contlub_iterate2" thy "contlub(iterate n F)"
   8.284 - (fn prems =>
   8.285 -        [
   8.286 -        (rtac contlubI 1),
   8.287 -        (strip_tac 1),
   8.288 -        (induct_tac "n" 1),
   8.289 -        (Simp_tac 1),
   8.290 -        (Simp_tac 1),
   8.291 -        (res_inst_tac [("t","iterate n F (lub(range(%u. Y u)))"),
   8.292 -        ("s","lub(range(%i. iterate n F (Y i)))")] ssubst 1),
   8.293 -        (atac 1),
   8.294 -        (rtac contlub_cfun_arg 1),
   8.295 -        (etac (monofun_iterate2 RS ch2ch_monofun) 1)
   8.296 -        ]);
   8.297 +Goal "contlub(iterate n F)";
   8.298 +by (rtac contlubI 1);
   8.299 +by (strip_tac 1);
   8.300 +by (induct_tac "n" 1);
   8.301 +by (Simp_tac 1);
   8.302 +by (Simp_tac 1);
   8.303 +by (res_inst_tac [("t","iterate n F (lub(range(%u. Y u)))"),
   8.304 +                  ("s","lub(range(%i. iterate n F (Y i)))")] ssubst 1);
   8.305 +by (atac 1);
   8.306 +by (rtac contlub_cfun_arg 1);
   8.307 +by (etac (monofun_iterate2 RS ch2ch_monofun) 1);
   8.308 +qed "contlub_iterate2";
   8.309  
   8.310 -qed_goal "cont_iterate2" thy "cont (iterate n F)"
   8.311 - (fn prems =>
   8.312 -        [
   8.313 -        (rtac monocontlub2cont 1),
   8.314 -        (rtac monofun_iterate2 1),
   8.315 -        (rtac contlub_iterate2 1)
   8.316 -        ]);
   8.317 +val prems = goal thy "cont (iterate n F)";
   8.318 +by (rtac monocontlub2cont 1);
   8.319 +by (rtac monofun_iterate2 1);
   8.320 +by (rtac contlub_iterate2 1);
   8.321 +qed "cont_iterate2";
   8.322  
   8.323  (* ------------------------------------------------------------------------ *)
   8.324  (* monotonicity and continuity of Ifix                                      *)
   8.325  (* ------------------------------------------------------------------------ *)
   8.326  
   8.327 -qed_goalw "monofun_Ifix" thy  [monofun,Ifix_def] "monofun(Ifix)"
   8.328 - (fn prems =>
   8.329 -        [
   8.330 -        (strip_tac 1),
   8.331 -        (rtac lub_mono 1),
   8.332 -        (rtac chain_iterate 1),
   8.333 -        (rtac chain_iterate 1),
   8.334 -        (rtac allI 1),
   8.335 -        (rtac (less_fun RS iffD1 RS spec) 1),
   8.336 -        (etac (monofun_iterate RS monofunE RS spec RS spec RS mp) 1)
   8.337 -        ]);
   8.338 +Goalw [monofun,Ifix_def] "monofun(Ifix)";
   8.339 +by (strip_tac 1);
   8.340 +by (rtac lub_mono 1);
   8.341 +by (rtac chain_iterate 1);
   8.342 +by (rtac chain_iterate 1);
   8.343 +by (rtac allI 1);
   8.344 +by (rtac (less_fun RS iffD1 RS spec) 1 THEN
   8.345 +    etac (monofun_iterate RS monofunE RS spec RS spec RS mp) 1);
   8.346 +qed "monofun_Ifix";
   8.347  
   8.348  (* ------------------------------------------------------------------------ *)
   8.349  (* since iterate is not monotone in its first argument, special lemmas must *)
   8.350  (* be derived for lubs in this argument                                     *)
   8.351  (* ------------------------------------------------------------------------ *)
   8.352  
   8.353 -qed_goal "chain_iterate_lub" thy   
   8.354 -"chain(Y) ==> chain(%i. lub(range(%ia. iterate ia (Y i) UU)))"
   8.355 - (fn prems =>
   8.356 -        [
   8.357 -        (cut_facts_tac prems 1),
   8.358 -        (rtac chainI 1),
   8.359 -        (strip_tac 1),
   8.360 -        (rtac lub_mono 1),
   8.361 -        (rtac chain_iterate 1),
   8.362 -        (rtac chain_iterate 1),
   8.363 -        (strip_tac 1),
   8.364 -        (etac (monofun_iterate RS ch2ch_monofun RS ch2ch_fun RS chainE 
   8.365 -         RS spec) 1)
   8.366 -        ]);
   8.367 +val prems = goal thy   
   8.368 +"chain(Y) ==> chain(%i. lub(range(%ia. iterate ia (Y i) UU)))";
   8.369 +by (cut_facts_tac prems 1);
   8.370 +by (rtac chainI 1);
   8.371 +by (strip_tac 1);
   8.372 +by (rtac lub_mono 1);
   8.373 +by (rtac chain_iterate 1);
   8.374 +by (rtac chain_iterate 1);
   8.375 +by (strip_tac 1);
   8.376 +by (etac (monofun_iterate RS ch2ch_monofun RS ch2ch_fun RS chainE RS spec) 1);
   8.377 +qed "chain_iterate_lub";
   8.378  
   8.379  (* ------------------------------------------------------------------------ *)
   8.380  (* this exchange lemma is analog to the one for monotone functions          *)
   8.381 @@ -242,138 +207,111 @@
   8.382  (* chains is the essential argument which is usually derived from monot.    *)
   8.383  (* ------------------------------------------------------------------------ *)
   8.384  
   8.385 -qed_goal "contlub_Ifix_lemma1" thy 
   8.386 -"chain(Y) ==>iterate n (lub(range Y)) y = lub(range(%i. iterate n (Y i) y))"
   8.387 - (fn prems =>
   8.388 -        [
   8.389 -        (cut_facts_tac prems 1),
   8.390 -        (rtac (thelub_fun RS subst) 1),
   8.391 -        (rtac (monofun_iterate RS ch2ch_monofun) 1),
   8.392 -        (atac 1),
   8.393 -        (rtac fun_cong 1),
   8.394 -        (stac (contlub_iterate RS contlubE RS spec RS mp) 1),
   8.395 -        (atac 1),
   8.396 -        (rtac refl 1)
   8.397 -        ]);
   8.398 +Goal
   8.399 + "chain(Y) ==>iterate n (lub(range Y)) y = lub(range(%i. iterate n (Y i) y))";
   8.400 +by (rtac (thelub_fun RS subst) 1);
   8.401 +by (etac (monofun_iterate RS ch2ch_monofun) 1);
   8.402 +by (asm_simp_tac (simpset() addsimps [contlub_iterate RS contlubE]) 1);
   8.403 +qed "contlub_Ifix_lemma1";
   8.404  
   8.405  
   8.406 -qed_goal "ex_lub_iterate" thy  "chain(Y) ==>\
   8.407 +val prems = goal thy  "chain(Y) ==>\
   8.408  \         lub(range(%i. lub(range(%ia. iterate i (Y ia) UU)))) =\
   8.409 -\         lub(range(%i. lub(range(%ia. iterate ia (Y i) UU))))"
   8.410 - (fn prems =>
   8.411 -        [
   8.412 -        (cut_facts_tac prems 1),
   8.413 -        (rtac antisym_less 1),
   8.414 -        (rtac is_lub_thelub 1),
   8.415 -        (rtac (contlub_Ifix_lemma1 RS ext RS subst) 1),
   8.416 -        (atac 1),
   8.417 -        (rtac chain_iterate 1),
   8.418 -        (rtac ub_rangeI 1),
   8.419 -        (strip_tac 1),
   8.420 -        (rtac lub_mono 1),
   8.421 -        (etac (monofun_iterate RS ch2ch_monofun RS ch2ch_fun) 1),
   8.422 -        (etac chain_iterate_lub 1),
   8.423 -        (strip_tac 1),
   8.424 -        (rtac is_ub_thelub 1),
   8.425 -        (rtac chain_iterate 1),
   8.426 -        (rtac is_lub_thelub 1),
   8.427 -        (etac chain_iterate_lub 1),
   8.428 -        (rtac ub_rangeI 1),
   8.429 -        (strip_tac 1),
   8.430 -        (rtac lub_mono 1),
   8.431 -        (rtac chain_iterate 1),
   8.432 -        (rtac (contlub_Ifix_lemma1 RS ext RS subst) 1),
   8.433 -        (atac 1),
   8.434 -        (rtac chain_iterate 1),
   8.435 -        (strip_tac 1),
   8.436 -        (rtac is_ub_thelub 1),
   8.437 -        (etac (monofun_iterate RS ch2ch_monofun RS ch2ch_fun) 1)
   8.438 -        ]);
   8.439 +\         lub(range(%i. lub(range(%ia. iterate ia (Y i) UU))))";
   8.440 +by (cut_facts_tac prems 1);
   8.441 +by (rtac antisym_less 1);
   8.442 +by (rtac is_lub_thelub 1);
   8.443 +by (rtac (contlub_Ifix_lemma1 RS ext RS subst) 1);
   8.444 +by (atac 1);
   8.445 +by (rtac chain_iterate 1);
   8.446 +by (rtac ub_rangeI 1);
   8.447 +by (strip_tac 1);
   8.448 +by (rtac lub_mono 1);
   8.449 +by (etac (monofun_iterate RS ch2ch_monofun RS ch2ch_fun) 1);
   8.450 +by (etac chain_iterate_lub 1);
   8.451 +by (strip_tac 1);
   8.452 +by (rtac is_ub_thelub 1);
   8.453 +by (rtac chain_iterate 1);
   8.454 +by (rtac is_lub_thelub 1);
   8.455 +by (etac chain_iterate_lub 1);
   8.456 +by (rtac ub_rangeI 1);
   8.457 +by (strip_tac 1);
   8.458 +by (rtac lub_mono 1);
   8.459 +by (rtac chain_iterate 1);
   8.460 +by (rtac (contlub_Ifix_lemma1 RS ext RS subst) 1);
   8.461 +by (atac 1);
   8.462 +by (rtac chain_iterate 1);
   8.463 +by (strip_tac 1);
   8.464 +by (rtac is_ub_thelub 1);
   8.465 +by (etac (monofun_iterate RS ch2ch_monofun RS ch2ch_fun) 1);
   8.466 +qed "ex_lub_iterate";
   8.467  
   8.468  
   8.469 -qed_goalw "contlub_Ifix" thy  [contlub,Ifix_def] "contlub(Ifix)"
   8.470 - (fn prems =>
   8.471 -        [
   8.472 -        (strip_tac 1),
   8.473 -        (stac (contlub_Ifix_lemma1 RS ext) 1),
   8.474 -        (atac 1),
   8.475 -        (etac ex_lub_iterate 1)
   8.476 -        ]);
   8.477 +val prems = goalw thy [contlub,Ifix_def] "contlub(Ifix)";
   8.478 +by (strip_tac 1);
   8.479 +by (stac (contlub_Ifix_lemma1 RS ext) 1);
   8.480 +by (atac 1);
   8.481 +by (etac ex_lub_iterate 1);
   8.482 +qed "contlub_Ifix";
   8.483  
   8.484  
   8.485 -qed_goal "cont_Ifix" thy "cont(Ifix)"
   8.486 - (fn prems =>
   8.487 -        [
   8.488 -        (rtac monocontlub2cont 1),
   8.489 -        (rtac monofun_Ifix 1),
   8.490 -        (rtac contlub_Ifix 1)
   8.491 -        ]);
   8.492 +val prems = goal thy "cont(Ifix)";
   8.493 +by (rtac monocontlub2cont 1);
   8.494 +by (rtac monofun_Ifix 1);
   8.495 +by (rtac contlub_Ifix 1);
   8.496 +qed "cont_Ifix";
   8.497  
   8.498  (* ------------------------------------------------------------------------ *)
   8.499  (* propagate properties of Ifix to its continuous counterpart               *)
   8.500  (* ------------------------------------------------------------------------ *)
   8.501  
   8.502 -qed_goalw "fix_eq" thy  [fix_def] "fix`F = F`(fix`F)"
   8.503 - (fn prems =>
   8.504 -        [
   8.505 -        (asm_simp_tac (simpset() addsimps [cont_Ifix]) 1),
   8.506 -        (rtac Ifix_eq 1)
   8.507 -        ]);
   8.508 +val prems = goalw thy [fix_def] "fix`F = F`(fix`F)";
   8.509 +by (asm_simp_tac (simpset() addsimps [cont_Ifix]) 1);
   8.510 +by (rtac Ifix_eq 1);
   8.511 +qed "fix_eq";
   8.512  
   8.513 -qed_goalw "fix_least" thy [fix_def] "F`x = x ==> fix`F << x"
   8.514 - (fn prems =>
   8.515 -        [
   8.516 -        (cut_facts_tac prems 1),
   8.517 -        (asm_simp_tac (simpset() addsimps [cont_Ifix]) 1),
   8.518 -        (etac Ifix_least 1)
   8.519 -        ]);
   8.520 +val prems = goalw thy [fix_def] "F`x = x ==> fix`F << x";
   8.521 +by (cut_facts_tac prems 1);
   8.522 +by (asm_simp_tac (simpset() addsimps [cont_Ifix]) 1);
   8.523 +by (etac Ifix_least 1);
   8.524 +qed "fix_least";
   8.525  
   8.526  
   8.527 -qed_goal "fix_eqI" thy
   8.528 -"[| F`x = x; !z. F`z = z --> x << z |] ==> x = fix`F"
   8.529 - (fn prems =>
   8.530 -        [
   8.531 -        (cut_facts_tac prems 1),
   8.532 -        (rtac antisym_less 1),
   8.533 -        (etac allE 1),
   8.534 -        (etac mp 1),
   8.535 -        (rtac (fix_eq RS sym) 1),
   8.536 -        (etac fix_least 1)
   8.537 -        ]);
   8.538 +val prems = goal thy
   8.539 +"[| F`x = x; !z. F`z = z --> x << z |] ==> x = fix`F";
   8.540 +by (cut_facts_tac prems 1);
   8.541 +by (rtac antisym_less 1);
   8.542 +by (etac allE 1);
   8.543 +by (etac mp 1);
   8.544 +by (rtac (fix_eq RS sym) 1);
   8.545 +by (etac fix_least 1);
   8.546 +qed "fix_eqI";
   8.547  
   8.548  
   8.549 -qed_goal "fix_eq2" thy "f == fix`F ==> f = F`f"
   8.550 - (fn prems =>
   8.551 -        [
   8.552 -        (rewrite_goals_tac prems),
   8.553 -        (rtac fix_eq 1)
   8.554 -        ]);
   8.555 +val prems = goal thy "f == fix`F ==> f = F`f";
   8.556 +by (rewrite_goals_tac prems);
   8.557 +by (rtac fix_eq 1);
   8.558 +qed "fix_eq2";
   8.559  
   8.560 -qed_goal "fix_eq3" thy "f == fix`F ==> f`x = F`f`x"
   8.561 - (fn prems =>
   8.562 -        [
   8.563 -        (rtac trans 1),
   8.564 -        (rtac ((hd prems) RS fix_eq2 RS cfun_fun_cong) 1),
   8.565 -        (rtac refl 1)
   8.566 -        ]);
   8.567 +val prems = goal thy "f == fix`F ==> f`x = F`f`x";
   8.568 +by (rtac trans 1);
   8.569 +by (rtac ((hd prems) RS fix_eq2 RS cfun_fun_cong) 1);
   8.570 +by (rtac refl 1);
   8.571 +qed "fix_eq3";
   8.572  
   8.573  fun fix_tac3 thm i  = ((rtac trans i) THEN (rtac (thm RS fix_eq3) i)); 
   8.574  
   8.575 -qed_goal "fix_eq4" thy "f = fix`F ==> f = F`f"
   8.576 - (fn prems =>
   8.577 -        [
   8.578 -        (cut_facts_tac prems 1),
   8.579 -        (hyp_subst_tac 1),
   8.580 -        (rtac fix_eq 1)
   8.581 -        ]);
   8.582 +val prems = goal thy "f = fix`F ==> f = F`f";
   8.583 +by (cut_facts_tac prems 1);
   8.584 +by (hyp_subst_tac 1);
   8.585 +by (rtac fix_eq 1);
   8.586 +qed "fix_eq4";
   8.587  
   8.588 -qed_goal "fix_eq5" thy "f = fix`F ==> f`x = F`f`x"
   8.589 - (fn prems =>
   8.590 -        [
   8.591 -        (rtac trans 1),
   8.592 -        (rtac ((hd prems) RS fix_eq4 RS cfun_fun_cong) 1),
   8.593 -        (rtac refl 1)
   8.594 -        ]);
   8.595 +val prems = goal thy "f = fix`F ==> f`x = F`f`x";
   8.596 +by (rtac trans 1);
   8.597 +by (rtac ((hd prems) RS fix_eq4 RS cfun_fun_cong) 1);
   8.598 +by (rtac refl 1);
   8.599 +qed "fix_eq5";
   8.600  
   8.601  fun fix_tac5 thm i  = ((rtac trans i) THEN (rtac (thm RS fix_eq5) i)); 
   8.602  
   8.603 @@ -408,25 +346,21 @@
   8.604  (* ------------------------------------------------------------------------ *)
   8.605  
   8.606  
   8.607 -qed_goal "Ifix_def2" thy "Ifix=(%x. lub(range(%i. iterate i x UU)))"
   8.608 - (fn prems =>
   8.609 -        [
   8.610 -        (rtac ext 1),
   8.611 -        (rewtac Ifix_def),
   8.612 -        (rtac refl 1)
   8.613 -        ]);
   8.614 +val prems = goal thy "Ifix=(%x. lub(range(%i. iterate i x UU)))";
   8.615 +by (rtac ext 1);
   8.616 +by (rewtac Ifix_def);
   8.617 +by (rtac refl 1);
   8.618 +qed "Ifix_def2";
   8.619  
   8.620  (* ------------------------------------------------------------------------ *)
   8.621  (* direct connection between fix and iteration without Ifix                 *)
   8.622  (* ------------------------------------------------------------------------ *)
   8.623  
   8.624 -qed_goalw "fix_def2" thy [fix_def]
   8.625 - "fix`F = lub(range(%i. iterate i F UU))"
   8.626 - (fn prems =>
   8.627 -        [
   8.628 -        (fold_goals_tac [Ifix_def]),
   8.629 -        (asm_simp_tac (simpset() addsimps [cont_Ifix]) 1)
   8.630 -        ]);
   8.631 +val prems = goalw thy [fix_def]
   8.632 + "fix`F = lub(range(%i. iterate i F UU))";
   8.633 +by (fold_goals_tac [Ifix_def]);
   8.634 +by (asm_simp_tac (simpset() addsimps [cont_Ifix]) 1);
   8.635 +qed "fix_def2";
   8.636  
   8.637  
   8.638  (* ------------------------------------------------------------------------ *)
   8.639 @@ -437,106 +371,99 @@
   8.640  (* access to definitions                                                    *)
   8.641  (* ------------------------------------------------------------------------ *)
   8.642  
   8.643 -qed_goalw "admI" thy [adm_def]
   8.644 -        "(!!Y. [| chain(Y); !i. P(Y(i)) |] ==> P(lub(range(Y)))) ==> adm(P)"
   8.645 - (fn prems => [fast_tac (HOL_cs addIs prems) 1]);
   8.646 -
   8.647 -qed_goalw "admD" thy [adm_def]
   8.648 -        "!!P. [| adm(P); chain(Y); !i. P(Y(i)) |] ==> P(lub(range(Y)))"
   8.649 - (fn prems => [fast_tac HOL_cs 1]);
   8.650 +val prems = goalw thy [adm_def]
   8.651 +        "(!!Y. [| chain(Y); !i. P(Y(i)) |] ==> P(lub(range(Y)))) ==> adm(P)";
   8.652 +by (fast_tac (HOL_cs addIs prems) 1);
   8.653 +qed "admI";
   8.654  
   8.655 -qed_goalw "admw_def2" thy [admw_def]
   8.656 +Goalw [adm_def] "[| adm(P); chain(Y); !i. P(Y(i)) |] ==> P(lub(range(Y)))";
   8.657 +by (Blast_tac 1);
   8.658 +qed "admD";
   8.659 +
   8.660 +val prems = goalw thy [admw_def]
   8.661          "admw(P) = (!F.(!n. P(iterate n F UU)) -->\
   8.662 -\                        P (lub(range(%i. iterate i F UU))))"
   8.663 - (fn prems =>
   8.664 -        [
   8.665 -        (rtac refl 1)
   8.666 -        ]);
   8.667 +\                        P (lub(range(%i. iterate i F UU))))";
   8.668 +by (rtac refl 1);
   8.669 +qed "admw_def2";
   8.670  
   8.671  (* ------------------------------------------------------------------------ *)
   8.672  (* an admissible formula is also weak admissible                            *)
   8.673  (* ------------------------------------------------------------------------ *)
   8.674  
   8.675 -qed_goalw "adm_impl_admw"  thy [admw_def] "!!P. adm(P)==>admw(P)"
   8.676 - (fn prems =>
   8.677 -        [
   8.678 -        (strip_tac 1),
   8.679 -        (etac admD 1),
   8.680 -        (rtac chain_iterate 1),
   8.681 -        (atac 1)
   8.682 -        ]);
   8.683 +val prems = goalw thy [admw_def] "!!P. adm(P)==>admw(P)";
   8.684 +by (strip_tac 1);
   8.685 +by (etac admD 1);
   8.686 +by (rtac chain_iterate 1);
   8.687 +by (atac 1);
   8.688 +qed "adm_impl_admw";
   8.689  
   8.690  (* ------------------------------------------------------------------------ *)
   8.691  (* fixed point induction                                                    *)
   8.692  (* ------------------------------------------------------------------------ *)
   8.693  
   8.694 -qed_goal "fix_ind"  thy  
   8.695 -"[| adm(P);P(UU);!!x. P(x) ==> P(F`x)|] ==> P(fix`F)"
   8.696 - (fn prems =>
   8.697 -        [
   8.698 -        (cut_facts_tac prems 1),
   8.699 -        (stac fix_def2 1),
   8.700 -        (etac admD 1),
   8.701 -        (rtac chain_iterate 1),
   8.702 -        (rtac allI 1),
   8.703 -        (induct_tac "i" 1),
   8.704 -        (stac iterate_0 1),
   8.705 -        (atac 1),
   8.706 -        (stac iterate_Suc 1),
   8.707 -        (resolve_tac prems 1),
   8.708 -        (atac 1)
   8.709 -        ]);
   8.710 +val prems = goal  thy  
   8.711 +"[| adm(P);P(UU);!!x. P(x) ==> P(F`x)|] ==> P(fix`F)";
   8.712 +by (cut_facts_tac prems 1);
   8.713 +by (stac fix_def2 1);
   8.714 +by (etac admD 1);
   8.715 +by (rtac chain_iterate 1);
   8.716 +by (rtac allI 1);
   8.717 +by (induct_tac "i" 1);
   8.718 +by (stac iterate_0 1);
   8.719 +by (atac 1);
   8.720 +by (stac iterate_Suc 1);
   8.721 +by (resolve_tac prems 1);
   8.722 +by (atac 1);
   8.723 +qed "fix_ind";
   8.724  
   8.725 -qed_goal "def_fix_ind" thy "[| f == fix`F; adm(P); \
   8.726 -\       P(UU);!!x. P(x) ==> P(F`x)|] ==> P f" (fn prems => [
   8.727 -        (cut_facts_tac prems 1),
   8.728 -	(asm_simp_tac HOL_ss 1),
   8.729 -	(etac fix_ind 1),
   8.730 -	(atac 1),
   8.731 -	(eresolve_tac prems 1)]);
   8.732 +val prems = goal thy "[| f == fix`F; adm(P); \
   8.733 +\       P(UU);!!x. P(x) ==> P(F`x)|] ==> P f";
   8.734 +by (cut_facts_tac prems 1);
   8.735 +by (asm_simp_tac HOL_ss 1);
   8.736 +by (etac fix_ind 1);
   8.737 +by (atac 1);
   8.738 +by (eresolve_tac prems 1);
   8.739 +qed "def_fix_ind";
   8.740  	
   8.741  (* ------------------------------------------------------------------------ *)
   8.742  (* computational induction for weak admissible formulae                     *)
   8.743  (* ------------------------------------------------------------------------ *)
   8.744  
   8.745 -qed_goal "wfix_ind"  thy  
   8.746 -"[| admw(P); !n. P(iterate n F UU)|] ==> P(fix`F)"
   8.747 - (fn prems =>
   8.748 -        [
   8.749 -        (cut_facts_tac prems 1),
   8.750 -        (stac fix_def2 1),
   8.751 -        (rtac (admw_def2 RS iffD1 RS spec RS mp) 1),
   8.752 -        (atac 1),
   8.753 -        (rtac allI 1),
   8.754 -        (etac spec 1)
   8.755 -        ]);
   8.756 +val prems = goal  thy  
   8.757 +"[| admw(P); !n. P(iterate n F UU)|] ==> P(fix`F)";
   8.758 +by (cut_facts_tac prems 1);
   8.759 +by (stac fix_def2 1);
   8.760 +by (rtac (admw_def2 RS iffD1 RS spec RS mp) 1);
   8.761 +by (atac 1);
   8.762 +by (rtac allI 1);
   8.763 +by (etac spec 1);
   8.764 +qed "wfix_ind";
   8.765  
   8.766 -qed_goal "def_wfix_ind" thy "[| f == fix`F; admw(P); \
   8.767 -\       !n. P(iterate n F UU) |] ==> P f" (fn prems => [
   8.768 -        (cut_facts_tac prems 1),
   8.769 -	(asm_simp_tac HOL_ss 1),
   8.770 -	(etac wfix_ind 1),
   8.771 -	(atac 1)]);
   8.772 +val prems = goal thy "[| f == fix`F; admw(P); \
   8.773 +\       !n. P(iterate n F UU) |] ==> P f";
   8.774 +by (cut_facts_tac prems 1);
   8.775 +by (asm_simp_tac HOL_ss 1);
   8.776 +by (etac wfix_ind 1);
   8.777 +by (atac 1);
   8.778 +qed "def_wfix_ind";
   8.779  
   8.780  (* ------------------------------------------------------------------------ *)
   8.781  (* for chain-finite (easy) types every formula is admissible                *)
   8.782  (* ------------------------------------------------------------------------ *)
   8.783  
   8.784 -qed_goalw "adm_max_in_chain"  thy  [adm_def]
   8.785 -"!Y. chain(Y::nat=>'a) --> (? n. max_in_chain n Y) ==> adm(P::'a=>bool)"
   8.786 - (fn prems =>
   8.787 -        [
   8.788 -        (cut_facts_tac prems 1),
   8.789 -        (strip_tac 1),
   8.790 -        (rtac exE 1),
   8.791 -        (rtac mp 1),
   8.792 -        (etac spec 1),
   8.793 -        (atac 1),
   8.794 -        (stac (lub_finch1 RS thelubI) 1),
   8.795 -        (atac 1),
   8.796 -        (atac 1),
   8.797 -        (etac spec 1)
   8.798 -        ]);
   8.799 +val prems = goalw thy [adm_def]
   8.800 +"!Y. chain(Y::nat=>'a) --> (? n. max_in_chain n Y) ==> adm(P::'a=>bool)";
   8.801 +by (cut_facts_tac prems 1);
   8.802 +by (strip_tac 1);
   8.803 +by (rtac exE 1);
   8.804 +by (rtac mp 1);
   8.805 +by (etac spec 1);
   8.806 +by (atac 1);
   8.807 +by (stac (lub_finch1 RS thelubI) 1);
   8.808 +by (atac 1);
   8.809 +by (atac 1);
   8.810 +by (etac spec 1);
   8.811 +qed "adm_max_in_chain";
   8.812  
   8.813  bind_thm ("adm_chfin" ,chfin RS adm_max_in_chain);
   8.814  
   8.815 @@ -544,12 +471,12 @@
   8.816  (* some lemmata for functions with flat/chfin domain/range types	    *)
   8.817  (* ------------------------------------------------------------------------ *)
   8.818  
   8.819 -qed_goalw "adm_chfindom" thy [adm_def] "adm (%(u::'a::cpo->'b::chfin). P(u`s))"
   8.820 -    (fn _ => [
   8.821 -	strip_tac 1,
   8.822 -	dtac chfin_Rep_CFunR 1,
   8.823 -	eres_inst_tac [("x","s")] allE 1,
   8.824 -	fast_tac (HOL_cs addss (simpset() addsimps [chfin])) 1]);
   8.825 +val _ = goalw thy [adm_def] "adm (%(u::'a::cpo->'b::chfin). P(u`s))";
   8.826 +by (strip_tac 1);
   8.827 +by (dtac chfin_Rep_CFunR 1);
   8.828 +by (eres_inst_tac [("x","s")] allE 1);
   8.829 +by (fast_tac (HOL_cs addss (simpset() addsimps [chfin])) 1);
   8.830 +qed "adm_chfindom";
   8.831  
   8.832  (* adm_flat not needed any more, since it is a special case of adm_chfindom *)
   8.833  
   8.834 @@ -557,106 +484,103 @@
   8.835  (* improved admisibility introduction                                       *)
   8.836  (* ------------------------------------------------------------------------ *)
   8.837  
   8.838 -qed_goalw "admI2" thy [adm_def]
   8.839 +val prems = goalw thy [adm_def]
   8.840   "(!!Y. [| chain Y; !i. P (Y i); !i. ? j. i < j & Y i ~= Y j & Y i << Y j |]\
   8.841 -\ ==> P(lub (range Y))) ==> adm P" 
   8.842 - (fn prems => [
   8.843 -        strip_tac 1,
   8.844 -        etac increasing_chain_adm_lemma 1, atac 1,
   8.845 -        eresolve_tac prems 1, atac 1, atac 1]);
   8.846 +\ ==> P(lub (range Y))) ==> adm P";
   8.847 +by (strip_tac 1);
   8.848 +by (etac increasing_chain_adm_lemma 1);
   8.849 +by (atac 1);
   8.850 +by (eresolve_tac prems 1);
   8.851 +by (atac 1);
   8.852 +by (atac 1);
   8.853 +qed "admI2";
   8.854  
   8.855  
   8.856  (* ------------------------------------------------------------------------ *)
   8.857  (* admissibility of special formulae and propagation                        *)
   8.858  (* ------------------------------------------------------------------------ *)
   8.859  
   8.860 -qed_goalw "adm_less"  thy [adm_def]
   8.861 -        "[|cont u;cont v|]==> adm(%x. u x << v x)"
   8.862 - (fn prems =>
   8.863 -        [
   8.864 -        (cut_facts_tac prems 1),
   8.865 -        (strip_tac 1),
   8.866 -        (etac (cont2contlub RS contlubE RS spec RS mp RS ssubst) 1),
   8.867 -        (atac 1),
   8.868 -        (etac (cont2contlub RS contlubE RS spec RS mp RS ssubst) 1),
   8.869 -        (atac 1),
   8.870 -        (rtac lub_mono 1),
   8.871 -        (cut_facts_tac prems 1),
   8.872 -        (etac (cont2mono RS ch2ch_monofun) 1),
   8.873 -        (atac 1),
   8.874 -        (cut_facts_tac prems 1),
   8.875 -        (etac (cont2mono RS ch2ch_monofun) 1),
   8.876 -        (atac 1),
   8.877 -        (atac 1)
   8.878 -        ]);
   8.879 +val prems = goalw thy [adm_def]
   8.880 +        "[|cont u;cont v|]==> adm(%x. u x << v x)";
   8.881 +by (cut_facts_tac prems 1);
   8.882 +by (strip_tac 1);
   8.883 +by (etac (cont2contlub RS contlubE RS spec RS mp RS ssubst) 1);
   8.884 +by (atac 1);
   8.885 +by (etac (cont2contlub RS contlubE RS spec RS mp RS ssubst) 1);
   8.886 +by (atac 1);
   8.887 +by (rtac lub_mono 1);
   8.888 +by (cut_facts_tac prems 1);
   8.889 +by (etac (cont2mono RS ch2ch_monofun) 1);
   8.890 +by (atac 1);
   8.891 +by (cut_facts_tac prems 1);
   8.892 +by (etac (cont2mono RS ch2ch_monofun) 1);
   8.893 +by (atac 1);
   8.894 +by (atac 1);
   8.895 +qed "adm_less";
   8.896  Addsimps [adm_less];
   8.897  
   8.898 -qed_goal "adm_conj"  thy  
   8.899 -        "!!P. [| adm P; adm Q |] ==> adm(%x. P x & Q x)"
   8.900 - (fn prems => [fast_tac (HOL_cs addEs [admD] addIs [admI]) 1]);
   8.901 +val prems = goal  thy  
   8.902 +        "!!P. [| adm P; adm Q |] ==> adm(%x. P x & Q x)";
   8.903 +by (fast_tac (HOL_cs addEs [admD] addIs [admI]) 1);
   8.904 +qed "adm_conj";
   8.905  Addsimps [adm_conj];
   8.906  
   8.907 -qed_goalw "adm_not_free"  thy [adm_def] "adm(%x. t)"
   8.908 - (fn prems => [fast_tac HOL_cs 1]);
   8.909 +val prems = goalw thy [adm_def] "adm(%x. t)";
   8.910 +by (fast_tac HOL_cs 1);
   8.911 +qed "adm_not_free";
   8.912  Addsimps [adm_not_free];
   8.913  
   8.914 -qed_goalw "adm_not_less"  thy [adm_def]
   8.915 -        "!!t. cont t ==> adm(%x.~ (t x) << u)"
   8.916 - (fn prems =>
   8.917 -        [
   8.918 -        (strip_tac 1),
   8.919 -        (rtac contrapos 1),
   8.920 -        (etac spec 1),
   8.921 -        (rtac trans_less 1),
   8.922 -        (atac 2),
   8.923 -        (etac (cont2mono RS monofun_fun_arg) 1),
   8.924 -        (rtac is_ub_thelub 1),
   8.925 -        (atac 1)
   8.926 -        ]);
   8.927 +val prems = goalw thy [adm_def]
   8.928 +        "!!t. cont t ==> adm(%x.~ (t x) << u)";
   8.929 +by (strip_tac 1);
   8.930 +by (rtac contrapos 1);
   8.931 +by (etac spec 1);
   8.932 +by (rtac trans_less 1);
   8.933 +by (atac 2);
   8.934 +by (etac (cont2mono RS monofun_fun_arg) 1);
   8.935 +by (rtac is_ub_thelub 1);
   8.936 +by (atac 1);
   8.937 +qed "adm_not_less";
   8.938  
   8.939 -qed_goal "adm_all" thy  
   8.940 -        "!!P. !y. adm(P y) ==> adm(%x.!y. P y x)"
   8.941 - (fn prems => [fast_tac (HOL_cs addIs [admI] addEs [admD]) 1]);
   8.942 +val prems = goal thy  
   8.943 +        "!!P. !y. adm(P y) ==> adm(%x.!y. P y x)";
   8.944 +by (fast_tac (HOL_cs addIs [admI] addEs [admD]) 1);
   8.945 +qed "adm_all";
   8.946  
   8.947  bind_thm ("adm_all2", allI RS adm_all);
   8.948  
   8.949 -qed_goal "adm_subst"  thy  
   8.950 -        "!!P. [|cont t; adm P|] ==> adm(%x. P (t x))"
   8.951 - (fn prems =>
   8.952 -        [
   8.953 -        (rtac admI 1),
   8.954 -        (stac (cont2contlub RS contlubE RS spec RS mp) 1),
   8.955 -        (atac 1),
   8.956 -        (atac 1),
   8.957 -        (etac admD 1),
   8.958 -        (etac (cont2mono RS ch2ch_monofun) 1),
   8.959 -        (atac 1),
   8.960 -        (atac 1)
   8.961 -        ]);
   8.962 +val prems = goal  thy  
   8.963 +        "!!P. [|cont t; adm P|] ==> adm(%x. P (t x))";
   8.964 +by (rtac admI 1);
   8.965 +by (stac (cont2contlub RS contlubE RS spec RS mp) 1);
   8.966 +by (atac 1);
   8.967 +by (atac 1);
   8.968 +by (etac admD 1);
   8.969 +by (etac (cont2mono RS ch2ch_monofun) 1);
   8.970 +by (atac 1);
   8.971 +by (atac 1);
   8.972 +qed "adm_subst";
   8.973  
   8.974 -qed_goal "adm_UU_not_less"  thy "adm(%x.~ UU << t(x))"
   8.975 - (fn prems => [Simp_tac 1]);
   8.976 +val prems = goal  thy "adm(%x.~ UU << t(x))";
   8.977 +by (Simp_tac 1);
   8.978 +qed "adm_UU_not_less";
   8.979  
   8.980 -qed_goalw "adm_not_UU"  thy [adm_def] 
   8.981 -        "!!t. cont(t)==> adm(%x.~ (t x) = UU)"
   8.982 - (fn prems =>
   8.983 -        [
   8.984 -        (strip_tac 1),
   8.985 -        (rtac contrapos 1),
   8.986 -        (etac spec 1),
   8.987 -        (rtac (chain_UU_I RS spec) 1),
   8.988 -        (rtac (cont2mono RS ch2ch_monofun) 1),
   8.989 -        (atac 1),
   8.990 -        (atac 1),
   8.991 -        (rtac (cont2contlub RS contlubE RS spec RS mp RS subst) 1),
   8.992 -        (atac 1),
   8.993 -        (atac 1),
   8.994 -        (atac 1)
   8.995 -        ]);
   8.996  
   8.997 -qed_goal "adm_eq"  thy 
   8.998 -        "!!u. [|cont u ; cont v|]==> adm(%x. u x = v x)"
   8.999 - (fn prems => [asm_simp_tac (simpset() addsimps [po_eq_conv]) 1]);
  8.1000 +Goalw [adm_def] "cont(t)==> adm(%x.~ (t x) = UU)";
  8.1001 +by (strip_tac 1);
  8.1002 +by (rtac contrapos 1);
  8.1003 +by (etac spec 1);
  8.1004 +by (rtac (chain_UU_I RS spec) 1);
  8.1005 +by (etac (cont2mono RS ch2ch_monofun) 1);
  8.1006 +by (atac 1);
  8.1007 +by (etac (cont2contlub RS contlubE RS spec RS mp RS subst) 1);
  8.1008 +by (atac 1);
  8.1009 +by (atac 1);
  8.1010 +qed "adm_not_UU";
  8.1011 +
  8.1012 +Goal "[|cont u ; cont v|]==> adm(%x. u x = v x)";
  8.1013 +by (asm_simp_tac (simpset() addsimps [po_eq_conv]) 1);
  8.1014 +qed "adm_eq";
  8.1015  
  8.1016  
  8.1017  
  8.1018 @@ -664,202 +588,178 @@
  8.1019  (* admissibility for disjunction is hard to prove. It takes 10 Lemmas       *)
  8.1020  (* ------------------------------------------------------------------------ *)
  8.1021  
  8.1022 -local
  8.1023  
  8.1024 -  val adm_disj_lemma1 = prove_goal HOL.thy 
  8.1025 -  "!n. P(Y n)|Q(Y n) ==> (? i.!j. R i j --> Q(Y(j))) | (!i.? j. R i j & P(Y(j)))"
  8.1026 - (fn prems =>
  8.1027 -        [
  8.1028 -        (cut_facts_tac prems 1),
  8.1029 -        (fast_tac HOL_cs 1)
  8.1030 -        ]);
  8.1031 +val prems = goal HOL.thy 
  8.1032 +  "!n. P(Y n)|Q(Y n) ==> (? i.!j. R i j --> Q(Y(j))) | (!i.? j. R i j & P(Y(j)))";
  8.1033 +by (cut_facts_tac prems 1);
  8.1034 +by (fast_tac HOL_cs 1);
  8.1035 +qed "adm_disj_lemma1";
  8.1036  
  8.1037 -  val adm_disj_lemma2 = prove_goal thy  
  8.1038 +val _ = goal thy  
  8.1039    "!!Q. [| adm(Q); ? X. chain(X) & (!n. Q(X(n))) &\
  8.1040 -  \   lub(range(Y))=lub(range(X))|] ==> Q(lub(range(Y)))"
  8.1041 - (fn _ => [fast_tac (claset() addEs [admD] addss simpset()) 1]);
  8.1042 +  \   lub(range(Y))=lub(range(X))|] ==> Q(lub(range(Y)))";
  8.1043 +by (fast_tac (claset() addEs [admD] addss simpset()) 1);
  8.1044 +qed "adm_disj_lemma2";
  8.1045  
  8.1046 -  val adm_disj_lemma3 = prove_goalw thy [chain]
  8.1047 -  "!!Q. chain(Y) ==> chain(%m. if m < Suc i then Y(Suc i) else Y m)"
  8.1048 - (fn _ =>
  8.1049 -        [
  8.1050 -        Asm_simp_tac 1,
  8.1051 -        safe_tac HOL_cs,
  8.1052 -        subgoal_tac "ia = i" 1,
  8.1053 -        ALLGOALS Asm_simp_tac
  8.1054 -        ]);
  8.1055 +val _ = goalw thy [chain]
  8.1056 +  "!!Q. chain(Y) ==> chain(%m. if m < Suc i then Y(Suc i) else Y m)";
  8.1057 +by (Asm_simp_tac 1);
  8.1058 +by (safe_tac HOL_cs);
  8.1059 +by (subgoal_tac "ia = i" 1);
  8.1060 +by (ALLGOALS Asm_simp_tac);
  8.1061 +qed "adm_disj_lemma3";
  8.1062  
  8.1063 -  val adm_disj_lemma4 = prove_goal Arith.thy
  8.1064 -  "!!Q. !j. i < j --> Q(Y(j))  ==> !n. Q( if n < Suc i then Y(Suc i) else Y n)"
  8.1065 - (fn _ =>
  8.1066 -        [asm_simp_tac (simpset_of Arith.thy) 1]);
  8.1067 +val _ = goal Arith.thy
  8.1068 +  "!!Q. !j. i < j --> Q(Y(j))  ==> !n. Q( if n < Suc i then Y(Suc i) else Y n)";
  8.1069 +by (asm_simp_tac (simpset_of Arith.thy) 1);
  8.1070 +qed "adm_disj_lemma4";
  8.1071  
  8.1072 -  val adm_disj_lemma5 = prove_goal thy
  8.1073 +val prems = goal thy
  8.1074    "!!Y::nat=>'a::cpo. [| chain(Y); ! j. i < j --> Q(Y(j)) |] ==>\
  8.1075 -  \       lub(range(Y)) = lub(range(%m. if m< Suc(i) then Y(Suc(i)) else Y m))"
  8.1076 - (fn prems =>
  8.1077 -        [
  8.1078 -        safe_tac (HOL_cs addSIs [lub_equal2,adm_disj_lemma3]),
  8.1079 -        atac 2,
  8.1080 -        res_inst_tac [("x","i")] exI 1,
  8.1081 -        Asm_simp_tac 1
  8.1082 -        ]);
  8.1083 +  \       lub(range(Y)) = lub(range(%m. if m< Suc(i) then Y(Suc(i)) else Y m))";
  8.1084 +by (safe_tac (HOL_cs addSIs [lub_equal2,adm_disj_lemma3]));
  8.1085 +by (atac 2);
  8.1086 +by (res_inst_tac [("x","i")] exI 1);
  8.1087 +by (Asm_simp_tac 1);
  8.1088 +qed "adm_disj_lemma5";
  8.1089  
  8.1090 -  val adm_disj_lemma6 = prove_goal thy
  8.1091 +val prems = goal thy
  8.1092    "[| chain(Y::nat=>'a::cpo); ? i. ! j. i < j --> Q(Y(j)) |] ==>\
  8.1093 -  \         ? X. chain(X) & (! n. Q(X(n))) & lub(range(Y)) = lub(range(X))"
  8.1094 - (fn prems =>
  8.1095 -        [
  8.1096 -        (cut_facts_tac prems 1),
  8.1097 -        (etac exE 1),
  8.1098 -        (res_inst_tac [("x","%m. if m<Suc(i) then Y(Suc(i)) else Y m")] exI 1),
  8.1099 -        (rtac conjI 1),
  8.1100 -        (rtac adm_disj_lemma3 1),
  8.1101 -        (atac 1),
  8.1102 -        (rtac conjI 1),
  8.1103 -        (rtac adm_disj_lemma4 1),
  8.1104 -        (atac 1),
  8.1105 -        (rtac adm_disj_lemma5 1),
  8.1106 -        (atac 1),
  8.1107 -        (atac 1)
  8.1108 -        ]);
  8.1109 +  \         ? X. chain(X) & (! n. Q(X(n))) & lub(range(Y)) = lub(range(X))";
  8.1110 +by (cut_facts_tac prems 1);
  8.1111 +by (etac exE 1);
  8.1112 +by (res_inst_tac [("x","%m. if m<Suc(i) then Y(Suc(i)) else Y m")] exI 1);
  8.1113 +by (rtac conjI 1);
  8.1114 +by (rtac adm_disj_lemma3 1);
  8.1115 +by (atac 1);
  8.1116 +by (rtac conjI 1);
  8.1117 +by (rtac adm_disj_lemma4 1);
  8.1118 +by (atac 1);
  8.1119 +by (rtac adm_disj_lemma5 1);
  8.1120 +by (atac 1);
  8.1121 +by (atac 1);
  8.1122 +qed "adm_disj_lemma6";
  8.1123  
  8.1124 -  val adm_disj_lemma7 = prove_goal thy 
  8.1125 +val prems = goal thy 
  8.1126    "[| chain(Y::nat=>'a::cpo); ! i. ? j. i < j & P(Y(j))  |] ==>\
  8.1127 -  \         chain(%m. Y(Least(%j. m<j & P(Y(j)))))"
  8.1128 - (fn prems =>
  8.1129 -        [
  8.1130 -        (cut_facts_tac prems 1),
  8.1131 -        (rtac chainI 1),
  8.1132 -        (rtac allI 1),
  8.1133 -        (rtac chain_mono3 1),
  8.1134 -        (atac 1),
  8.1135 -        (rtac Least_le 1),
  8.1136 -        (rtac conjI 1),
  8.1137 -        (rtac Suc_lessD 1),
  8.1138 -        (etac allE 1),
  8.1139 -        (etac exE 1),
  8.1140 -        (rtac (LeastI RS conjunct1) 1),
  8.1141 -        (atac 1),
  8.1142 -        (etac allE 1),
  8.1143 -        (etac exE 1),
  8.1144 -        (rtac (LeastI RS conjunct2) 1),
  8.1145 -        (atac 1)
  8.1146 -        ]);
  8.1147 +  \         chain(%m. Y(Least(%j. m<j & P(Y(j)))))";
  8.1148 +by (cut_facts_tac prems 1);
  8.1149 +by (rtac chainI 1);
  8.1150 +by (rtac allI 1);
  8.1151 +by (rtac chain_mono3 1);
  8.1152 +by (atac 1);
  8.1153 +by (rtac Least_le 1);
  8.1154 +by (rtac conjI 1);
  8.1155 +by (rtac Suc_lessD 1);
  8.1156 +by (etac allE 1);
  8.1157 +by (etac exE 1);
  8.1158 +by (rtac (LeastI RS conjunct1) 1);
  8.1159 +by (atac 1);
  8.1160 +by (etac allE 1);
  8.1161 +by (etac exE 1);
  8.1162 +by (rtac (LeastI RS conjunct2) 1);
  8.1163 +by (atac 1);
  8.1164 +qed "adm_disj_lemma7";
  8.1165  
  8.1166 -  val adm_disj_lemma8 = prove_goal thy 
  8.1167 -  "[| ! i. ? j. i < j & P(Y(j)) |] ==> ! m. P(Y(LEAST j::nat. m<j & P(Y(j))))"
  8.1168 - (fn prems =>
  8.1169 -        [
  8.1170 -        (cut_facts_tac prems 1),
  8.1171 -        (strip_tac 1),
  8.1172 -        (etac allE 1),
  8.1173 -        (etac exE 1),
  8.1174 -        (etac (LeastI RS conjunct2) 1)
  8.1175 -        ]);
  8.1176 +val prems = goal thy 
  8.1177 +  "[| ! i. ? j. i < j & P(Y(j)) |] ==> ! m. P(Y(LEAST j::nat. m<j & P(Y(j))))";
  8.1178 +by (cut_facts_tac prems 1);
  8.1179 +by (strip_tac 1);
  8.1180 +by (etac allE 1);
  8.1181 +by (etac exE 1);
  8.1182 +by (etac (LeastI RS conjunct2) 1);
  8.1183 +qed "adm_disj_lemma8";
  8.1184  
  8.1185 -  val adm_disj_lemma9 = prove_goal thy
  8.1186 +val prems = goal thy
  8.1187    "[| chain(Y::nat=>'a::cpo); ! i. ? j. i < j & P(Y(j)) |] ==>\
  8.1188 -  \         lub(range(Y)) = lub(range(%m. Y(Least(%j. m<j & P(Y(j))))))"
  8.1189 - (fn prems =>
  8.1190 -        [
  8.1191 -        (cut_facts_tac prems 1),
  8.1192 -        (rtac antisym_less 1),
  8.1193 -        (rtac lub_mono 1),
  8.1194 -        (atac 1),
  8.1195 -        (rtac adm_disj_lemma7 1),
  8.1196 -        (atac 1),
  8.1197 -        (atac 1),
  8.1198 -        (strip_tac 1),
  8.1199 -        (rtac (chain_mono RS mp) 1),
  8.1200 -        (atac 1),
  8.1201 -        (etac allE 1),
  8.1202 -        (etac exE 1),
  8.1203 -        (rtac (LeastI RS conjunct1) 1),
  8.1204 -        (atac 1),
  8.1205 -        (rtac lub_mono3 1),
  8.1206 -        (rtac adm_disj_lemma7 1),
  8.1207 -        (atac 1),
  8.1208 -        (atac 1),
  8.1209 -        (atac 1),
  8.1210 -        (strip_tac 1),
  8.1211 -        (rtac exI 1),
  8.1212 -        (rtac (chain_mono RS mp) 1),
  8.1213 -        (atac 1),
  8.1214 -        (rtac lessI 1)
  8.1215 -        ]);
  8.1216 +  \         lub(range(Y)) = lub(range(%m. Y(Least(%j. m<j & P(Y(j))))))";
  8.1217 +by (cut_facts_tac prems 1);
  8.1218 +by (rtac antisym_less 1);
  8.1219 +by (rtac lub_mono 1);
  8.1220 +by (atac 1);
  8.1221 +by (rtac adm_disj_lemma7 1);
  8.1222 +by (atac 1);
  8.1223 +by (atac 1);
  8.1224 +by (strip_tac 1);
  8.1225 +by (rtac (chain_mono RS mp) 1);
  8.1226 +by (atac 1);
  8.1227 +by (etac allE 1);
  8.1228 +by (etac exE 1);
  8.1229 +by (rtac (LeastI RS conjunct1) 1);
  8.1230 +by (atac 1);
  8.1231 +by (rtac lub_mono3 1);
  8.1232 +by (rtac adm_disj_lemma7 1);
  8.1233 +by (atac 1);
  8.1234 +by (atac 1);
  8.1235 +by (atac 1);
  8.1236 +by (strip_tac 1);
  8.1237 +by (rtac exI 1);
  8.1238 +by (rtac (chain_mono RS mp) 1);
  8.1239 +by (atac 1);
  8.1240 +by (rtac lessI 1);
  8.1241 +qed "adm_disj_lemma9";
  8.1242  
  8.1243 -  val adm_disj_lemma10 = prove_goal thy
  8.1244 +val prems = goal thy
  8.1245    "[| chain(Y::nat=>'a::cpo); ! i. ? j. i < j & P(Y(j)) |] ==>\
  8.1246 -  \         ? X. chain(X) & (! n. P(X(n))) & lub(range(Y)) = lub(range(X))"
  8.1247 - (fn prems =>
  8.1248 -        [
  8.1249 -        (cut_facts_tac prems 1),
  8.1250 -        (res_inst_tac [("x","%m. Y(Least(%j. m<j & P(Y(j))))")] exI 1),
  8.1251 -        (rtac conjI 1),
  8.1252 -        (rtac adm_disj_lemma7 1),
  8.1253 -        (atac 1),
  8.1254 -        (atac 1),
  8.1255 -        (rtac conjI 1),
  8.1256 -        (rtac adm_disj_lemma8 1),
  8.1257 -        (atac 1),
  8.1258 -        (rtac adm_disj_lemma9 1),
  8.1259 -        (atac 1),
  8.1260 -        (atac 1)
  8.1261 -        ]);
  8.1262 +  \         ? X. chain(X) & (! n. P(X(n))) & lub(range(Y)) = lub(range(X))";
  8.1263 +by (cut_facts_tac prems 1);
  8.1264 +by (res_inst_tac [("x","%m. Y(Least(%j. m<j & P(Y(j))))")] exI 1);
  8.1265 +by (rtac conjI 1);
  8.1266 +by (rtac adm_disj_lemma7 1);
  8.1267 +by (atac 1);
  8.1268 +by (atac 1);
  8.1269 +by (rtac conjI 1);
  8.1270 +by (rtac adm_disj_lemma8 1);
  8.1271 +by (atac 1);
  8.1272 +by (rtac adm_disj_lemma9 1);
  8.1273 +by (atac 1);
  8.1274 +by (atac 1);
  8.1275 +qed "adm_disj_lemma10";
  8.1276  
  8.1277 -  val adm_disj_lemma12 = prove_goal thy
  8.1278 -  "[| adm(P); chain(Y);? i. ! j. i < j --> P(Y(j))|]==>P(lub(range(Y)))"
  8.1279 - (fn prems =>
  8.1280 -        [
  8.1281 -        (cut_facts_tac prems 1),
  8.1282 -        (etac adm_disj_lemma2 1),
  8.1283 -        (etac adm_disj_lemma6 1),
  8.1284 -        (atac 1)
  8.1285 -        ]);
  8.1286 +val prems = goal thy
  8.1287 +  "[| adm(P); chain(Y);? i. ! j. i < j --> P(Y(j))|]==>P(lub(range(Y)))";
  8.1288 +by (cut_facts_tac prems 1);
  8.1289 +by (etac adm_disj_lemma2 1);
  8.1290 +by (etac adm_disj_lemma6 1);
  8.1291 +by (atac 1);
  8.1292 +qed "adm_disj_lemma12";
  8.1293  
  8.1294 -in
  8.1295  
  8.1296 -val adm_lemma11 = prove_goal thy
  8.1297 -"[| adm(P); chain(Y); ! i. ? j. i < j & P(Y(j)) |]==>P(lub(range(Y)))"
  8.1298 - (fn prems =>
  8.1299 -        [
  8.1300 -        (cut_facts_tac prems 1),
  8.1301 -        (etac adm_disj_lemma2 1),
  8.1302 -        (etac adm_disj_lemma10 1),
  8.1303 -        (atac 1)
  8.1304 -        ]);
  8.1305 +val prems = goal thy
  8.1306 +"[| adm(P); chain(Y); ! i. ? j. i < j & P(Y(j)) |]==>P(lub(range(Y)))";
  8.1307 +by (cut_facts_tac prems 1);
  8.1308 +by (etac adm_disj_lemma2 1);
  8.1309 +by (etac adm_disj_lemma10 1);
  8.1310 +by (atac 1);
  8.1311 +qed "adm_lemma11";
  8.1312  
  8.1313 -val adm_disj = prove_goal thy  
  8.1314 -        "!!P. [| adm P; adm Q |] ==> adm(%x. P x | Q x)"
  8.1315 - (fn prems =>
  8.1316 -        [
  8.1317 -        (rtac admI 1),
  8.1318 -        (rtac (adm_disj_lemma1 RS disjE) 1),
  8.1319 -        (atac 1),
  8.1320 -        (rtac disjI2 1),
  8.1321 -        (etac adm_disj_lemma12 1),
  8.1322 -        (atac 1),
  8.1323 -        (atac 1),
  8.1324 -        (rtac disjI1 1),
  8.1325 -        (etac adm_lemma11 1),
  8.1326 -        (atac 1),
  8.1327 -        (atac 1)
  8.1328 -        ]);
  8.1329 +val prems = goal thy  
  8.1330 +        "!!P. [| adm P; adm Q |] ==> adm(%x. P x | Q x)";
  8.1331 +by (rtac admI 1);
  8.1332 +by (rtac (adm_disj_lemma1 RS disjE) 1);
  8.1333 +by (atac 1);
  8.1334 +by (rtac disjI2 1);
  8.1335 +by (etac adm_disj_lemma12 1);
  8.1336 +by (atac 1);
  8.1337 +by (atac 1);
  8.1338 +by (rtac disjI1 1);
  8.1339 +by (etac adm_lemma11 1);
  8.1340 +by (atac 1);
  8.1341 +by (atac 1);
  8.1342 +qed "adm_disj";
  8.1343  
  8.1344 -end;
  8.1345  
  8.1346  bind_thm("adm_lemma11",adm_lemma11);
  8.1347  bind_thm("adm_disj",adm_disj);
  8.1348  
  8.1349 -qed_goal "adm_imp"  thy  
  8.1350 -        "!!P. [| adm(%x.~(P x)); adm Q |] ==> adm(%x. P x --> Q x)" (K [
  8.1351 -        (subgoal_tac "(%x. P x --> Q x) = (%x. ~P x | Q x)" 1),
  8.1352 -         (etac ssubst 1),
  8.1353 -         (etac adm_disj 1),
  8.1354 -         (atac 1),
  8.1355 -        (Simp_tac 1)
  8.1356 -        ]);
  8.1357 +val prems = goal  thy  
  8.1358 +        "!!P. [| adm(%x.~(P x)); adm Q |] ==> adm(%x. P x --> Q x)";
  8.1359 +by (subgoal_tac "(%x. P x --> Q x) = (%x. ~P x | Q x)" 1);
  8.1360 +by (etac ssubst 1);
  8.1361 +by (etac adm_disj 1);
  8.1362 +by (atac 1);
  8.1363 +by (Simp_tac 1);
  8.1364 +qed "adm_imp";
  8.1365  
  8.1366  Goal "[| adm (%x. P x --> Q x); adm (%x. Q x --> P x) |] \
  8.1367  \           ==> adm (%x. P x = Q x)";
  8.1368 @@ -870,16 +770,16 @@
  8.1369  qed"adm_iff";
  8.1370  
  8.1371  
  8.1372 -qed_goal "adm_not_conj"  thy  
  8.1373 -"[| adm (%x. ~ P x); adm (%x. ~ Q x) |] ==> adm (%x. ~ (P x & Q x))"(fn prems=>[
  8.1374 -        cut_facts_tac prems 1,
  8.1375 -        subgoal_tac 
  8.1376 -        "(%x. ~ (P x & Q x)) = (%x. ~ P x | ~ Q x)" 1,
  8.1377 -        rtac ext 2,
  8.1378 -        fast_tac HOL_cs 2,
  8.1379 -        etac ssubst 1,
  8.1380 -        etac adm_disj 1,
  8.1381 -        atac 1]);
  8.1382 +val prems= goal  thy  
  8.1383 +"[| adm (%x. ~ P x); adm (%x. ~ Q x) |] ==> adm (%x. ~ (P x & Q x))";
  8.1384 +by (cut_facts_tac prems 1);
  8.1385 +by (subgoal_tac "(%x. ~ (P x & Q x)) = (%x. ~ P x | ~ Q x)" 1);
  8.1386 +by (rtac ext 2);
  8.1387 +by (fast_tac HOL_cs 2);
  8.1388 +by (etac ssubst 1);
  8.1389 +by (etac adm_disj 1);
  8.1390 +by (atac 1);
  8.1391 +qed "adm_not_conj";
  8.1392  
  8.1393  bind_thms ("adm_lemmas", [adm_imp,adm_disj,adm_eq,adm_not_UU,adm_UU_not_less,
  8.1394          adm_all2,adm_not_less,adm_not_conj,adm_iff]);
     9.1 --- a/src/HOLCF/Fun1.ML	Tue Jul 04 14:58:40 2000 +0200
     9.2 +++ b/src/HOLCF/Fun1.ML	Tue Jul 04 15:58:11 2000 +0200
     9.3 @@ -3,38 +3,30 @@
     9.4      Author:     Franz Regensburger
     9.5      Copyright   1993  Technische Universitaet Muenchen
     9.6  
     9.7 -Lemmas for fun1.thy 
     9.8 +Definition of the partial ordering for the type of all functions => (fun)
     9.9  *)
    9.10  
    9.11 -open Fun1;
    9.12 -
    9.13  (* ------------------------------------------------------------------------ *)
    9.14  (* less_fun is a partial order on 'a => 'b                                  *)
    9.15  (* ------------------------------------------------------------------------ *)
    9.16  
    9.17 -qed_goalw "refl_less_fun" thy [less_fun_def] "(f::'a::term =>'b::po) << f"
    9.18 -(fn prems =>
    9.19 -        [
    9.20 -        (fast_tac (HOL_cs addSIs [refl_less]) 1)
    9.21 -        ]);
    9.22 +val prems = goalw thy [less_fun_def] "(f::'a::term =>'b::po) << f";
    9.23 +by (fast_tac (HOL_cs addSIs [refl_less]) 1);
    9.24 +qed "refl_less_fun";
    9.25  
    9.26 -qed_goalw "antisym_less_fun" Fun1.thy [less_fun_def] 
    9.27 -        "[|(f1::'a::term =>'b::po) << f2; f2 << f1|] ==> f1 = f2"
    9.28 -(fn prems =>
    9.29 -        [
    9.30 -        (cut_facts_tac prems 1),
    9.31 -        (stac expand_fun_eq 1),
    9.32 -        (fast_tac (HOL_cs addSIs [antisym_less]) 1)
    9.33 -        ]);
    9.34 +val prems = goalw Fun1.thy [less_fun_def] 
    9.35 +        "[|(f1::'a::term =>'b::po) << f2; f2 << f1|] ==> f1 = f2";
    9.36 +by (cut_facts_tac prems 1);
    9.37 +by (stac expand_fun_eq 1);
    9.38 +by (fast_tac (HOL_cs addSIs [antisym_less]) 1);
    9.39 +qed "antisym_less_fun";
    9.40  
    9.41 -qed_goalw "trans_less_fun" Fun1.thy [less_fun_def] 
    9.42 -        "[|(f1::'a::term =>'b::po) << f2; f2 << f3 |] ==> f1 << f3"
    9.43 -(fn prems =>
    9.44 -        [
    9.45 -        (cut_facts_tac prems 1),
    9.46 -        (strip_tac 1),
    9.47 -        (rtac trans_less 1),
    9.48 -        (etac allE 1),
    9.49 -        (atac 1),
    9.50 -        ((etac allE 1) THEN (atac 1))
    9.51 -        ]);
    9.52 +val prems = goalw Fun1.thy [less_fun_def] 
    9.53 +        "[|(f1::'a::term =>'b::po) << f2; f2 << f3 |] ==> f1 << f3";
    9.54 +by (cut_facts_tac prems 1);
    9.55 +by (strip_tac 1);
    9.56 +by (rtac trans_less 1);
    9.57 +by (etac allE 1);
    9.58 +by (atac 1);
    9.59 +by ((etac allE 1) THEN (atac 1));
    9.60 +qed "trans_less_fun";
    10.1 --- a/src/HOLCF/Fun2.ML	Tue Jul 04 14:58:40 2000 +0200
    10.2 +++ b/src/HOLCF/Fun2.ML	Tue Jul 04 15:58:11 2000 +0200
    10.3 @@ -1,120 +1,94 @@
    10.4 -(*  Title:      HOLCF/fun2.ML
    10.5 +(*  Title:      HOLCF/Fun2.ML
    10.6      ID:         $Id$
    10.7      Author:     Franz Regensburger
    10.8      Copyright   1993 Technische Universitaet Muenchen
    10.9  
   10.10 -Lemmas for fun2.thy 
   10.11 +Class Instance =>::(term,po)po
   10.12  *)
   10.13  
   10.14 -open Fun2;
   10.15 -
   10.16  (* for compatibility with old HOLCF-Version *)
   10.17 -qed_goal "inst_fun_po" thy "(op <<)=(%f g.!x. f x << g x)"
   10.18 - (fn prems => 
   10.19 -        [
   10.20 -	(fold_goals_tac [less_fun_def]),
   10.21 -	(rtac refl 1)
   10.22 -        ]);
   10.23 +val prems = goal thy "(op <<)=(%f g.!x. f x << g x)";
   10.24 +by (fold_goals_tac [less_fun_def]);
   10.25 +by (rtac refl 1);
   10.26 +qed "inst_fun_po";
   10.27  
   10.28  (* ------------------------------------------------------------------------ *)
   10.29  (* Type 'a::term => 'b::pcpo is pointed                                     *)
   10.30  (* ------------------------------------------------------------------------ *)
   10.31  
   10.32 -qed_goal "minimal_fun" thy "(%z. UU) << x"
   10.33 -(fn prems =>
   10.34 -        [
   10.35 -        (simp_tac (simpset() addsimps [inst_fun_po,minimal]) 1)
   10.36 -        ]);
   10.37 +val prems = goal thy "(%z. UU) << x";
   10.38 +by (simp_tac (simpset() addsimps [inst_fun_po,minimal]) 1);
   10.39 +qed "minimal_fun";
   10.40  
   10.41  bind_thm ("UU_fun_def",minimal_fun RS minimal2UU RS sym);
   10.42  
   10.43 -qed_goal "least_fun" thy "? x::'a=>'b::pcpo.!y. x<<y"
   10.44 -(fn prems =>
   10.45 -        [
   10.46 -        (res_inst_tac [("x","(%z. UU)")] exI 1),
   10.47 -        (rtac (minimal_fun RS allI) 1)
   10.48 -        ]);
   10.49 +val prems = goal thy "? x::'a=>'b::pcpo.!y. x<<y";
   10.50 +by (res_inst_tac [("x","(%z. UU)")] exI 1);
   10.51 +by (rtac (minimal_fun RS allI) 1);
   10.52 +qed "least_fun";
   10.53  
   10.54  (* ------------------------------------------------------------------------ *)
   10.55  (* make the symbol << accessible for type fun                               *)
   10.56  (* ------------------------------------------------------------------------ *)
   10.57  
   10.58 -qed_goal "less_fun" thy "(f1 << f2) = (! x. f1(x) << f2(x))"
   10.59 -(fn prems =>
   10.60 -        [
   10.61 -        (stac inst_fun_po 1),
   10.62 -        (fold_goals_tac [less_fun_def]),
   10.63 -        (rtac refl 1)
   10.64 -        ]);
   10.65 +val prems = goal thy "(f1 << f2) = (! x. f1(x) << f2(x))";
   10.66 +by (stac inst_fun_po 1);
   10.67 +by (rtac refl 1);
   10.68 +qed "less_fun";
   10.69  
   10.70  (* ------------------------------------------------------------------------ *)
   10.71  (* chains of functions yield chains in the po range                         *)
   10.72  (* ------------------------------------------------------------------------ *)
   10.73  
   10.74 -qed_goal "ch2ch_fun" thy 
   10.75 -        "chain(S::nat=>('a=>'b::po)) ==> chain(% i. S(i)(x))"
   10.76 -(fn prems =>
   10.77 -        [
   10.78 -        (cut_facts_tac prems 1),
   10.79 -        (rewtac chain),
   10.80 -        (rtac allI 1),
   10.81 -        (rtac spec 1),
   10.82 -        (rtac (less_fun RS subst) 1),
   10.83 -        (etac allE 1),
   10.84 -        (atac 1)
   10.85 -        ]);
   10.86 +Goalw [chain] "chain(S::nat=>('a=>'b::po)) ==> chain(% i. S(i)(x))";
   10.87 +by (asm_full_simp_tac (simpset() addsimps [less_fun]) 1);
   10.88 +qed "ch2ch_fun";
   10.89  
   10.90  (* ------------------------------------------------------------------------ *)
   10.91  (* upper bounds of function chains yield upper bound in the po range        *)
   10.92  (* ------------------------------------------------------------------------ *)
   10.93  
   10.94 -qed_goal "ub2ub_fun" Fun2.thy 
   10.95 -   " range(S::nat=>('a::term => 'b::po)) <| u ==> range(%i. S i x) <| u(x)"
   10.96 -(fn prems =>
   10.97 -        [
   10.98 -        (cut_facts_tac prems 1),
   10.99 -        (rtac ub_rangeI 1),
  10.100 -        (rtac allI 1),
  10.101 -        (rtac allE 1),
  10.102 -        (rtac (less_fun RS subst) 1),
  10.103 -        (etac (ub_rangeE RS spec) 1),
  10.104 -        (atac 1)
  10.105 -        ]);
  10.106 +val prems = goal Fun2.thy 
  10.107 +   " range(S::nat=>('a::term => 'b::po)) <| u ==> range(%i. S i x) <| u(x)";
  10.108 +by (cut_facts_tac prems 1);
  10.109 +by (rtac ub_rangeI 1);
  10.110 +by (rtac allI 1);
  10.111 +by (rtac allE 1);
  10.112 +by (rtac (less_fun RS subst) 1);
  10.113 +by (etac (ub_rangeE RS spec) 1);
  10.114 +by (atac 1);
  10.115 +qed "ub2ub_fun";
  10.116  
  10.117  (* ------------------------------------------------------------------------ *)
  10.118  (* Type 'a::term => 'b::pcpo is chain complete                              *)
  10.119  (* ------------------------------------------------------------------------ *)
  10.120  
  10.121 -qed_goal "lub_fun"  Fun2.thy
  10.122 +val prems = goal  Fun2.thy
  10.123          "chain(S::nat=>('a::term => 'b::cpo)) ==> \
  10.124 -\        range(S) <<| (% x. lub(range(% i. S(i)(x))))"
  10.125 -(fn prems =>
  10.126 -        [
  10.127 -        (cut_facts_tac prems 1),
  10.128 -        (rtac is_lubI 1),
  10.129 -        (rtac conjI 1),
  10.130 -        (rtac ub_rangeI 1),
  10.131 -        (rtac allI 1),
  10.132 -        (stac less_fun 1),
  10.133 -        (rtac allI 1),
  10.134 -        (rtac is_ub_thelub 1),
  10.135 -        (etac ch2ch_fun 1),
  10.136 -        (strip_tac 1),
  10.137 -        (stac less_fun 1),
  10.138 -        (rtac allI 1),
  10.139 -        (rtac is_lub_thelub 1),
  10.140 -        (etac ch2ch_fun 1),
  10.141 -        (etac ub2ub_fun 1)
  10.142 -        ]);
  10.143 +\        range(S) <<| (% x. lub(range(% i. S(i)(x))))";
  10.144 +by (cut_facts_tac prems 1);
  10.145 +by (rtac is_lubI 1);
  10.146 +by (rtac conjI 1);
  10.147 +by (rtac ub_rangeI 1);
  10.148 +by (rtac allI 1);
  10.149 +by (stac less_fun 1);
  10.150 +by (rtac allI 1);
  10.151 +by (rtac is_ub_thelub 1);
  10.152 +by (etac ch2ch_fun 1);
  10.153 +by (strip_tac 1);
  10.154 +by (stac less_fun 1);
  10.155 +by (rtac allI 1);
  10.156 +by (rtac is_lub_thelub 1);
  10.157 +by (etac ch2ch_fun 1);
  10.158 +by (etac ub2ub_fun 1);
  10.159 +qed "lub_fun";
  10.160  
  10.161  bind_thm ("thelub_fun", lub_fun RS thelubI);
  10.162  (* chain ?S1 ==> lub (range ?S1) = (%x. lub (range (%i. ?S1 i x))) *)
  10.163  
  10.164 -qed_goal "cpo_fun"  Fun2.thy
  10.165 -        "chain(S::nat=>('a::term => 'b::cpo)) ==> ? x. range(S) <<| x"
  10.166 -(fn prems =>
  10.167 -        [
  10.168 -        (cut_facts_tac prems 1),
  10.169 -        (rtac exI 1),
  10.170 -        (etac lub_fun 1)
  10.171 -        ]);
  10.172 +val prems = goal  Fun2.thy
  10.173 +        "chain(S::nat=>('a::term => 'b::cpo)) ==> ? x. range(S) <<| x";
  10.174 +by (cut_facts_tac prems 1);
  10.175 +by (rtac exI 1);
  10.176 +by (etac lub_fun 1);
  10.177 +qed "cpo_fun";
    11.1 --- a/src/HOLCF/Fun3.ML	Tue Jul 04 14:58:40 2000 +0200
    11.2 +++ b/src/HOLCF/Fun3.ML	Tue Jul 04 15:58:11 2000 +0200
    11.3 @@ -1,14 +1,10 @@
    11.4 -(*  Title:      HOLCF/fun3.ML
    11.5 +(*  Title:      HOLCF/Fun3.ML
    11.6      ID:         $Id$
    11.7      Author:     Franz Regensburger
    11.8      Copyright   1993 Technische Universitaet Muenchen
    11.9  *)
   11.10  
   11.11 -open Fun3;
   11.12 -
   11.13  (* for compatibility with old HOLCF-Version *)
   11.14 -qed_goal "inst_fun_pcpo" thy "UU = (%x. UU)"
   11.15 - (fn prems => 
   11.16 -        [
   11.17 -        (simp_tac (HOL_ss addsimps [UU_def,UU_fun_def]) 1)
   11.18 -        ]);
   11.19 +val prems = goal thy "UU = (%x. UU)";
   11.20 +by (simp_tac (HOL_ss addsimps [UU_def,UU_fun_def]) 1);
   11.21 +qed "inst_fun_pcpo";
    12.1 --- a/src/HOLCF/HOLCF.ML	Tue Jul 04 14:58:40 2000 +0200
    12.2 +++ b/src/HOLCF/HOLCF.ML	Tue Jul 04 15:58:11 2000 +0200
    12.3 @@ -4,8 +4,6 @@
    12.4      Copyright   1993 Technische Universitaet Muenchen
    12.5  *)
    12.6  
    12.7 -open HOLCF;
    12.8 -
    12.9  use"adm.ML";
   12.10  
   12.11  simpset_ref() := simpset() addSolver
    13.1 --- a/src/HOLCF/Lift2.ML	Tue Jul 04 14:58:40 2000 +0200
    13.2 +++ b/src/HOLCF/Lift2.ML	Tue Jul 04 15:58:11 2000 +0200
    13.3 @@ -3,18 +3,14 @@
    13.4      Author:     Olaf Mueller
    13.5      Copyright   1996 Technische Universitaet Muenchen
    13.6  
    13.7 -Theorems for Lift2.thy
    13.8 +Class Instance lift::(term)po
    13.9  *)
   13.10  
   13.11 -open Lift2;
   13.12 -
   13.13  (* for compatibility with old HOLCF-Version *)
   13.14 -qed_goal "inst_lift_po" thy "(op <<)=(%x y. x=y|x=Undef)"
   13.15 - (fn prems => 
   13.16 -        [
   13.17 -        (fold_goals_tac [less_lift_def]),
   13.18 -        (rtac refl 1)
   13.19 -        ]);
   13.20 +val prems = goal thy "(op <<)=(%x y. x=y|x=Undef)";
   13.21 +by (fold_goals_tac [less_lift_def]);
   13.22 +by (rtac refl 1);
   13.23 +qed "inst_lift_po";
   13.24  
   13.25  (* -------------------------------------------------------------------------*)
   13.26  (* type ('a)lift is pointed                                                *)
   13.27 @@ -26,12 +22,10 @@
   13.28  
   13.29  bind_thm ("UU_lift_def",minimal_lift RS minimal2UU RS sym);
   13.30  
   13.31 -qed_goal "least_lift" thy "? x::'a lift.!y. x<<y"
   13.32 -(fn prems =>
   13.33 -        [
   13.34 -        (res_inst_tac [("x","Undef")] exI 1),
   13.35 -        (rtac (minimal_lift RS allI) 1)
   13.36 -        ]);
   13.37 +val prems = goal thy "? x::'a lift.!y. x<<y";
   13.38 +by (res_inst_tac [("x","Undef")] exI 1);
   13.39 +by (rtac (minimal_lift RS allI) 1);
   13.40 +qed "least_lift";
   13.41  
   13.42  (* ------------------------------------------------------------------------ *)
   13.43  (* ('a)lift is a cpo                                                       *)
   13.44 @@ -55,9 +49,8 @@
   13.45  
   13.46  (* Tailoring chain_mono2 of Pcpo.ML to Undef *)
   13.47  
   13.48 -Goal
   13.49 -"!!Y. [|? j.~Y(j)=Undef;chain(Y::nat=>('a)lift)|] \
   13.50 -\ ==> ? j.!i. j<i-->~Y(i)=Undef";
   13.51 +Goal "[| ? j.~Y(j)=Undef; chain(Y::nat=>('a)lift) |] \
   13.52 +\        ==> ? j.!i. j<i-->~Y(i)=Undef";
   13.53  by Safe_tac;
   13.54  by (Step_tac 1);
   13.55  by (strip_tac 1);
   13.56 @@ -70,8 +63,7 @@
   13.57  
   13.58  (* Tailoring flat_imp_chfin of Fix.ML to lift *)
   13.59  
   13.60 -Goal
   13.61 -        "(! Y. chain(Y::nat=>('a)lift)-->(? n. max_in_chain n Y))";
   13.62 +Goal "(! Y. chain(Y::nat=>('a)lift)-->(? n. max_in_chain n Y))";
   13.63  by (rewtac max_in_chain_def);  
   13.64  by (strip_tac 1);
   13.65  by (res_inst_tac [("P","!i. Y(i)=Undef")] case_split_thm  1);
   13.66 @@ -81,7 +73,6 @@
   13.67  by (etac spec 1);
   13.68  by (rtac sym 1);
   13.69  by (etac spec 1); 
   13.70 -
   13.71  by (subgoal_tac "!x y. x<<(y::('a)lift) --> x=Undef | x=y" 1);
   13.72  by (simp_tac (simpset() addsimps [inst_lift_po]) 2);
   13.73  by (rtac (chain_mono2_po RS exE) 1); 
   13.74 @@ -109,8 +100,7 @@
   13.75  
   13.76  (* Main Lemma: cpo_lift *)
   13.77  
   13.78 -Goal  
   13.79 -  "!!Y. chain(Y::nat=>('a)lift) ==> ? x. range(Y) <<|x";
   13.80 +Goal "chain(Y::nat=>('a)lift) ==> ? x. range(Y) <<|x";
   13.81  by (cut_inst_tac [] flat_imp_chfin_poo 1);
   13.82  by (Step_tac 1);
   13.83  by Safe_tac;
    14.1 --- a/src/HOLCF/Lift3.ML	Tue Jul 04 14:58:40 2000 +0200
    14.2 +++ b/src/HOLCF/Lift3.ML	Tue Jul 04 15:58:11 2000 +0200
    14.3 @@ -3,16 +3,14 @@
    14.4      Author:     Olaf Mueller
    14.5      Copyright   1996 Technische Universitaet Muenchen
    14.6  
    14.7 -Theorems for Lift3.thy
    14.8 +Class Instance lift::(term)pcpo
    14.9  *)
   14.10  
   14.11  
   14.12  (* for compatibility with old HOLCF-Version *)
   14.13 -qed_goal "inst_lift_pcpo" thy "UU = Undef"
   14.14 - (fn prems => 
   14.15 -        [
   14.16 -        (simp_tac (HOL_ss addsimps [UU_def,UU_lift_def]) 1)
   14.17 -        ]);
   14.18 +val prems = goal thy "UU = Undef";
   14.19 +by (simp_tac (HOL_ss addsimps [UU_def,UU_lift_def]) 1);
   14.20 +qed "inst_lift_pcpo";
   14.21  
   14.22  (* ----------------------------------------------------------- *)
   14.23  (*           In lift.simps Undef is replaced by UU             *)
   14.24 @@ -105,10 +103,10 @@
   14.25  
   14.26  bind_thm("Undef_eq_UU", inst_lift_pcpo RS sym);
   14.27  
   14.28 -val DefE = prove_goal thy "Def x = UU ==> R" 
   14.29 -    (fn prems => [
   14.30 -        cut_facts_tac prems 1,
   14.31 -        asm_full_simp_tac (HOL_ss addsimps [Def_not_UU]) 1]);
   14.32 +val prems = goal thy "Def x = UU ==> R";
   14.33 +by (cut_facts_tac prems 1);
   14.34 +by (asm_full_simp_tac (HOL_ss addsimps [Def_not_UU]) 1);
   14.35 +qed "DefE";
   14.36  
   14.37  val prems = goal thy "[| x = Def s; x = UU |] ==> R";
   14.38  by (cut_facts_tac prems 1);
    15.1 --- a/src/HOLCF/One.ML	Tue Jul 04 14:58:40 2000 +0200
    15.2 +++ b/src/HOLCF/One.ML	Tue Jul 04 15:58:11 2000 +0200
    15.3 @@ -3,31 +3,25 @@
    15.4      Author:     Oscar Slotosch
    15.5      Copyright   1997 Technische Universitaet Muenchen
    15.6  
    15.7 -Lemmas for One.thy
    15.8 +The unit domain
    15.9  *)
   15.10  
   15.11 -open One;
   15.12 -
   15.13  (* ------------------------------------------------------------------------ *)
   15.14  (* Exhaustion and Elimination for type one                                  *)
   15.15  (* ------------------------------------------------------------------------ *)
   15.16  
   15.17 -qed_goalw "Exh_one" thy [ONE_def] "t=UU | t = ONE"
   15.18 - (fn prems =>
   15.19 -        [
   15.20 -	(lift.induct_tac "t" 1),
   15.21 -	(Simp_tac 1),
   15.22 -	(Simp_tac 1)
   15.23 -	]);
   15.24 +val prems = goalw thy [ONE_def] "t=UU | t = ONE";
   15.25 +by (lift.induct_tac "t" 1);
   15.26 +by (Simp_tac 1);
   15.27 +by (Simp_tac 1);
   15.28 +qed "Exh_one";
   15.29  
   15.30 -qed_goal "oneE" thy
   15.31 -        "[| p=UU ==> Q; p = ONE ==>Q|] ==>Q"
   15.32 - (fn prems =>
   15.33 -        [
   15.34 -        (rtac (Exh_one RS disjE) 1),
   15.35 -        (eresolve_tac prems 1),
   15.36 -        (eresolve_tac prems 1)
   15.37 -        ]);
   15.38 +val prems = goal thy
   15.39 +        "[| p=UU ==> Q; p = ONE ==>Q|] ==>Q";
   15.40 +by (rtac (Exh_one RS disjE) 1);
   15.41 +by (eresolve_tac prems 1);
   15.42 +by (eresolve_tac prems 1);
   15.43 +qed "oneE";
   15.44  
   15.45  (* ------------------------------------------------------------------------ *) 
   15.46  (* tactic for one-thms                                                      *)
    16.1 --- a/src/HOLCF/Porder.ML	Tue Jul 04 14:58:40 2000 +0200
    16.2 +++ b/src/HOLCF/Porder.ML	Tue Jul 04 15:58:11 2000 +0200
    16.3 @@ -1,49 +1,48 @@
    16.4 -(*  Title:      HOLCF/Porder.thy
    16.5 +(*  Title:      HOLCF/Porder
    16.6      ID:         $Id$
    16.7      Author:     Franz Regensburger
    16.8      Copyright   1993 Technische Universitaet Muenchen
    16.9  
   16.10 -Lemmas for theory Porder.thy 
   16.11 +Conservative extension of theory Porder0 by constant definitions 
   16.12  *)
   16.13  
   16.14  (* ------------------------------------------------------------------------ *)
   16.15  (* lubs are unique                                                          *)
   16.16  (* ------------------------------------------------------------------------ *)
   16.17  
   16.18 -qed_goalw "unique_lub" thy [is_lub, is_ub] 
   16.19 -        "[| S <<| x ; S <<| y |] ==> x=y"
   16.20 -( fn prems =>
   16.21 -        [
   16.22 -        (cut_facts_tac prems 1),
   16.23 -        (etac conjE 1),
   16.24 -        (etac conjE 1),
   16.25 -        (rtac antisym_less 1),
   16.26 -        (rtac mp 1),((etac allE 1) THEN (atac 1) THEN (atac 1)),
   16.27 -        (rtac mp 1),((etac allE 1) THEN (atac 1) THEN (atac 1))
   16.28 -        ]);
   16.29 +
   16.30 +val prems = goalw thy [is_lub, is_ub] 
   16.31 +        "[| S <<| x ; S <<| y |] ==> x=y";
   16.32 +by (cut_facts_tac prems 1);
   16.33 +by (etac conjE 1);
   16.34 +by (etac conjE 1);
   16.35 +by (rtac antisym_less 1);
   16.36 +by (rtac mp 1);
   16.37 +by ((etac allE 1) THEN (atac 1) THEN (atac 1));
   16.38 +by (rtac mp 1);
   16.39 +by ((etac allE 1) THEN (atac 1) THEN (atac 1));
   16.40 +qed "unique_lub";
   16.41  
   16.42  (* ------------------------------------------------------------------------ *)
   16.43  (* chains are monotone functions                                            *)
   16.44  (* ------------------------------------------------------------------------ *)
   16.45  
   16.46 -qed_goalw "chain_mono" thy [chain] "chain F ==> x<y --> F x<<F y"
   16.47 -( fn prems =>
   16.48 -        [
   16.49 -        (cut_facts_tac prems 1),
   16.50 -        (induct_tac "y" 1),
   16.51 -        (rtac impI 1),
   16.52 -        (etac less_zeroE 1),
   16.53 -        (stac less_Suc_eq 1),
   16.54 -        (strip_tac 1),
   16.55 -        (etac disjE 1),
   16.56 -        (rtac trans_less 1),
   16.57 -        (etac allE 2),
   16.58 -        (atac 2),
   16.59 -        (fast_tac HOL_cs 1),
   16.60 -        (hyp_subst_tac 1),
   16.61 -        (etac allE 1),
   16.62 -        (atac 1)
   16.63 -        ]);
   16.64 +val prems = goalw thy [chain] "chain F ==> x<y --> F x<<F y";
   16.65 +by (cut_facts_tac prems 1);
   16.66 +by (induct_tac "y" 1);
   16.67 +by (rtac impI 1);
   16.68 +by (etac less_zeroE 1);
   16.69 +by (stac less_Suc_eq 1);
   16.70 +by (strip_tac 1);
   16.71 +by (etac disjE 1);
   16.72 +by (rtac trans_less 1);
   16.73 +by (etac allE 2);
   16.74 +by (atac 2);
   16.75 +by (fast_tac HOL_cs 1);
   16.76 +by (hyp_subst_tac 1);
   16.77 +by (etac allE 1);
   16.78 +by (atac 1);
   16.79 +qed "chain_mono";
   16.80  
   16.81  Goal "[| chain F; x <= y |] ==> F x << F y";
   16.82  by (rtac (le_imp_less_or_eq RS disjE) 1);
   16.83 @@ -56,16 +55,16 @@
   16.84  
   16.85  
   16.86  (* ------------------------------------------------------------------------ *)
   16.87 -(* The range of a chain is a totaly ordered     <<                           *)
   16.88 +(* The range of a chain is a totally ordered     <<                         *)
   16.89  (* ------------------------------------------------------------------------ *)
   16.90  
   16.91 -qed_goalw "chain_tord" thy [tord] 
   16.92 -"!!F. chain(F) ==> tord(range(F))"
   16.93 - (fn _ =>
   16.94 -        [
   16.95 -        Safe_tac,
   16.96 -        (rtac nat_less_cases 1),
   16.97 -        (ALLGOALS (fast_tac (claset() addIs [refl_less, chain_mono RS mp])))]);
   16.98 +val _ = goalw thy [tord] 
   16.99 +"!!F. chain(F) ==> tord(range(F))";
  16.100 +by (Safe_tac);
  16.101 +by (rtac nat_less_cases 1);
  16.102 +by (ALLGOALS (fast_tac (claset() addIs [refl_less, chain_mono RS mp])));
  16.103 +qed "chain_tord";
  16.104 +
  16.105  
  16.106  (* ------------------------------------------------------------------------ *)
  16.107  (* technical lemmas about lub and is_lub                                    *)
  16.108 @@ -106,57 +105,47 @@
  16.109  (* access to some definition as inference rule                              *)
  16.110  (* ------------------------------------------------------------------------ *)
  16.111  
  16.112 -qed_goalw "is_lubE" thy [is_lub]
  16.113 -        "S <<| x  ==> S <| x & (! u. S <| u  --> x << u)"
  16.114 -(fn prems =>
  16.115 -        [
  16.116 -        (cut_facts_tac prems 1),
  16.117 -        (atac 1)
  16.118 -        ]);
  16.119 +val prems = goalw thy [is_lub]
  16.120 +        "S <<| x  ==> S <| x & (! u. S <| u  --> x << u)";
  16.121 +by (cut_facts_tac prems 1);
  16.122 +by (atac 1);
  16.123 +qed "is_lubE";
  16.124  
  16.125 -qed_goalw "is_lubI" thy [is_lub]
  16.126 -        "S <| x & (! u. S <| u  --> x << u) ==> S <<| x"
  16.127 -(fn prems =>
  16.128 -        [
  16.129 -        (cut_facts_tac prems 1),
  16.130 -        (atac 1)
  16.131 -        ]);
  16.132 +val prems = goalw thy [is_lub]
  16.133 +        "S <| x & (! u. S <| u  --> x << u) ==> S <<| x";
  16.134 +by (cut_facts_tac prems 1);
  16.135 +by (atac 1);
  16.136 +qed "is_lubI";
  16.137  
  16.138 -qed_goalw "chainE" thy [chain] "chain F ==> !i. F(i) << F(Suc(i))"
  16.139 -(fn prems =>
  16.140 -        [
  16.141 -        (cut_facts_tac prems 1),
  16.142 -        (atac 1)]);
  16.143 +val prems = goalw thy [chain] "chain F ==> !i. F(i) << F(Suc(i))";
  16.144 +by (cut_facts_tac prems 1);
  16.145 +by (atac 1);
  16.146 +qed "chainE";
  16.147  
  16.148 -qed_goalw "chainI" thy [chain] "!i. F i << F(Suc i) ==> chain F"
  16.149 -(fn prems =>
  16.150 -        [
  16.151 -        (cut_facts_tac prems 1),
  16.152 -        (atac 1)]);
  16.153 +val prems = goalw thy [chain] "!i. F i << F(Suc i) ==> chain F";
  16.154 +by (cut_facts_tac prems 1);
  16.155 +by (atac 1);
  16.156 +qed "chainI";
  16.157  
  16.158  (* ------------------------------------------------------------------------ *)
  16.159  (* technical lemmas about (least) upper bounds of chains                    *)
  16.160  (* ------------------------------------------------------------------------ *)
  16.161  
  16.162 -qed_goalw "ub_rangeE" thy [is_ub] "range S <| x  ==> !i. S(i) << x"
  16.163 -(fn prems =>
  16.164 -        [
  16.165 -        (cut_facts_tac prems 1),
  16.166 -        (strip_tac 1),
  16.167 -        (rtac mp 1),
  16.168 -        (etac spec 1),
  16.169 -        (rtac rangeI 1)
  16.170 -        ]);
  16.171 +val prems = goalw thy [is_ub] "range S <| x  ==> !i. S(i) << x";
  16.172 +by (cut_facts_tac prems 1);
  16.173 +by (strip_tac 1);
  16.174 +by (rtac mp 1);
  16.175 +by (etac spec 1);
  16.176 +by (rtac rangeI 1);
  16.177 +qed "ub_rangeE";
  16.178  
  16.179 -qed_goalw "ub_rangeI" thy [is_ub] "!i. S i << x  ==> range S <| x"
  16.180 -(fn prems =>
  16.181 -        [
  16.182 -        (cut_facts_tac prems 1),
  16.183 -        (strip_tac 1),
  16.184 -        (etac rangeE 1),
  16.185 -        (hyp_subst_tac 1),
  16.186 -        (etac spec 1)
  16.187 -        ]);
  16.188 +val prems = goalw thy [is_ub] "!i. S i << x  ==> range S <| x";
  16.189 +by (cut_facts_tac prems 1);
  16.190 +by (strip_tac 1);
  16.191 +by (etac rangeE 1);
  16.192 +by (hyp_subst_tac 1);
  16.193 +by (etac spec 1);
  16.194 +qed "ub_rangeI";
  16.195  
  16.196  bind_thm ("is_ub_lub", is_lubE RS conjunct1 RS ub_rangeE RS spec);
  16.197  (* range(?S1) <<| ?x1 ==> ?S1(?x) << ?x1                                    *)
  16.198 @@ -168,38 +157,34 @@
  16.199  (* results about finite chains                                              *)
  16.200  (* ------------------------------------------------------------------------ *)
  16.201  
  16.202 -qed_goalw "lub_finch1" thy [max_in_chain_def]
  16.203 -        "[| chain C; max_in_chain i C|] ==> range C <<| C i"
  16.204 -(fn prems =>
  16.205 -        [
  16.206 -        (cut_facts_tac prems 1),
  16.207 -        (rtac is_lubI 1),
  16.208 -        (rtac conjI 1),
  16.209 -        (rtac ub_rangeI 1),
  16.210 -        (rtac allI 1),
  16.211 -        (res_inst_tac [("m","i")] nat_less_cases 1),
  16.212 -        (rtac (antisym_less_inverse RS conjunct2) 1),
  16.213 -        (etac (disjI1 RS less_or_eq_imp_le RS rev_mp) 1),
  16.214 -        (etac spec 1),
  16.215 -        (rtac (antisym_less_inverse RS conjunct2) 1),
  16.216 -        (etac (disjI2 RS less_or_eq_imp_le RS rev_mp) 1),
  16.217 -        (etac spec 1),
  16.218 -        (etac (chain_mono RS mp) 1),
  16.219 -        (atac 1),
  16.220 -        (strip_tac 1),
  16.221 -        (etac (ub_rangeE RS spec) 1)
  16.222 -        ]);     
  16.223 +val prems = goalw thy [max_in_chain_def]
  16.224 +        "[| chain C; max_in_chain i C|] ==> range C <<| C i";
  16.225 +by (cut_facts_tac prems 1);
  16.226 +by (rtac is_lubI 1);
  16.227 +by (rtac conjI 1);
  16.228 +by (rtac ub_rangeI 1);
  16.229 +by (rtac allI 1);
  16.230 +by (res_inst_tac [("m","i")] nat_less_cases 1);
  16.231 +by (rtac (antisym_less_inverse RS conjunct2) 1);
  16.232 +by (etac (disjI1 RS less_or_eq_imp_le RS rev_mp) 1);
  16.233 +by (etac spec 1);
  16.234 +by (rtac (antisym_less_inverse RS conjunct2) 1);
  16.235 +by (etac (disjI2 RS less_or_eq_imp_le RS rev_mp) 1);
  16.236 +by (etac spec 1);
  16.237 +by (etac (chain_mono RS mp) 1);
  16.238 +by (atac 1);
  16.239 +by (strip_tac 1);
  16.240 +by (etac (ub_rangeE RS spec) 1);
  16.241 +qed "lub_finch1";     
  16.242  
  16.243 -qed_goalw "lub_finch2" thy [finite_chain_def]
  16.244 -        "finite_chain(C) ==> range(C) <<| C(@ i. max_in_chain i C)"
  16.245 - (fn prems=>
  16.246 -        [
  16.247 -        (cut_facts_tac prems 1),
  16.248 -        (rtac lub_finch1 1),
  16.249 -        (etac conjunct1 1),
  16.250 -        (rtac (select_eq_Ex RS iffD2) 1),
  16.251 -        (etac conjunct2 1)
  16.252 -        ]);
  16.253 +val prems= goalw thy [finite_chain_def]
  16.254 +        "finite_chain(C) ==> range(C) <<| C(@ i. max_in_chain i C)";
  16.255 +by (cut_facts_tac prems 1);
  16.256 +by (rtac lub_finch1 1);
  16.257 +by (etac conjunct1 1);
  16.258 +by (rtac (select_eq_Ex RS iffD2) 1);
  16.259 +by (etac conjunct2 1);
  16.260 +qed "lub_finch2";
  16.261  
  16.262  
  16.263  Goal "x<<y ==> chain (%i. if i=0 then x else y)";
  16.264 @@ -210,16 +195,14 @@
  16.265  by (Asm_simp_tac 1);
  16.266  qed "bin_chain";
  16.267  
  16.268 -qed_goalw "bin_chainmax" thy [max_in_chain_def,le_def]
  16.269 -        "x<<y ==> max_in_chain (Suc 0) (%i. if (i=0) then x else y)"
  16.270 -(fn prems =>
  16.271 -        [
  16.272 -        (cut_facts_tac prems 1),
  16.273 -        (rtac allI 1),
  16.274 -        (induct_tac "j" 1),
  16.275 -        (Asm_simp_tac 1),
  16.276 -        (Asm_simp_tac 1)
  16.277 -        ]);
  16.278 +val prems = goalw thy [max_in_chain_def,le_def]
  16.279 +        "x<<y ==> max_in_chain (Suc 0) (%i. if (i=0) then x else y)";
  16.280 +by (cut_facts_tac prems 1);
  16.281 +by (rtac allI 1);
  16.282 +by (induct_tac "j" 1);
  16.283 +by (Asm_simp_tac 1);
  16.284 +by (Asm_simp_tac 1);
  16.285 +qed "bin_chainmax";
  16.286  
  16.287  Goal "x << y ==> range(%i::nat. if (i=0) then x else y) <<| y";
  16.288  by (res_inst_tac [("s","if (Suc 0) = 0 then x else y")] subst 1
    17.1 --- a/src/HOLCF/Porder0.ML	Tue Jul 04 14:58:40 2000 +0200
    17.2 +++ b/src/HOLCF/Porder0.ML	Tue Jul 04 15:58:11 2000 +0200
    17.3 @@ -3,25 +3,21 @@
    17.4      Author:     Oscar Slotosch
    17.5      Copyright   1997 Technische Universitaet Muenchen
    17.6  
    17.7 -    derive the characteristic axioms for the characteristic constants *)
    17.8 -
    17.9 -open Porder0;
   17.10 +    derive the characteristic axioms for the characteristic constants 
   17.11 +*)
   17.12  
   17.13  AddIffs [refl_less];
   17.14  
   17.15  (* ------------------------------------------------------------------------ *)
   17.16  (* minimal fixes least element                                              *)
   17.17  (* ------------------------------------------------------------------------ *)
   17.18 -bind_thm("minimal2UU",allI RS (prove_goal thy "!x::'a::po. uu<<x==>uu=(@u.!y. u<<y)"
   17.19 -(fn prems =>
   17.20 -        [
   17.21 -        (cut_facts_tac prems 1),
   17.22 -        (rtac antisym_less 1),
   17.23 -        (etac spec 1),
   17.24 -        (res_inst_tac [("a","uu")] selectI2 1),
   17.25 -	(atac 1),
   17.26 -	(etac spec 1)
   17.27 -        ])));
   17.28 +Goal "!x::'a::po. uu<<x ==> uu=(@u.!y. u<<y)";
   17.29 +by (rtac antisym_less 1);
   17.30 +by (etac spec 1);
   17.31 +by (res_inst_tac [("a","uu")] selectI2 1);
   17.32 +by (atac 1);
   17.33 +by (etac spec 1);
   17.34 +bind_thm ("minimal2UU", allI RS result());
   17.35  
   17.36  (* ------------------------------------------------------------------------ *)
   17.37  (* the reverse law of anti--symmetrie of <<                                 *)
    18.1 --- a/src/HOLCF/Sprod0.ML	Tue Jul 04 14:58:40 2000 +0200
    18.2 +++ b/src/HOLCF/Sprod0.ML	Tue Jul 04 15:58:11 2000 +0200
    18.3 @@ -1,336 +1,283 @@
    18.4 -(*  Title:      HOLCF/sprod0.thy
    18.5 +(*  Title:      HOLCF/Sprod0
    18.6      ID:         $Id$
    18.7      Author:     Franz Regensburger
    18.8      Copyright   1993  Technische Universitaet Muenchen
    18.9  
   18.10 -Lemmas for theory sprod0.thy
   18.11 +Strict product with typedef.
   18.12  *)
   18.13  
   18.14 -open Sprod0;
   18.15 -
   18.16  (* ------------------------------------------------------------------------ *)
   18.17  (* A non-emptyness result for Sprod                                         *)
   18.18  (* ------------------------------------------------------------------------ *)
   18.19  
   18.20 -qed_goalw "SprodI" Sprod0.thy [Sprod_def]
   18.21 -        "(Spair_Rep a b):Sprod"
   18.22 -(fn prems =>
   18.23 -        [
   18.24 -        (EVERY1 [rtac CollectI, rtac exI,rtac exI, rtac refl])
   18.25 -        ]);
   18.26 +val prems = goalw Sprod0.thy [Sprod_def]
   18.27 +        "(Spair_Rep a b):Sprod";
   18.28 +by (EVERY1 [rtac CollectI, rtac exI,rtac exI, rtac refl]);
   18.29 +qed "SprodI";
   18.30  
   18.31 -qed_goal "inj_on_Abs_Sprod" Sprod0.thy 
   18.32 -        "inj_on Abs_Sprod Sprod"
   18.33 -(fn prems =>
   18.34 -        [
   18.35 -        (rtac inj_on_inverseI 1),
   18.36 -        (etac Abs_Sprod_inverse 1)
   18.37 -        ]);
   18.38 +val prems = goal Sprod0.thy 
   18.39 +        "inj_on Abs_Sprod Sprod";
   18.40 +by (rtac inj_on_inverseI 1);
   18.41 +by (etac Abs_Sprod_inverse 1);
   18.42 +qed "inj_on_Abs_Sprod";
   18.43  
   18.44  (* ------------------------------------------------------------------------ *)
   18.45  (* Strictness and definedness of Spair_Rep                                  *)
   18.46  (* ------------------------------------------------------------------------ *)
   18.47  
   18.48 -qed_goalw "strict_Spair_Rep" Sprod0.thy [Spair_Rep_def]
   18.49 - "(a=UU | b=UU) ==> (Spair_Rep a b) = (Spair_Rep UU UU)"
   18.50 - (fn prems =>
   18.51 -        [
   18.52 -        (cut_facts_tac prems 1),
   18.53 -        (rtac ext 1),
   18.54 -        (rtac ext 1),
   18.55 -        (rtac iffI 1),
   18.56 -        (fast_tac HOL_cs 1),
   18.57 -        (fast_tac HOL_cs 1)
   18.58 -        ]);
   18.59 +val prems = goalw Sprod0.thy [Spair_Rep_def]
   18.60 + "(a=UU | b=UU) ==> (Spair_Rep a b) = (Spair_Rep UU UU)";
   18.61 +by (cut_facts_tac prems 1);
   18.62 +by (rtac ext 1);
   18.63 +by (rtac ext 1);
   18.64 +by (rtac iffI 1);
   18.65 +by (fast_tac HOL_cs 1);
   18.66 +by (fast_tac HOL_cs 1);
   18.67 +qed "strict_Spair_Rep";
   18.68  
   18.69 -qed_goalw "defined_Spair_Rep_rev" Sprod0.thy [Spair_Rep_def]
   18.70 - "(Spair_Rep a b) = (Spair_Rep UU UU) ==> (a=UU | b=UU)"
   18.71 - (fn prems =>
   18.72 -        [
   18.73 -        (case_tac "a=UU|b=UU" 1),
   18.74 -        (atac 1),
   18.75 -        (rtac disjI1 1),
   18.76 -        (rtac ((hd prems) RS fun_cong RS fun_cong RS iffD2 RS mp RS 
   18.77 -        conjunct1 RS sym) 1),
   18.78 -        (fast_tac HOL_cs 1),
   18.79 -        (fast_tac HOL_cs 1)
   18.80 -        ]);
   18.81 -
   18.82 +val prems = goalw Sprod0.thy [Spair_Rep_def]
   18.83 + "(Spair_Rep a b) = (Spair_Rep UU UU) ==> (a=UU | b=UU)";
   18.84 +by (case_tac "a=UU|b=UU" 1);
   18.85 +by (atac 1);
   18.86 +by (rtac disjI1 1);
   18.87 +by (rtac ((hd prems) RS fun_cong RS fun_cong RS iffD2 RS mp RS conjunct1 RS sym) 1);
   18.88 +by (fast_tac HOL_cs 1);
   18.89 +by (fast_tac HOL_cs 1);
   18.90 +qed "defined_Spair_Rep_rev";
   18.91  
   18.92  (* ------------------------------------------------------------------------ *)
   18.93  (* injectivity of Spair_Rep and Ispair                                      *)
   18.94  (* ------------------------------------------------------------------------ *)
   18.95  
   18.96 -qed_goalw "inject_Spair_Rep" Sprod0.thy [Spair_Rep_def]
   18.97 -"[|~aa=UU ; ~ba=UU ; Spair_Rep a b = Spair_Rep aa ba |] ==> a=aa & b=ba"
   18.98 - (fn prems =>
   18.99 -        [
  18.100 -        (cut_facts_tac prems 1),
  18.101 -        (rtac ((nth_elem (2,prems)) RS fun_cong  RS fun_cong 
  18.102 -                RS iffD1 RS mp) 1),
  18.103 -        (fast_tac HOL_cs 1),
  18.104 -        (fast_tac HOL_cs 1)
  18.105 -        ]);
  18.106 +val prems = goalw Sprod0.thy [Spair_Rep_def]
  18.107 +"[|~aa=UU ; ~ba=UU ; Spair_Rep a b = Spair_Rep aa ba |] ==> a=aa & b=ba";
  18.108 +by (cut_facts_tac prems 1);
  18.109 +by (rtac ((nth_elem (2,prems)) RS fun_cong  RS fun_cong RS iffD1 RS mp) 1);
  18.110 +by (fast_tac HOL_cs 1);
  18.111 +by (fast_tac HOL_cs 1);
  18.112 +qed "inject_Spair_Rep";
  18.113  
  18.114  
  18.115 -qed_goalw "inject_Ispair" Sprod0.thy [Ispair_def]
  18.116 -        "[|~aa=UU ; ~ba=UU ; Ispair a b = Ispair aa ba |] ==> a=aa & b=ba"
  18.117 -(fn prems =>
  18.118 -        [
  18.119 -        (cut_facts_tac prems 1),
  18.120 -        (etac inject_Spair_Rep 1),
  18.121 -        (atac 1),
  18.122 -        (etac (inj_on_Abs_Sprod  RS inj_onD) 1),
  18.123 -        (rtac SprodI 1),
  18.124 -        (rtac SprodI 1)
  18.125 -        ]);
  18.126 +val prems = goalw Sprod0.thy [Ispair_def]
  18.127 +        "[|~aa=UU ; ~ba=UU ; Ispair a b = Ispair aa ba |] ==> a=aa & b=ba";
  18.128 +by (cut_facts_tac prems 1);
  18.129 +by (etac inject_Spair_Rep 1);
  18.130 +by (atac 1);
  18.131 +by (etac (inj_on_Abs_Sprod  RS inj_onD) 1);
  18.132 +by (rtac SprodI 1);
  18.133 +by (rtac SprodI 1);
  18.134 +qed "inject_Ispair";
  18.135  
  18.136  
  18.137  (* ------------------------------------------------------------------------ *)
  18.138  (* strictness and definedness of Ispair                                     *)
  18.139  (* ------------------------------------------------------------------------ *)
  18.140  
  18.141 -qed_goalw "strict_Ispair" Sprod0.thy [Ispair_def] 
  18.142 - "(a=UU | b=UU) ==> Ispair a b = Ispair UU UU"
  18.143 -(fn prems =>
  18.144 -        [
  18.145 -        (cut_facts_tac prems 1),
  18.146 -        (etac (strict_Spair_Rep RS arg_cong) 1)
  18.147 -        ]);
  18.148 +val prems = goalw Sprod0.thy [Ispair_def] 
  18.149 + "(a=UU | b=UU) ==> Ispair a b = Ispair UU UU";
  18.150 +by (cut_facts_tac prems 1);
  18.151 +by (etac (strict_Spair_Rep RS arg_cong) 1);
  18.152 +qed "strict_Ispair";
  18.153  
  18.154 -qed_goalw "strict_Ispair1" Sprod0.thy [Ispair_def]
  18.155 -        "Ispair UU b  = Ispair UU UU"
  18.156 -(fn prems =>
  18.157 -        [
  18.158 -        (rtac (strict_Spair_Rep RS arg_cong) 1),
  18.159 -        (rtac disjI1 1),
  18.160 -        (rtac refl 1)
  18.161 -        ]);
  18.162 +val prems = goalw Sprod0.thy [Ispair_def]
  18.163 +        "Ispair UU b  = Ispair UU UU";
  18.164 +by (rtac (strict_Spair_Rep RS arg_cong) 1);
  18.165 +by (rtac disjI1 1);
  18.166 +by (rtac refl 1);
  18.167 +qed "strict_Ispair1";
  18.168  
  18.169 -qed_goalw "strict_Ispair2" Sprod0.thy [Ispair_def]
  18.170 -        "Ispair a UU = Ispair UU UU"
  18.171 -(fn prems =>
  18.172 -        [
  18.173 -        (rtac (strict_Spair_Rep RS arg_cong) 1),
  18.174 -        (rtac disjI2 1),
  18.175 -        (rtac refl 1)
  18.176 -        ]);
  18.177 +val prems = goalw Sprod0.thy [Ispair_def]
  18.178 +        "Ispair a UU = Ispair UU UU";
  18.179 +by (rtac (strict_Spair_Rep RS arg_cong) 1);
  18.180 +by (rtac disjI2 1);
  18.181 +by (rtac refl 1);
  18.182 +qed "strict_Ispair2";
  18.183  
  18.184 -qed_goal "strict_Ispair_rev" Sprod0.thy 
  18.185 -        "~Ispair x y = Ispair UU UU ==> ~x=UU & ~y=UU"
  18.186 -(fn prems =>
  18.187 -        [
  18.188 -        (cut_facts_tac prems 1),
  18.189 -        (rtac (de_Morgan_disj RS subst) 1),
  18.190 -        (etac contrapos 1),
  18.191 -        (etac strict_Ispair 1)
  18.192 -        ]);
  18.193 +val prems = goal Sprod0.thy 
  18.194 +        "~Ispair x y = Ispair UU UU ==> ~x=UU & ~y=UU";
  18.195 +by (cut_facts_tac prems 1);
  18.196 +by (rtac (de_Morgan_disj RS subst) 1);
  18.197 +by (etac contrapos 1);
  18.198 +by (etac strict_Ispair 1);
  18.199 +qed "strict_Ispair_rev";
  18.200  
  18.201 -qed_goalw "defined_Ispair_rev" Sprod0.thy [Ispair_def]
  18.202 -        "Ispair a b  = Ispair UU UU ==> (a = UU | b = UU)"
  18.203 -(fn prems =>
  18.204 -        [
  18.205 -        (cut_facts_tac prems 1),
  18.206 -        (rtac defined_Spair_Rep_rev 1),
  18.207 -        (rtac (inj_on_Abs_Sprod  RS inj_onD) 1),
  18.208 -        (atac 1),
  18.209 -        (rtac SprodI 1),
  18.210 -        (rtac SprodI 1)
  18.211 -        ]);
  18.212 +val prems = goalw Sprod0.thy [Ispair_def]
  18.213 +        "Ispair a b  = Ispair UU UU ==> (a = UU | b = UU)";
  18.214 +by (cut_facts_tac prems 1);
  18.215 +by (rtac defined_Spair_Rep_rev 1);
  18.216 +by (rtac (inj_on_Abs_Sprod  RS inj_onD) 1);
  18.217 +by (atac 1);
  18.218 +by (rtac SprodI 1);
  18.219 +by (rtac SprodI 1);
  18.220 +qed "defined_Ispair_rev";
  18.221  
  18.222 -qed_goal "defined_Ispair" Sprod0.thy  
  18.223 -"[|a~=UU; b~=UU|] ==> (Ispair a b) ~= (Ispair UU UU)" 
  18.224 -(fn prems =>
  18.225 -        [
  18.226 -        (cut_facts_tac prems 1),
  18.227 -        (rtac contrapos 1),
  18.228 -        (etac defined_Ispair_rev 2),
  18.229 -        (rtac (de_Morgan_disj RS iffD2) 1),
  18.230 -        (etac conjI 1),
  18.231 -        (atac 1)
  18.232 -        ]);
  18.233 +val prems = goal Sprod0.thy  
  18.234 +"[|a~=UU; b~=UU|] ==> (Ispair a b) ~= (Ispair UU UU)";
  18.235 +by (cut_facts_tac prems 1);
  18.236 +by (rtac contrapos 1);
  18.237 +by (etac defined_Ispair_rev 2);
  18.238 +by (rtac (de_Morgan_disj RS iffD2) 1);
  18.239 +by (etac conjI 1);
  18.240 +by (atac 1);
  18.241 +qed "defined_Ispair";
  18.242  
  18.243  
  18.244  (* ------------------------------------------------------------------------ *)
  18.245  (* Exhaustion of the strict product **                                      *)
  18.246  (* ------------------------------------------------------------------------ *)
  18.247  
  18.248 -qed_goalw "Exh_Sprod" Sprod0.thy [Ispair_def]
  18.249 -        "z=Ispair UU UU | (? a b. z=Ispair a b & a~=UU & b~=UU)"
  18.250 -(fn prems =>
  18.251 -        [
  18.252 -        (rtac (rewrite_rule [Sprod_def] Rep_Sprod RS CollectE) 1),
  18.253 -        (etac exE 1),
  18.254 -        (etac exE 1),
  18.255 -        (rtac (excluded_middle RS disjE) 1),
  18.256 -        (rtac disjI2 1),
  18.257 -        (rtac exI 1),
  18.258 -        (rtac exI 1),
  18.259 -        (rtac conjI 1),
  18.260 -        (rtac (Rep_Sprod_inverse RS sym RS trans) 1),
  18.261 -        (etac arg_cong 1),
  18.262 -        (rtac (de_Morgan_disj RS subst) 1),
  18.263 -        (atac 1),
  18.264 -        (rtac disjI1 1),
  18.265 -        (rtac (Rep_Sprod_inverse RS sym RS trans) 1),
  18.266 -        (res_inst_tac [("f","Abs_Sprod")] arg_cong 1),
  18.267 -        (etac trans 1),
  18.268 -        (etac strict_Spair_Rep 1)
  18.269 -        ]);
  18.270 +val prems = goalw Sprod0.thy [Ispair_def]
  18.271 +        "z=Ispair UU UU | (? a b. z=Ispair a b & a~=UU & b~=UU)";
  18.272 +by (rtac (rewrite_rule [Sprod_def] Rep_Sprod RS CollectE) 1);
  18.273 +by (etac exE 1);
  18.274 +by (etac exE 1);
  18.275 +by (rtac (excluded_middle RS disjE) 1);
  18.276 +by (rtac disjI2 1);
  18.277 +by (rtac exI 1);
  18.278 +by (rtac exI 1);
  18.279 +by (rtac conjI 1);
  18.280 +by (rtac (Rep_Sprod_inverse RS sym RS trans) 1);
  18.281 +by (etac arg_cong 1);
  18.282 +by (rtac (de_Morgan_disj RS subst) 1);
  18.283 +by (atac 1);
  18.284 +by (rtac disjI1 1);
  18.285 +by (rtac (Rep_Sprod_inverse RS sym RS trans) 1);
  18.286 +by (res_inst_tac [("f","Abs_Sprod")] arg_cong 1);
  18.287 +by (etac trans 1);
  18.288 +by (etac strict_Spair_Rep 1);
  18.289 +qed "Exh_Sprod";
  18.290  
  18.291  (* ------------------------------------------------------------------------ *)
  18.292  (* general elimination rule for strict product                              *)
  18.293  (* ------------------------------------------------------------------------ *)
  18.294  
  18.295 -qed_goal "IsprodE" Sprod0.thy
  18.296 -"[|p=Ispair UU UU ==> Q ;!!x y. [|p=Ispair x y; x~=UU ; y~=UU|] ==> Q|] ==> Q"
  18.297 -(fn prems =>
  18.298 -        [
  18.299 -        (rtac (Exh_Sprod RS disjE) 1),
  18.300 -        (etac (hd prems) 1),
  18.301 -        (etac exE 1),
  18.302 -        (etac exE 1),
  18.303 -        (etac conjE 1),
  18.304 -        (etac conjE 1),
  18.305 -        (etac (hd (tl prems)) 1),
  18.306 -        (atac 1),
  18.307 -        (atac 1)
  18.308 -        ]);
  18.309 +val prems = goal Sprod0.thy
  18.310 +"[|p=Ispair UU UU ==> Q ;!!x y. [|p=Ispair x y; x~=UU ; y~=UU|] ==> Q|] ==> Q";
  18.311 +by (rtac (Exh_Sprod RS disjE) 1);
  18.312 +by (etac (hd prems) 1);
  18.313 +by (etac exE 1);
  18.314 +by (etac exE 1);
  18.315 +by (etac conjE 1);
  18.316 +by (etac conjE 1);
  18.317 +by (etac (hd (tl prems)) 1);
  18.318 +by (atac 1);
  18.319 +by (atac 1);
  18.320 +qed "IsprodE";
  18.321  
  18.322  
  18.323  (* ------------------------------------------------------------------------ *)
  18.324  (* some results about the selectors Isfst, Issnd                            *)
  18.325  (* ------------------------------------------------------------------------ *)
  18.326  
  18.327 -qed_goalw "strict_Isfst" Sprod0.thy [Isfst_def] 
  18.328 -        "p=Ispair UU UU ==> Isfst p = UU"
  18.329 -(fn prems =>
  18.330 -        [
  18.331 -        (cut_facts_tac prems 1),
  18.332 -        (rtac select_equality 1),
  18.333 -        (rtac conjI 1),
  18.334 -        (fast_tac HOL_cs  1),
  18.335 -        (strip_tac 1),
  18.336 -        (res_inst_tac [("P","Ispair UU UU = Ispair a b")] notE 1),
  18.337 -        (rtac not_sym 1),
  18.338 -        (rtac defined_Ispair 1),
  18.339 -        (REPEAT (fast_tac HOL_cs  1))
  18.340 -        ]);
  18.341 +val prems = goalw Sprod0.thy [Isfst_def] 
  18.342 +        "p=Ispair UU UU ==> Isfst p = UU";
  18.343 +by (cut_facts_tac prems 1);
  18.344 +by (rtac select_equality 1);
  18.345 +by (rtac conjI 1);
  18.346 +by (fast_tac HOL_cs  1);
  18.347 +by (strip_tac 1);
  18.348 +by (res_inst_tac [("P","Ispair UU UU = Ispair a b")] notE 1);
  18.349 +by (rtac not_sym 1);
  18.350 +by (rtac defined_Ispair 1);
  18.351 +by (REPEAT (fast_tac HOL_cs  1));
  18.352 +qed "strict_Isfst";
  18.353  
  18.354  
  18.355 -qed_goal "strict_Isfst1" Sprod0.thy
  18.356 -        "Isfst(Ispair UU y) = UU"
  18.357 -(fn prems =>
  18.358 -        [
  18.359 -        (stac strict_Ispair1 1),
  18.360 -        (rtac strict_Isfst 1),
  18.361 -        (rtac refl 1)
  18.362 -        ]);
  18.363 +val prems = goal Sprod0.thy
  18.364 +        "Isfst(Ispair UU y) = UU";
  18.365 +by (stac strict_Ispair1 1);
  18.366 +by (rtac strict_Isfst 1);
  18.367 +by (rtac refl 1);
  18.368 +qed "strict_Isfst1";
  18.369  
  18.370 -qed_goal "strict_Isfst2" Sprod0.thy
  18.371 -        "Isfst(Ispair x UU) = UU"
  18.372 -(fn prems =>
  18.373 -        [
  18.374 -        (stac strict_Ispair2 1),
  18.375 -        (rtac strict_Isfst 1),
  18.376 -        (rtac refl 1)
  18.377 -        ]);
  18.378 +val prems = goal Sprod0.thy
  18.379 +        "Isfst(Ispair x UU) = UU";
  18.380 +by (stac strict_Ispair2 1);
  18.381 +by (rtac strict_Isfst 1);
  18.382 +by (rtac refl 1);
  18.383 +qed "strict_Isfst2";
  18.384  
  18.385  
  18.386 -qed_goalw "strict_Issnd" Sprod0.thy [Issnd_def] 
  18.387 -        "p=Ispair UU UU ==>Issnd p=UU"
  18.388 -(fn prems =>
  18.389 -        [
  18.390 -        (cut_facts_tac prems 1),
  18.391 -        (rtac select_equality 1),
  18.392 -        (rtac conjI 1),
  18.393 -        (fast_tac HOL_cs  1),
  18.394 -        (strip_tac 1),
  18.395 -        (res_inst_tac [("P","Ispair UU UU = Ispair a b")] notE 1),
  18.396 -        (rtac not_sym 1),
  18.397 -        (rtac defined_Ispair 1),
  18.398 -        (REPEAT (fast_tac HOL_cs  1))
  18.399 -        ]);
  18.400 +val prems = goalw Sprod0.thy [Issnd_def] 
  18.401 +        "p=Ispair UU UU ==>Issnd p=UU";
  18.402 +by (cut_facts_tac prems 1);
  18.403 +by (rtac select_equality 1);
  18.404 +by (rtac conjI 1);
  18.405 +by (fast_tac HOL_cs  1);
  18.406 +by (strip_tac 1);
  18.407 +by (res_inst_tac [("P","Ispair UU UU = Ispair a b")] notE 1);
  18.408 +by (rtac not_sym 1);
  18.409 +by (rtac defined_Ispair 1);
  18.410 +by (REPEAT (fast_tac HOL_cs  1));
  18.411 +qed "strict_Issnd";
  18.412  
  18.413 -qed_goal "strict_Issnd1" Sprod0.thy
  18.414 -        "Issnd(Ispair UU y) = UU"
  18.415 -(fn prems =>
  18.416 -        [
  18.417 -        (stac strict_Ispair1 1),
  18.418 -        (rtac strict_Issnd 1),
  18.419 -        (rtac refl 1)
  18.420 -        ]);
  18.421 +val prems = goal Sprod0.thy
  18.422 +        "Issnd(Ispair UU y) = UU";
  18.423 +by (stac strict_Ispair1 1);
  18.424 +by (rtac strict_Issnd 1);
  18.425 +by (rtac refl 1);
  18.426 +qed "strict_Issnd1";
  18.427  
  18.428 -qed_goal "strict_Issnd2" Sprod0.thy
  18.429 -        "Issnd(Ispair x UU) = UU"
  18.430 -(fn prems =>
  18.431 -        [
  18.432 -        (stac strict_Ispair2 1),
  18.433 -        (rtac strict_Issnd 1),
  18.434 -        (rtac refl 1)
  18.435 -        ]);
  18.436 +val prems = goal Sprod0.thy
  18.437 +        "Issnd(Ispair x UU) = UU";
  18.438 +by (stac strict_Ispair2 1);
  18.439 +by (rtac strict_Issnd 1);
  18.440 +by (rtac refl 1);
  18.441 +qed "strict_Issnd2";
  18.442  
  18.443 -qed_goalw "Isfst" Sprod0.thy [Isfst_def]
  18.444 -        "[|x~=UU ;y~=UU |] ==> Isfst(Ispair x y) = x"
  18.445 -(fn prems =>
  18.446 -        [
  18.447 -        (cut_facts_tac prems 1),
  18.448 -        (rtac select_equality 1),
  18.449 -        (rtac conjI 1),
  18.450 -        (strip_tac 1),
  18.451 -        (res_inst_tac [("P","Ispair x y = Ispair UU UU")] notE 1),
  18.452 -        (etac defined_Ispair 1),
  18.453 -        (atac 1),
  18.454 -        (atac 1),
  18.455 -        (strip_tac 1),
  18.456 -        (rtac (inject_Ispair RS conjunct1) 1),
  18.457 -        (fast_tac HOL_cs  3),
  18.458 -        (fast_tac HOL_cs  1),
  18.459 -        (fast_tac HOL_cs  1),
  18.460 -        (fast_tac HOL_cs  1)
  18.461 -        ]);
  18.462 +val prems = goalw Sprod0.thy [Isfst_def]
  18.463 +        "[|x~=UU ;y~=UU |] ==> Isfst(Ispair x y) = x";
  18.464 +by (cut_facts_tac prems 1);
  18.465 +by (rtac select_equality 1);
  18.466 +by (rtac conjI 1);
  18.467 +by (strip_tac 1);
  18.468 +by (res_inst_tac [("P","Ispair x y = Ispair UU UU")] notE 1);
  18.469 +by (etac defined_Ispair 1);
  18.470 +by (atac 1);
  18.471 +by (atac 1);
  18.472 +by (strip_tac 1);
  18.473 +by (rtac (inject_Ispair RS conjunct1) 1);
  18.474 +by (fast_tac HOL_cs  3);
  18.475 +by (fast_tac HOL_cs  1);
  18.476 +by (fast_tac HOL_cs  1);
  18.477 +by (fast_tac HOL_cs  1);
  18.478 +qed "Isfst";
  18.479  
  18.480 -qed_goalw "Issnd" Sprod0.thy [Issnd_def]
  18.481 -        "[|x~=UU ;y~=UU |] ==> Issnd(Ispair x y) = y"
  18.482 -(fn prems =>
  18.483 -        [
  18.484 -        (cut_facts_tac prems 1),
  18.485 -        (rtac select_equality 1),
  18.486 -        (rtac conjI 1),
  18.487 -        (strip_tac 1),
  18.488 -        (res_inst_tac [("P","Ispair x y = Ispair UU UU")] notE 1),
  18.489 -        (etac defined_Ispair 1),
  18.490 -        (atac 1),
  18.491 -        (atac 1),
  18.492 -        (strip_tac 1),
  18.493 -        (rtac (inject_Ispair RS conjunct2) 1),
  18.494 -        (fast_tac HOL_cs  3),
  18.495 -        (fast_tac HOL_cs  1),
  18.496 -        (fast_tac HOL_cs  1),
  18.497 -        (fast_tac HOL_cs  1)
  18.498 -        ]);
  18.499 +val prems = goalw Sprod0.thy [Issnd_def]
  18.500 +        "[|x~=UU ;y~=UU |] ==> Issnd(Ispair x y) = y";
  18.501 +by (cut_facts_tac prems 1);
  18.502 +by (rtac select_equality 1);
  18.503 +by (rtac conjI 1);
  18.504 +by (strip_tac 1);
  18.505 +by (res_inst_tac [("P","Ispair x y = Ispair UU UU")] notE 1);
  18.506 +by (etac defined_Ispair 1);
  18.507 +by (atac 1);
  18.508 +by (atac 1);
  18.509 +by (strip_tac 1);
  18.510 +by (rtac (inject_Ispair RS conjunct2) 1);
  18.511 +by (fast_tac HOL_cs  3);
  18.512 +by (fast_tac HOL_cs  1);
  18.513 +by (fast_tac HOL_cs  1);
  18.514 +by (fast_tac HOL_cs  1);
  18.515 +qed "Issnd";
  18.516  
  18.517 -qed_goal "Isfst2" Sprod0.thy "y~=UU ==>Isfst(Ispair x y)=x"
  18.518 -(fn prems =>
  18.519 -        [
  18.520 -        (cut_facts_tac prems 1),
  18.521 -        (res_inst_tac [("Q","x=UU")] (excluded_middle RS disjE) 1),
  18.522 -        (etac Isfst 1),
  18.523 -        (atac 1),
  18.524 -        (hyp_subst_tac 1),
  18.525 -        (rtac strict_Isfst1 1)
  18.526 -        ]);
  18.527 +val prems = goal Sprod0.thy "y~=UU ==>Isfst(Ispair x y)=x";
  18.528 +by (cut_facts_tac prems 1);
  18.529 +by (res_inst_tac [("Q","x=UU")] (excluded_middle RS disjE) 1);
  18.530 +by (etac Isfst 1);
  18.531 +by (atac 1);
  18.532 +by (hyp_subst_tac 1);
  18.533 +by (rtac strict_Isfst1 1);
  18.534 +qed "Isfst2";
  18.535  
  18.536 -qed_goal "Issnd2" Sprod0.thy "~x=UU ==>Issnd(Ispair x y)=y"
  18.537 -(fn prems =>
  18.538 -        [
  18.539 -        (cut_facts_tac prems 1),
  18.540 -        (res_inst_tac [("Q","y=UU")] (excluded_middle RS disjE) 1),
  18.541 -        (etac Issnd 1),
  18.542 -        (atac 1),
  18.543 -        (hyp_subst_tac 1),
  18.544 -        (rtac strict_Issnd2 1)
  18.545 -        ]);
  18.546 +val prems = goal Sprod0.thy "~x=UU ==>Issnd(Ispair x y)=y";
  18.547 +by (cut_facts_tac prems 1);
  18.548 +by (res_inst_tac [("Q","y=UU")] (excluded_middle RS disjE) 1);
  18.549 +by (etac Issnd 1);
  18.550 +by (atac 1);
  18.551 +by (hyp_subst_tac 1);
  18.552 +by (rtac strict_Issnd2 1);
  18.553 +qed "Issnd2";
  18.554  
  18.555  
  18.556  (* ------------------------------------------------------------------------ *)
  18.557 @@ -342,42 +289,36 @@
  18.558          addsimps [strict_Isfst1,strict_Isfst2,strict_Issnd1,strict_Issnd2,
  18.559                   Isfst2,Issnd2];
  18.560  
  18.561 -qed_goal "defined_IsfstIssnd" Sprod0.thy 
  18.562 -        "p~=Ispair UU UU ==> Isfst p ~= UU & Issnd p ~= UU"
  18.563 - (fn prems =>
  18.564 -        [
  18.565 -        (cut_facts_tac prems 1),
  18.566 -        (res_inst_tac [("p","p")] IsprodE 1),
  18.567 -        (contr_tac 1),
  18.568 -        (hyp_subst_tac 1),
  18.569 -        (rtac conjI 1),
  18.570 -        (asm_simp_tac Sprod0_ss 1),
  18.571 -        (asm_simp_tac Sprod0_ss 1)
  18.572 -        ]);
  18.573 +val prems = goal Sprod0.thy 
  18.574 +        "p~=Ispair UU UU ==> Isfst p ~= UU & Issnd p ~= UU";
  18.575 +by (cut_facts_tac prems 1);
  18.576 +by (res_inst_tac [("p","p")] IsprodE 1);
  18.577 +by (contr_tac 1);
  18.578 +by (hyp_subst_tac 1);
  18.579 +by (rtac conjI 1);
  18.580 +by (asm_simp_tac Sprod0_ss 1);
  18.581 +by (asm_simp_tac Sprod0_ss 1);
  18.582 +qed "defined_IsfstIssnd";
  18.583  
  18.584  
  18.585  (* ------------------------------------------------------------------------ *)
  18.586  (* Surjective pairing: equivalent to Exh_Sprod                              *)
  18.587  (* ------------------------------------------------------------------------ *)
  18.588  
  18.589 -qed_goal "surjective_pairing_Sprod" Sprod0.thy 
  18.590 -        "z = Ispair(Isfst z)(Issnd z)"
  18.591 -(fn prems =>
  18.592 -        [
  18.593 -        (res_inst_tac [("z1","z")] (Exh_Sprod RS disjE) 1),
  18.594 -        (asm_simp_tac Sprod0_ss 1),
  18.595 -        (etac exE 1),
  18.596 -        (etac exE 1),
  18.597 -        (asm_simp_tac Sprod0_ss 1)
  18.598 -        ]);
  18.599 +val prems = goal Sprod0.thy 
  18.600 +        "z = Ispair(Isfst z)(Issnd z)";
  18.601 +by (res_inst_tac [("z1","z")] (Exh_Sprod RS disjE) 1);
  18.602 +by (asm_simp_tac Sprod0_ss 1);
  18.603 +by (etac exE 1);
  18.604 +by (etac exE 1);
  18.605 +by (asm_simp_tac Sprod0_ss 1);
  18.606 +qed "surjective_pairing_Sprod";
  18.607  
  18.608 -qed_goal "Sel_injective_Sprod" thy 
  18.609 -        "[|Isfst x = Isfst y; Issnd x = Issnd y|] ==> x = y"
  18.610 -(fn prems =>
  18.611 -        [
  18.612 -        (cut_facts_tac prems 1),
  18.613 -        (subgoal_tac "Ispair(Isfst x)(Issnd x)=Ispair(Isfst y)(Issnd y)" 1),
  18.614 -        (rotate_tac ~1 1),
  18.615 -        (asm_full_simp_tac(HOL_ss addsimps[surjective_pairing_Sprod RS sym])1),
  18.616 -        (Asm_simp_tac 1)
  18.617 -        ]);
  18.618 +val prems = goal thy 
  18.619 +        "[|Isfst x = Isfst y; Issnd x = Issnd y|] ==> x = y";
  18.620 +by (cut_facts_tac prems 1);
  18.621 +by (subgoal_tac "Ispair(Isfst x)(Issnd x)=Ispair(Isfst y)(Issnd y)" 1);
  18.622 +by (rotate_tac ~1 1);
  18.623 +by (asm_full_simp_tac(HOL_ss addsimps[surjective_pairing_Sprod RS sym])1);
  18.624 +by (Asm_simp_tac 1);
  18.625 +qed "Sel_injective_Sprod";
    19.1 --- a/src/HOLCF/Sprod1.ML	Tue Jul 04 14:58:40 2000 +0200
    19.2 +++ b/src/HOLCF/Sprod1.ML	Tue Jul 04 15:58:11 2000 +0200
    19.3 @@ -3,34 +3,28 @@
    19.4      Author:     Franz Regensburger
    19.5      Copyright   1993  Technische Universitaet Muenchen
    19.6  
    19.7 -Lemmas for theory Sprod1.thy
    19.8  *)
    19.9  
   19.10 -open Sprod1;
   19.11 -
   19.12  (* ------------------------------------------------------------------------ *)
   19.13  (* less_sprod is a partial order on Sprod                                   *)
   19.14  (* ------------------------------------------------------------------------ *)
   19.15  
   19.16 -qed_goalw "refl_less_sprod" thy [less_sprod_def]"(p::'a ** 'b) << p"
   19.17 -(fn prems => [(fast_tac (HOL_cs addIs [refl_less]) 1)]);
   19.18 +val prems = goalw thy [less_sprod_def]"(p::'a ** 'b) << p";
   19.19 +by (fast_tac (HOL_cs addIs [refl_less]) 1);
   19.20 +qed "refl_less_sprod";
   19.21  
   19.22 -qed_goalw "antisym_less_sprod" thy [less_sprod_def]
   19.23 -        "[|(p1::'a ** 'b) << p2;p2 << p1|] ==> p1=p2"
   19.24 -(fn prems =>
   19.25 -        [
   19.26 -        (cut_facts_tac prems 1),
   19.27 -        (rtac Sel_injective_Sprod 1),
   19.28 -        (fast_tac (HOL_cs addIs [antisym_less]) 1),
   19.29 -        (fast_tac (HOL_cs addIs [antisym_less]) 1)
   19.30 -        ]);
   19.31 +val prems = goalw thy [less_sprod_def]
   19.32 +        "[|(p1::'a ** 'b) << p2;p2 << p1|] ==> p1=p2";
   19.33 +by (cut_facts_tac prems 1);
   19.34 +by (rtac Sel_injective_Sprod 1);
   19.35 +by (fast_tac (HOL_cs addIs [antisym_less]) 1);
   19.36 +by (fast_tac (HOL_cs addIs [antisym_less]) 1);
   19.37 +qed "antisym_less_sprod";
   19.38  
   19.39 -qed_goalw "trans_less_sprod" thy [less_sprod_def]
   19.40 -        "[|(p1::'a**'b) << p2;p2 << p3|] ==> p1 << p3"
   19.41 -(fn prems =>
   19.42 -        [
   19.43 -        (cut_facts_tac prems 1),
   19.44 -        (rtac conjI 1),
   19.45 -        (fast_tac (HOL_cs addIs [trans_less]) 1),
   19.46 -        (fast_tac (HOL_cs addIs [trans_less]) 1)
   19.47 -        ]);
   19.48 +val prems = goalw thy [less_sprod_def]
   19.49 +        "[|(p1::'a**'b) << p2;p2 << p3|] ==> p1 << p3";
   19.50 +by (cut_facts_tac prems 1);
   19.51 +by (rtac conjI 1);
   19.52 +by (fast_tac (HOL_cs addIs [trans_less]) 1);
   19.53 +by (fast_tac (HOL_cs addIs [trans_less]) 1);
   19.54 +qed "trans_less_sprod";
    20.1 --- a/src/HOLCF/Sprod2.ML	Tue Jul 04 14:58:40 2000 +0200
    20.2 +++ b/src/HOLCF/Sprod2.ML	Tue Jul 04 15:58:11 2000 +0200
    20.3 @@ -3,138 +3,108 @@
    20.4      Author:     Franz Regensburger
    20.5      Copyright   1993 Technische Universitaet Muenchen
    20.6  
    20.7 -Lemmas for Sprod2.thy
    20.8 +Class Instance **::(pcpo,pcpo)po
    20.9  *)
   20.10  
   20.11 -open Sprod2;
   20.12 -
   20.13  (* for compatibility with old HOLCF-Version *)
   20.14 -qed_goal "inst_sprod_po" thy "(op <<)=(%x y. Isfst x<<Isfst y&Issnd x<<Issnd y)"
   20.15 - (fn prems => 
   20.16 -        [
   20.17 -	(fold_goals_tac [less_sprod_def]),
   20.18 -	(rtac refl 1)
   20.19 -        ]);
   20.20 +val prems = goal thy "(op <<)=(%x y. Isfst x<<Isfst y&Issnd x<<Issnd y)";
   20.21 +by (fold_goals_tac [less_sprod_def]);
   20.22 +by (rtac refl 1);
   20.23 +qed "inst_sprod_po";
   20.24  
   20.25  (* ------------------------------------------------------------------------ *)
   20.26  (* type sprod is pointed                                                    *)
   20.27  (* ------------------------------------------------------------------------ *)
   20.28  
   20.29 -qed_goal "minimal_sprod" thy "Ispair UU UU << p"
   20.30 -(fn prems =>
   20.31 -        [
   20.32 -        (simp_tac(Sprod0_ss addsimps[inst_sprod_po,minimal])1)
   20.33 -        ]);
   20.34 +val prems = goal thy "Ispair UU UU << p";
   20.35 +by (simp_tac(Sprod0_ss addsimps[inst_sprod_po,minimal])1);
   20.36 +qed "minimal_sprod";
   20.37  
   20.38  bind_thm ("UU_sprod_def",minimal_sprod RS minimal2UU RS sym);
   20.39  
   20.40 -qed_goal "least_sprod" thy "? x::'a**'b.!y. x<<y"
   20.41 -(fn prems =>
   20.42 -        [
   20.43 -        (res_inst_tac [("x","Ispair UU UU")] exI 1),
   20.44 -        (rtac (minimal_sprod RS allI) 1)
   20.45 -        ]);
   20.46 +val prems = goal thy "? x::'a**'b.!y. x<<y";
   20.47 +by (res_inst_tac [("x","Ispair UU UU")] exI 1);
   20.48 +by (rtac (minimal_sprod RS allI) 1);
   20.49 +qed "least_sprod";
   20.50  
   20.51  (* ------------------------------------------------------------------------ *)
   20.52  (* Ispair is monotone in both arguments                                     *)
   20.53  (* ------------------------------------------------------------------------ *)
   20.54  
   20.55 -qed_goalw "monofun_Ispair1" Sprod2.thy [monofun] "monofun(Ispair)"
   20.56 -(fn prems =>
   20.57 -        [
   20.58 -        (strip_tac 1),
   20.59 -        (rtac (less_fun RS iffD2) 1),
   20.60 -        (strip_tac 1),
   20.61 -        (res_inst_tac [("Q","xa=UU")] (excluded_middle RS disjE) 1),
   20.62 -        (res_inst_tac [("Q","x=UU")] (excluded_middle RS disjE) 1),
   20.63 -        (ftac notUU_I 1),
   20.64 -        (atac 1),
   20.65 -        (REPEAT(asm_simp_tac(Sprod0_ss 
   20.66 -                addsimps[inst_sprod_po,refl_less,minimal]) 1))
   20.67 -        ]);
   20.68 +val prems = goalw Sprod2.thy [monofun]  "monofun(Ispair)";
   20.69 +by (strip_tac 1);
   20.70 +by (rtac (less_fun RS iffD2) 1);
   20.71 +by (strip_tac 1);
   20.72 +by (res_inst_tac [("Q","xa=UU")] (excluded_middle RS disjE) 1);
   20.73 +by (res_inst_tac [("Q","x=UU")] (excluded_middle RS disjE) 1);
   20.74 +by (ftac notUU_I 1);
   20.75 +by (atac 1);
   20.76 +by (REPEAT(asm_simp_tac(Sprod0_ss addsimps[inst_sprod_po,refl_less,minimal]) 1));
   20.77 +qed "monofun_Ispair1";
   20.78  
   20.79 -qed_goalw "monofun_Ispair2" Sprod2.thy [monofun] "monofun(Ispair(x))"
   20.80 -(fn prems =>
   20.81 -        [
   20.82 -        (strip_tac 1),
   20.83 -        (res_inst_tac [("Q","x=UU")] (excluded_middle RS disjE) 1),
   20.84 -        (res_inst_tac [("Q","xa=UU")] (excluded_middle RS disjE) 1),
   20.85 -        (ftac notUU_I 1),
   20.86 -        (atac 1),
   20.87 -        (REPEAT(asm_simp_tac(Sprod0_ss 
   20.88 -                addsimps[inst_sprod_po,refl_less,minimal]) 1))
   20.89 -        ]);
   20.90 -
   20.91 +val prems = goalw Sprod2.thy [monofun]  "monofun(Ispair(x))";
   20.92 +by (strip_tac 1);
   20.93 +by (res_inst_tac [("Q","x=UU")] (excluded_middle RS disjE) 1);
   20.94 +by (res_inst_tac [("Q","xa=UU")] (excluded_middle RS disjE) 1);
   20.95 +by (ftac notUU_I 1);
   20.96 +by (atac 1);
   20.97 +by (REPEAT(asm_simp_tac(Sprod0_ss addsimps[inst_sprod_po,refl_less,minimal]) 1));
   20.98 +qed "monofun_Ispair2";      
   20.99  
  20.100 -qed_goal "monofun_Ispair" Sprod2.thy 
  20.101 - "[|x1<<x2; y1<<y2|] ==> Ispair x1 y1 << Ispair x2 y2"
  20.102 -(fn prems =>
  20.103 -        [
  20.104 -        (cut_facts_tac prems 1),
  20.105 -        (rtac trans_less 1),
  20.106 -        (rtac (monofun_Ispair1 RS monofunE RS spec RS spec RS mp RS 
  20.107 -        (less_fun RS iffD1 RS spec)) 1),
  20.108 -        (rtac (monofun_Ispair2 RS monofunE RS spec RS spec RS mp) 2),
  20.109 -        (atac 1),
  20.110 -        (atac 1)
  20.111 -        ]);
  20.112 -
  20.113 +Goal "[|x1<<x2; y1<<y2|] ==> Ispair x1 y1 << Ispair x2 y2";
  20.114 +by (rtac trans_less 1);
  20.115 +by (rtac (monofun_Ispair1 RS monofunE RS spec RS spec RS mp RS 
  20.116 +        (less_fun RS iffD1 RS spec)) 1);
  20.117 +by (rtac (monofun_Ispair2 RS monofunE RS spec RS spec RS mp) 2);
  20.118 +by (atac 1);
  20.119 +by (atac 1);
  20.120 +qed "monofun_Ispair";
  20.121  
  20.122  (* ------------------------------------------------------------------------ *)
  20.123  (* Isfst and Issnd are monotone                                             *)
  20.124  (* ------------------------------------------------------------------------ *)
  20.125  
  20.126 -qed_goalw "monofun_Isfst" Sprod2.thy [monofun] "monofun(Isfst)"
  20.127 -(fn prems => [(simp_tac (HOL_ss addsimps [inst_sprod_po]) 1)]);
  20.128 +val prems = goalw Sprod2.thy [monofun]  "monofun(Isfst)";
  20.129 +by (simp_tac (HOL_ss addsimps [inst_sprod_po]) 1);
  20.130 +qed "monofun_Isfst";
  20.131  
  20.132 -qed_goalw "monofun_Issnd" Sprod2.thy [monofun] "monofun(Issnd)"
  20.133 -(fn prems => [(simp_tac (HOL_ss addsimps [inst_sprod_po]) 1)]);
  20.134 +val prems = goalw Sprod2.thy [monofun]  "monofun(Issnd)";
  20.135 +by (simp_tac (HOL_ss addsimps [inst_sprod_po]) 1);
  20.136 +qed "monofun_Issnd";
  20.137  
  20.138  (* ------------------------------------------------------------------------ *)
  20.139  (* the type 'a ** 'b is a cpo                                               *)
  20.140  (* ------------------------------------------------------------------------ *)
  20.141  
  20.142 -qed_goal "lub_sprod" Sprod2.thy 
  20.143 +val prems = goal Sprod2.thy 
  20.144  "[|chain(S)|] ==> range(S) <<| \
  20.145 -\ Ispair (lub(range(%i. Isfst(S i)))) (lub(range(%i. Issnd(S i))))"
  20.146 -(fn prems =>
  20.147 -        [
  20.148 -        (cut_facts_tac prems 1),
  20.149 -        (rtac (conjI RS is_lubI) 1),
  20.150 -        (rtac (allI RS ub_rangeI) 1),
  20.151 -        (res_inst_tac [("t","S(i)")] (surjective_pairing_Sprod RS ssubst) 1),
  20.152 -        (rtac monofun_Ispair 1),
  20.153 -        (rtac is_ub_thelub 1),
  20.154 -        (etac (monofun_Isfst RS ch2ch_monofun) 1),
  20.155 -        (rtac is_ub_thelub 1),
  20.156 -        (etac (monofun_Issnd RS ch2ch_monofun) 1),
  20.157 -        (strip_tac 1),
  20.158 -        (res_inst_tac [("t","u")] (surjective_pairing_Sprod RS ssubst) 1),
  20.159 -        (rtac monofun_Ispair 1),
  20.160 -        (rtac is_lub_thelub 1),
  20.161 -        (etac (monofun_Isfst RS ch2ch_monofun) 1),
  20.162 -        (etac (monofun_Isfst RS ub2ub_monofun) 1),
  20.163 -        (rtac is_lub_thelub 1),
  20.164 -        (etac (monofun_Issnd RS ch2ch_monofun) 1),
  20.165 -        (etac (monofun_Issnd RS ub2ub_monofun) 1)
  20.166 -        ]);
  20.167 +\ Ispair (lub(range(%i. Isfst(S i)))) (lub(range(%i. Issnd(S i))))";
  20.168 +by (cut_facts_tac prems 1);
  20.169 +by (rtac (conjI RS is_lubI) 1);
  20.170 +by (rtac (allI RS ub_rangeI) 1);
  20.171 +by (res_inst_tac [("t","S(i)")] (surjective_pairing_Sprod RS ssubst) 1);
  20.172 +by (rtac monofun_Ispair 1);
  20.173 +by (rtac is_ub_thelub 1);
  20.174 +by (etac (monofun_Isfst RS ch2ch_monofun) 1);
  20.175 +by (rtac is_ub_thelub 1);
  20.176 +by (etac (monofun_Issnd RS ch2ch_monofun) 1);
  20.177 +by (strip_tac 1);
  20.178 +by (res_inst_tac [("t","u")] (surjective_pairing_Sprod RS ssubst) 1);
  20.179 +by (rtac monofun_Ispair 1);
  20.180 +by (rtac is_lub_thelub 1);
  20.181 +by (etac (monofun_Isfst RS ch2ch_monofun) 1);
  20.182 +by (etac (monofun_Isfst RS ub2ub_monofun) 1);
  20.183 +by (rtac is_lub_thelub 1);
  20.184 +by (etac (monofun_Issnd RS ch2ch_monofun) 1);
  20.185 +by (etac (monofun_Issnd RS ub2ub_monofun) 1);
  20.186 +qed "lub_sprod";
  20.187  
  20.188  bind_thm ("thelub_sprod", lub_sprod RS thelubI);
  20.189  
  20.190  
  20.191 -qed_goal "cpo_sprod" Sprod2.thy 
  20.192 -        "chain(S::nat=>'a**'b)==>? x. range(S)<<| x"
  20.193 -(fn prems =>
  20.194 -        [
  20.195 -        (cut_facts_tac prems 1),
  20.196 -        (rtac exI 1),
  20.197 -        (etac lub_sprod 1)
  20.198 -        ]);
  20.199 -
  20.200 -
  20.201 -
  20.202 -
  20.203 -
  20.204 -
  20.205 -
  20.206 -
  20.207 +val prems = goal Sprod2.thy 
  20.208 +        "chain(S::nat=>'a**'b)==>? x. range(S)<<| x";
  20.209 +by (cut_facts_tac prems 1);
  20.210 +by (rtac exI 1);
  20.211 +by (etac lub_sprod 1);
  20.212 +qed "cpo_sprod";
    21.1 --- a/src/HOLCF/Sprod3.ML	Tue Jul 04 14:58:40 2000 +0200
    21.2 +++ b/src/HOLCF/Sprod3.ML	Tue Jul 04 15:58:11 2000 +0200
    21.3 @@ -1,581 +1,488 @@
    21.4 -(*  Title:      HOLCF/Sprod3.thy
    21.5 +(*  Title:      HOLCF/Sprod3
    21.6      ID:         $Id$
    21.7      Author:     Franz Regensburger
    21.8      Copyright   1993 Technische Universitaet Muenchen
    21.9  
   21.10 -Lemmas for Sprod.thy 
   21.11 +Class instance of  ** for class pcpo
   21.12  *)
   21.13  
   21.14 -open Sprod3;
   21.15 -
   21.16  (* for compatibility with old HOLCF-Version *)
   21.17 -qed_goal "inst_sprod_pcpo" thy "UU = Ispair UU UU"
   21.18 - (fn prems => 
   21.19 -        [
   21.20 -        (simp_tac (HOL_ss addsimps [UU_def,UU_sprod_def]) 1)
   21.21 -        ]);
   21.22 +val prems = goal thy "UU = Ispair UU UU";
   21.23 +by (simp_tac (HOL_ss addsimps [UU_def,UU_sprod_def]) 1);
   21.24 +qed "inst_sprod_pcpo";
   21.25 +
   21.26 +Addsimps [inst_sprod_pcpo RS sym];
   21.27 +
   21.28  (* ------------------------------------------------------------------------ *)
   21.29  (* continuity of Ispair, Isfst, Issnd                                       *)
   21.30  (* ------------------------------------------------------------------------ *)
   21.31  
   21.32 -qed_goal "sprod3_lemma1" thy 
   21.33 +val prems = goal thy 
   21.34  "[| chain(Y);  x~= UU;  lub(range(Y))~= UU |] ==>\
   21.35  \ Ispair (lub(range Y)) x =\
   21.36  \ Ispair (lub(range(%i. Isfst(Ispair(Y i) x)))) \
   21.37 -\        (lub(range(%i. Issnd(Ispair(Y i) x))))"
   21.38 - (fn prems =>
   21.39 -        [
   21.40 -        (cut_facts_tac prems 1),
   21.41 -        (res_inst_tac [("f1","Ispair")] (arg_cong RS cong) 1),
   21.42 -        (rtac lub_equal 1),
   21.43 -        (atac 1),
   21.44 -        (rtac (monofun_Isfst RS ch2ch_monofun) 1),
   21.45 -        (rtac ch2ch_fun 1),
   21.46 -        (rtac (monofun_Ispair1 RS ch2ch_monofun) 1),
   21.47 -        (atac 1),
   21.48 -        (rtac allI 1),
   21.49 -        (asm_simp_tac Sprod0_ss 1),
   21.50 -        (rtac sym 1),
   21.51 -        (rtac lub_chain_maxelem 1),
   21.52 -        (res_inst_tac [("P","%j.~Y(j)=UU")] exE 1),
   21.53 -        (rtac (not_all RS iffD1) 1),
   21.54 -        (res_inst_tac [("Q","lub(range(Y)) = UU")] contrapos 1),
   21.55 -        (atac 1),
   21.56 -        (rtac chain_UU_I_inverse 1),
   21.57 -        (atac 1),
   21.58 -        (rtac exI 1),
   21.59 -        (etac Issnd2 1),
   21.60 -        (rtac allI 1),
   21.61 -        (res_inst_tac [("Q","Y(i)=UU")] (excluded_middle RS disjE) 1),
   21.62 -        (asm_simp_tac Sprod0_ss 1),
   21.63 -        (rtac refl_less 1),
   21.64 -        (res_inst_tac [("s","UU"),("t","Y(i)")] subst 1),
   21.65 -        (etac sym 1),
   21.66 -        (asm_simp_tac Sprod0_ss  1),
   21.67 -        (rtac minimal 1)
   21.68 -        ]);
   21.69 +\        (lub(range(%i. Issnd(Ispair(Y i) x))))";
   21.70 +by (cut_facts_tac prems 1);
   21.71 +by (res_inst_tac [("f1","Ispair")] (arg_cong RS cong) 1);
   21.72 +by (rtac lub_equal 1);
   21.73 +by (atac 1);
   21.74 +by (rtac (monofun_Isfst RS ch2ch_monofun) 1);
   21.75 +by (rtac ch2ch_fun 1);
   21.76 +by (rtac (monofun_Ispair1 RS ch2ch_monofun) 1);
   21.77 +by (atac 1);
   21.78 +by (rtac allI 1);
   21.79 +by (asm_simp_tac Sprod0_ss 1);
   21.80 +by (rtac sym 1);
   21.81 +by (rtac lub_chain_maxelem 1);
   21.82 +by (res_inst_tac [("P","%j.~Y(j)=UU")] exE 1);
   21.83 +by (rtac (not_all RS iffD1) 1);
   21.84 +by (res_inst_tac [("Q","lub(range(Y)) = UU")] contrapos 1);
   21.85 +by (atac 1);
   21.86 +by (rtac chain_UU_I_inverse 1);
   21.87 +by (atac 1);
   21.88 +by (rtac exI 1);
   21.89 +by (etac Issnd2 1);
   21.90 +by (rtac allI 1);
   21.91 +by (res_inst_tac [("Q","Y(i)=UU")] (excluded_middle RS disjE) 1);
   21.92 +by (asm_simp_tac Sprod0_ss 1);
   21.93 +by (rtac refl_less 1);
   21.94 +by (res_inst_tac [("s","UU"),("t","Y(i)")] subst 1);
   21.95 +by (etac sym 1);
   21.96 +by (asm_simp_tac Sprod0_ss  1);
   21.97 +by (rtac minimal 1);
   21.98 +qed "sprod3_lemma1";
   21.99  
  21.100 -qed_goal "sprod3_lemma2" thy 
  21.101 +val prems = goal thy 
  21.102  "[| chain(Y); x ~= UU; lub(range(Y)) = UU |] ==>\
  21.103  \   Ispair (lub(range Y)) x =\
  21.104  \   Ispair (lub(range(%i. Isfst(Ispair(Y i) x))))\
  21.105 -\          (lub(range(%i. Issnd(Ispair(Y i) x))))"
  21.106 - (fn prems =>
  21.107 -        [
  21.108 -        (cut_facts_tac prems 1),
  21.109 -        (res_inst_tac [("s","UU"),("t","lub(range(Y))")] ssubst 1),
  21.110 -        (atac 1),
  21.111 -        (rtac trans 1),
  21.112 -        (rtac strict_Ispair1 1),
  21.113 -        (rtac (strict_Ispair RS sym) 1),
  21.114 -        (rtac disjI1 1),
  21.115 -        (rtac chain_UU_I_inverse 1),
  21.116 -        (rtac allI 1),
  21.117 -        (asm_simp_tac Sprod0_ss  1),
  21.118 -        (etac (chain_UU_I RS spec) 1),
  21.119 -        (atac 1)
  21.120 -        ]);
  21.121 +\          (lub(range(%i. Issnd(Ispair(Y i) x))))";
  21.122 +by (cut_facts_tac prems 1);
  21.123 +by (res_inst_tac [("s","UU"),("t","lub(range(Y))")] ssubst 1);
  21.124 +by (atac 1);
  21.125 +by (rtac trans 1);
  21.126 +by (rtac strict_Ispair1 1);
  21.127 +by (rtac (strict_Ispair RS sym) 1);
  21.128 +by (rtac disjI1 1);
  21.129 +by (rtac chain_UU_I_inverse 1);
  21.130 +by (rtac allI 1);
  21.131 +by (asm_simp_tac Sprod0_ss  1);
  21.132 +by (etac (chain_UU_I RS spec) 1);
  21.133 +by (atac 1);
  21.134 +qed "sprod3_lemma2";
  21.135  
  21.136  
  21.137 -qed_goal "sprod3_lemma3" thy 
  21.138 +val prems = goal thy 
  21.139  "[| chain(Y); x = UU |] ==>\
  21.140  \          Ispair (lub(range Y)) x =\
  21.141  \          Ispair (lub(range(%i. Isfst(Ispair (Y i) x))))\
  21.142 -\                 (lub(range(%i. Issnd(Ispair (Y i) x))))"
  21.143 - (fn prems =>
  21.144 -        [
  21.145 -        (cut_facts_tac prems 1),
  21.146 -        (res_inst_tac [("s","UU"),("t","x")] ssubst 1),
  21.147 -        (atac 1),
  21.148 -        (rtac trans 1),
  21.149 -        (rtac strict_Ispair2 1),
  21.150 -        (rtac (strict_Ispair RS sym) 1),
  21.151 -        (rtac disjI1 1),
  21.152 -        (rtac chain_UU_I_inverse 1),
  21.153 -        (rtac allI 1),
  21.154 -        (simp_tac Sprod0_ss  1)
  21.155 -        ]);
  21.156 -
  21.157 +\                 (lub(range(%i. Issnd(Ispair (Y i) x))))";
  21.158 +by (cut_facts_tac prems 1);
  21.159 +by (res_inst_tac [("s","UU"),("t","x")] ssubst 1);
  21.160 +by (atac 1);
  21.161 +by (rtac trans 1);
  21.162 +by (rtac strict_Ispair2 1);
  21.163 +by (rtac (strict_Ispair RS sym) 1);
  21.164 +by (rtac disjI1 1);
  21.165 +by (rtac chain_UU_I_inverse 1);
  21.166 +by (rtac allI 1);
  21.167 +by (simp_tac Sprod0_ss  1);
  21.168 +qed "sprod3_lemma3";
  21.169  
  21.170 -qed_goal "contlub_Ispair1" thy "contlub(Ispair)"
  21.171 -(fn prems =>
  21.172 -        [
  21.173 -        (rtac contlubI 1),
  21.174 -        (strip_tac 1),
  21.175 -        (rtac (expand_fun_eq RS iffD2) 1),
  21.176 -        (strip_tac 1),
  21.177 -        (stac (lub_fun RS thelubI) 1),
  21.178 -        (etac (monofun_Ispair1 RS ch2ch_monofun) 1),
  21.179 -        (rtac trans 1),
  21.180 -        (rtac (thelub_sprod RS sym) 2),
  21.181 -        (rtac ch2ch_fun 2),
  21.182 -        (etac (monofun_Ispair1 RS ch2ch_monofun) 2),
  21.183 -        (res_inst_tac [("Q","x=UU")] (excluded_middle RS disjE) 1),
  21.184 -        (res_inst_tac 
  21.185 -                [("Q","lub(range(Y))=UU")] (excluded_middle RS disjE) 1),
  21.186 -        (etac sprod3_lemma1 1),
  21.187 -        (atac 1),
  21.188 -        (atac 1),
  21.189 -        (etac sprod3_lemma2 1),
  21.190 -        (atac 1),
  21.191 -        (atac 1),
  21.192 -        (etac sprod3_lemma3 1),
  21.193 -        (atac 1)
  21.194 -        ]);
  21.195 +Goal "contlub(Ispair)";
  21.196 +by (rtac contlubI 1);
  21.197 +by (strip_tac 1);
  21.198 +by (rtac (expand_fun_eq RS iffD2) 1);
  21.199 +by (strip_tac 1);
  21.200 +by (stac (lub_fun RS thelubI) 1);
  21.201 +by (etac (monofun_Ispair1 RS ch2ch_monofun) 1);
  21.202 +by (rtac trans 1);
  21.203 +by (rtac (thelub_sprod RS sym) 2);
  21.204 +by (rtac ch2ch_fun 2);
  21.205 +by (etac (monofun_Ispair1 RS ch2ch_monofun) 2);
  21.206 +by (res_inst_tac [("Q","x=UU")] (excluded_middle RS disjE) 1);
  21.207 +by (res_inst_tac [("Q","lub(range(Y))=UU")] (excluded_middle RS disjE) 1);
  21.208 +by (etac sprod3_lemma1 1);
  21.209 +by (atac 1);
  21.210 +by (atac 1);
  21.211 +by (etac sprod3_lemma2 1);
  21.212 +by (atac 1);
  21.213 +by (atac 1);
  21.214 +by (etac sprod3_lemma3 1);
  21.215 +by (atac 1);
  21.216 +qed "contlub_Ispair1";
  21.217  
  21.218 -qed_goal "sprod3_lemma4" thy 
  21.219 +val prems = goal thy 
  21.220  "[| chain(Y); x ~= UU; lub(range(Y)) ~= UU |] ==>\
  21.221  \         Ispair x (lub(range Y)) =\
  21.222  \         Ispair (lub(range(%i. Isfst (Ispair x (Y i)))))\
  21.223 -\                (lub(range(%i. Issnd (Ispair x (Y i)))))"
  21.224 - (fn prems =>
  21.225 -        [
  21.226 -        (cut_facts_tac prems 1),
  21.227 -        (res_inst_tac [("f1","Ispair")] (arg_cong RS cong) 1),
  21.228 -        (rtac sym 1),
  21.229 -        (rtac lub_chain_maxelem 1),
  21.230 -        (res_inst_tac [("P","%j. Y(j)~=UU")] exE 1),
  21.231 -        (rtac (not_all RS iffD1) 1),
  21.232 -        (res_inst_tac [("Q","lub(range(Y)) = UU")] contrapos 1),
  21.233 -        (atac 1),
  21.234 -        (rtac chain_UU_I_inverse 1),
  21.235 -        (atac 1),
  21.236 -        (rtac exI 1),
  21.237 -        (etac Isfst2 1),
  21.238 -        (rtac allI 1),
  21.239 -        (res_inst_tac [("Q","Y(i)=UU")] (excluded_middle RS disjE) 1),
  21.240 -        (asm_simp_tac Sprod0_ss 1),
  21.241 -        (rtac refl_less 1),
  21.242 -        (res_inst_tac [("s","UU"),("t","Y(i)")] subst 1),
  21.243 -        (etac sym 1),
  21.244 -        (asm_simp_tac Sprod0_ss  1),
  21.245 -        (rtac minimal 1),
  21.246 -        (rtac lub_equal 1),
  21.247 -        (atac 1),
  21.248 -        (rtac (monofun_Issnd RS ch2ch_monofun) 1),
  21.249 -        (rtac (monofun_Ispair2 RS ch2ch_monofun) 1),
  21.250 -        (atac 1),
  21.251 -        (rtac allI 1),
  21.252 -        (asm_simp_tac Sprod0_ss 1)
  21.253 -        ]);
  21.254 +\                (lub(range(%i. Issnd (Ispair x (Y i)))))";
  21.255 +by (cut_facts_tac prems 1);
  21.256 +by (res_inst_tac [("f1","Ispair")] (arg_cong RS cong) 1);
  21.257 +by (rtac sym 1);
  21.258 +by (rtac lub_chain_maxelem 1);
  21.259 +by (res_inst_tac [("P","%j. Y(j)~=UU")] exE 1);
  21.260 +by (rtac (not_all RS iffD1) 1);
  21.261 +by (res_inst_tac [("Q","lub(range(Y)) = UU")] contrapos 1);
  21.262 +by (atac 1);
  21.263 +by (rtac chain_UU_I_inverse 1);
  21.264 +by (atac 1);
  21.265 +by (rtac exI 1);
  21.266 +by (etac Isfst2 1);
  21.267 +by (rtac allI 1);
  21.268 +by (res_inst_tac [("Q","Y(i)=UU")] (excluded_middle RS disjE) 1);
  21.269 +by (asm_simp_tac Sprod0_ss 1);
  21.270 +by (rtac refl_less 1);
  21.271 +by (res_inst_tac [("s","UU"),("t","Y(i)")] subst 1);
  21.272 +by (etac sym 1);
  21.273 +by (asm_simp_tac Sprod0_ss  1);
  21.274 +by (rtac minimal 1);
  21.275 +by (rtac lub_equal 1);
  21.276 +by (atac 1);
  21.277 +by (rtac (monofun_Issnd RS ch2ch_monofun) 1);
  21.278 +by (rtac (monofun_Ispair2 RS ch2ch_monofun) 1);
  21.279 +by (atac 1);
  21.280 +by (rtac allI 1);
  21.281 +by (asm_simp_tac Sprod0_ss 1);
  21.282 +qed "sprod3_lemma4";
  21.283  
  21.284 -qed_goal "sprod3_lemma5" thy 
  21.285 +val prems = goal thy 
  21.286  "[| chain(Y); x ~= UU; lub(range(Y)) = UU |] ==>\
  21.287  \         Ispair x (lub(range Y)) =\
  21.288  \         Ispair (lub(range(%i. Isfst(Ispair x (Y i)))))\
  21.289 -\                (lub(range(%i. Issnd(Ispair x (Y i)))))"
  21.290 - (fn prems =>
  21.291 -        [
  21.292 -        (cut_facts_tac prems 1),
  21.293 -        (res_inst_tac [("s","UU"),("t","lub(range(Y))")] ssubst 1),
  21.294 -        (atac 1),
  21.295 -        (rtac trans 1),
  21.296 -        (rtac strict_Ispair2 1),
  21.297 -        (rtac (strict_Ispair RS sym) 1),
  21.298 -        (rtac disjI2 1),
  21.299 -        (rtac chain_UU_I_inverse 1),
  21.300 -        (rtac allI 1),
  21.301 -        (asm_simp_tac Sprod0_ss  1),
  21.302 -        (etac (chain_UU_I RS spec) 1),
  21.303 -        (atac 1)
  21.304 -        ]);
  21.305 +\                (lub(range(%i. Issnd(Ispair x (Y i)))))";
  21.306 +by (cut_facts_tac prems 1);
  21.307 +by (res_inst_tac [("s","UU"),("t","lub(range(Y))")] ssubst 1);
  21.308 +by (atac 1);
  21.309 +by (rtac trans 1);
  21.310 +by (rtac strict_Ispair2 1);
  21.311 +by (rtac (strict_Ispair RS sym) 1);
  21.312 +by (rtac disjI2 1);
  21.313 +by (rtac chain_UU_I_inverse 1);
  21.314 +by (rtac allI 1);
  21.315 +by (asm_simp_tac Sprod0_ss  1);
  21.316 +by (etac (chain_UU_I RS spec) 1);
  21.317 +by (atac 1);
  21.318 +qed "sprod3_lemma5";
  21.319  
  21.320 -qed_goal "sprod3_lemma6" thy 
  21.321 +val prems = goal thy 
  21.322  "[| chain(Y); x = UU |] ==>\
  21.323  \         Ispair x (lub(range Y)) =\
  21.324  \         Ispair (lub(range(%i. Isfst (Ispair x (Y i)))))\
  21.325 -\                (lub(range(%i. Issnd (Ispair x (Y i)))))"
  21.326 -(fn prems =>
  21.327 -        [
  21.328 -        (cut_facts_tac prems 1),
  21.329 -        (res_inst_tac [("s","UU"),("t","x")] ssubst 1),
  21.330 -        (atac 1),
  21.331 -        (rtac trans 1),
  21.332 -        (rtac strict_Ispair1 1),
  21.333 -        (rtac (strict_Ispair RS sym) 1),
  21.334 -        (rtac disjI1 1),
  21.335 -        (rtac chain_UU_I_inverse 1),
  21.336 -        (rtac allI 1),
  21.337 -        (simp_tac Sprod0_ss  1)
  21.338 -        ]);
  21.339 +\                (lub(range(%i. Issnd (Ispair x (Y i)))))";
  21.340 +by (cut_facts_tac prems 1);
  21.341 +by (res_inst_tac [("s","UU"),("t","x")] ssubst 1);
  21.342 +by (atac 1);
  21.343 +by (rtac trans 1);
  21.344 +by (rtac strict_Ispair1 1);
  21.345 +by (rtac (strict_Ispair RS sym) 1);
  21.346 +by (rtac disjI1 1);
  21.347 +by (rtac chain_UU_I_inverse 1);
  21.348 +by (rtac allI 1);
  21.349 +by (simp_tac Sprod0_ss  1);
  21.350 +qed "sprod3_lemma6";
  21.351  
  21.352 -qed_goal "contlub_Ispair2" thy "contlub(Ispair(x))"
  21.353 -(fn prems =>
  21.354 -        [
  21.355 -        (rtac contlubI 1),
  21.356 -        (strip_tac 1),
  21.357 -        (rtac trans 1),
  21.358 -        (rtac (thelub_sprod RS sym) 2),
  21.359 -        (etac (monofun_Ispair2 RS ch2ch_monofun) 2),
  21.360 -        (res_inst_tac [("Q","x=UU")] (excluded_middle RS disjE) 1),
  21.361 -        (res_inst_tac [("Q","lub(range(Y))=UU")] 
  21.362 -                (excluded_middle RS disjE) 1),
  21.363 -        (etac sprod3_lemma4 1),
  21.364 -        (atac 1),
  21.365 -        (atac 1),
  21.366 -        (etac sprod3_lemma5 1),
  21.367 -        (atac 1),
  21.368 -        (atac 1),
  21.369 -        (etac sprod3_lemma6 1),
  21.370 -        (atac 1)
  21.371 -        ]);
  21.372 +val prems = goal thy "contlub(Ispair(x))";
  21.373 +by (rtac contlubI 1);
  21.374 +by (strip_tac 1);
  21.375 +by (rtac trans 1);
  21.376 +by (rtac (thelub_sprod RS sym) 2);
  21.377 +by (etac (monofun_Ispair2 RS ch2ch_monofun) 2);
  21.378 +by (res_inst_tac [("Q","x=UU")] (excluded_middle RS disjE) 1);
  21.379 +by (res_inst_tac [("Q","lub(range(Y))=UU")] (excluded_middle RS disjE) 1);
  21.380 +by (etac sprod3_lemma4 1);
  21.381 +by (atac 1);
  21.382 +by (atac 1);
  21.383 +by (etac sprod3_lemma5 1);
  21.384 +by (atac 1);
  21.385 +by (atac 1);
  21.386 +by (etac sprod3_lemma6 1);
  21.387 +by (atac 1);
  21.388 +qed "contlub_Ispair2";
  21.389  
  21.390 -
  21.391 -qed_goal "cont_Ispair1" thy "cont(Ispair)"
  21.392 -(fn prems =>
  21.393 -        [
  21.394 -        (rtac monocontlub2cont 1),
  21.395 -        (rtac monofun_Ispair1 1),
  21.396 -        (rtac contlub_Ispair1 1)
  21.397 -        ]);
  21.398 +val prems = goal thy "cont(Ispair)";
  21.399 +by (rtac monocontlub2cont 1);
  21.400 +by (rtac monofun_Ispair1 1);
  21.401 +by (rtac contlub_Ispair1 1);
  21.402 +qed "cont_Ispair1";
  21.403  
  21.404  
  21.405 -qed_goal "cont_Ispair2" thy "cont(Ispair(x))"
  21.406 -(fn prems =>
  21.407 -        [
  21.408 -        (rtac monocontlub2cont 1),
  21.409 -        (rtac monofun_Ispair2 1),
  21.410 -        (rtac contlub_Ispair2 1)
  21.411 -        ]);
  21.412 +val prems = goal thy "cont(Ispair(x))";
  21.413 +by (rtac monocontlub2cont 1);
  21.414 +by (rtac monofun_Ispair2 1);
  21.415 +by (rtac contlub_Ispair2 1);
  21.416 +qed "cont_Ispair2";
  21.417  
  21.418 -qed_goal "contlub_Isfst" thy "contlub(Isfst)"
  21.419 - (fn prems =>
  21.420 -        [
  21.421 -        (rtac contlubI 1),
  21.422 -        (strip_tac 1),
  21.423 -        (stac (lub_sprod RS thelubI) 1),
  21.424 -        (atac 1),
  21.425 -        (res_inst_tac [("Q","lub(range(%i. Issnd(Y(i))))=UU")]  
  21.426 -                (excluded_middle RS disjE) 1),
  21.427 -        (asm_simp_tac Sprod0_ss  1),
  21.428 -        (res_inst_tac [("s","UU"),("t","lub(range(%i. Issnd(Y(i))))")]
  21.429 -                ssubst 1),
  21.430 -        (atac 1),
  21.431 -        (rtac trans 1),
  21.432 -        (asm_simp_tac Sprod0_ss  1),
  21.433 -        (rtac sym 1),
  21.434 -        (rtac chain_UU_I_inverse 1),
  21.435 -        (rtac allI 1),
  21.436 -        (rtac strict_Isfst 1),
  21.437 -        (rtac swap 1),
  21.438 -        (etac (defined_IsfstIssnd RS conjunct2) 2),
  21.439 -        (fast_tac (HOL_cs addSDs [monofun_Issnd RS ch2ch_monofun RS 
  21.440 -                                  chain_UU_I RS spec]) 1)
  21.441 -        ]);
  21.442 +val prems = goal thy "contlub(Isfst)";
  21.443 +by (rtac contlubI 1);
  21.444 +by (strip_tac 1);
  21.445 +by (stac (lub_sprod RS thelubI) 1);
  21.446 +by (atac 1);
  21.447 +by (res_inst_tac [("Q","lub(range(%i. Issnd(Y(i))))=UU")] (excluded_middle RS disjE) 1);
  21.448 +by (asm_simp_tac Sprod0_ss  1);
  21.449 +by (res_inst_tac [("s","UU"),("t","lub(range(%i. Issnd(Y(i))))")] ssubst 1);
  21.450 +by (atac 1);
  21.451 +by (rtac trans 1);
  21.452 +by (asm_simp_tac Sprod0_ss  1);
  21.453 +by (rtac sym 1);
  21.454 +by (rtac chain_UU_I_inverse 1);
  21.455 +by (rtac allI 1);
  21.456 +by (rtac strict_Isfst 1);
  21.457 +by (rtac swap 1);
  21.458 +by (etac (defined_IsfstIssnd RS conjunct2) 2);
  21.459 +by (fast_tac (HOL_cs addSDs [monofun_Issnd RS ch2ch_monofun RS chain_UU_I RS spec]) 1);
  21.460 +qed "contlub_Isfst";
  21.461  
  21.462 -qed_goal "contlub_Issnd" thy "contlub(Issnd)"
  21.463 -(fn prems =>
  21.464 -        [
  21.465 -        (rtac contlubI 1),
  21.466 -        (strip_tac 1),
  21.467 -        (stac (lub_sprod RS thelubI) 1),
  21.468 -        (atac 1),
  21.469 -        (res_inst_tac [("Q","lub(range(%i. Isfst(Y(i))))=UU")]
  21.470 -         (excluded_middle RS disjE) 1),
  21.471 -        (asm_simp_tac Sprod0_ss  1),
  21.472 -        (res_inst_tac [("s","UU"),("t","lub(range(%i. Isfst(Y(i))))")] 
  21.473 -                ssubst 1),
  21.474 -        (atac 1),
  21.475 -        (asm_simp_tac Sprod0_ss  1),
  21.476 -        (rtac sym 1),
  21.477 -        (rtac chain_UU_I_inverse 1),
  21.478 -        (rtac allI 1),
  21.479 -        (rtac strict_Issnd 1),
  21.480 -        (rtac swap 1),
  21.481 -        (etac (defined_IsfstIssnd RS conjunct1) 2),
  21.482 -        (fast_tac (HOL_cs addSDs [monofun_Isfst RS ch2ch_monofun RS
  21.483 -                                  chain_UU_I RS spec]) 1)
  21.484 -        ]);
  21.485 +val prems = goal thy "contlub(Issnd)";
  21.486 +by (rtac contlubI 1);
  21.487 +by (strip_tac 1);
  21.488 +by (stac (lub_sprod RS thelubI) 1);
  21.489 +by (atac 1);
  21.490 +by (res_inst_tac [("Q","lub(range(%i. Isfst(Y(i))))=UU")] (excluded_middle RS disjE) 1);
  21.491 +by (asm_simp_tac Sprod0_ss  1);
  21.492 +by (res_inst_tac [("s","UU"),("t","lub(range(%i. Isfst(Y(i))))")] ssubst 1);
  21.493 +by (atac 1);
  21.494 +by (asm_simp_tac Sprod0_ss  1);
  21.495 +by (rtac sym 1);
  21.496 +by (rtac chain_UU_I_inverse 1);
  21.497 +by (rtac allI 1);
  21.498 +by (rtac strict_Issnd 1);
  21.499 +by (rtac swap 1);
  21.500 +by (etac (defined_IsfstIssnd RS conjunct1) 2);
  21.501 +by (fast_tac (HOL_cs addSDs [monofun_Isfst RS ch2ch_monofun RS chain_UU_I RS spec]) 1);
  21.502 +qed "contlub_Issnd";
  21.503  
  21.504 -qed_goal "cont_Isfst" thy "cont(Isfst)"
  21.505 -(fn prems =>
  21.506 -        [
  21.507 -        (rtac monocontlub2cont 1),
  21.508 -        (rtac monofun_Isfst 1),
  21.509 -        (rtac contlub_Isfst 1)
  21.510 -        ]);
  21.511 +val prems = goal thy "cont(Isfst)";
  21.512 +by (rtac monocontlub2cont 1);
  21.513 +by (rtac monofun_Isfst 1);
  21.514 +by (rtac contlub_Isfst 1);
  21.515 +qed "cont_Isfst";
  21.516  
  21.517 -qed_goal "cont_Issnd" thy "cont(Issnd)"
  21.518 -(fn prems =>
  21.519 -        [
  21.520 -        (rtac monocontlub2cont 1),
  21.521 -        (rtac monofun_Issnd 1),
  21.522 -        (rtac contlub_Issnd 1)
  21.523 -        ]);
  21.524 +val prems = goal thy "cont(Issnd)";
  21.525 +by (rtac monocontlub2cont 1);
  21.526 +by (rtac monofun_Issnd 1);
  21.527 +by (rtac contlub_Issnd 1);
  21.528 +qed "cont_Issnd";
  21.529  
  21.530 -qed_goal "spair_eq" thy "[|x1=x2;y1=y2|] ==> (:x1,y1:) = (:x2,y2:)"
  21.531 - (fn prems =>
  21.532 -        [
  21.533 -        (cut_facts_tac prems 1),
  21.534 -        (fast_tac HOL_cs 1)
  21.535 -        ]);
  21.536 +val prems = goal thy "[|x1=x2;y1=y2|] ==> (:x1,y1:) = (:x2,y2:)";
  21.537 +by (cut_facts_tac prems 1);
  21.538 +by (fast_tac HOL_cs 1);
  21.539 +qed "spair_eq";
  21.540  
  21.541  (* ------------------------------------------------------------------------ *)
  21.542  (* convert all lemmas to the continuous versions                            *)
  21.543  (* ------------------------------------------------------------------------ *)
  21.544  
  21.545 -qed_goalw "beta_cfun_sprod" thy [spair_def]
  21.546 -        "(LAM x y. Ispair x y)`a`b = Ispair a b"
  21.547 - (fn prems =>
  21.548 -        [
  21.549 -        (stac beta_cfun 1),
  21.550 -        (simp_tac (simpset() addsimps [cont_Ispair2, cont_Ispair1,
  21.551 -					cont2cont_CF1L]) 1),
  21.552 -        (stac beta_cfun 1),
  21.553 -        (rtac cont_Ispair2 1),
  21.554 -        (rtac refl 1)
  21.555 -        ]);
  21.556 +val prems = goalw thy [spair_def]
  21.557 +        "(LAM x y. Ispair x y)`a`b = Ispair a b";
  21.558 +by (stac beta_cfun 1);
  21.559 +by (simp_tac (simpset() addsimps [cont_Ispair2, cont_Ispair1, cont2cont_CF1L]) 1);
  21.560 +by (stac beta_cfun 1);
  21.561 +by (rtac cont_Ispair2 1);
  21.562 +by (rtac refl 1);
  21.563 +qed "beta_cfun_sprod";
  21.564  
  21.565 -qed_goalw "inject_spair" thy [spair_def]
  21.566 -        "[| aa~=UU ; ba~=UU ; (:a,b:)=(:aa,ba:) |] ==> a=aa & b=ba"
  21.567 - (fn prems =>
  21.568 -        [
  21.569 -        (cut_facts_tac prems 1),
  21.570 -        (etac inject_Ispair 1),
  21.571 -        (atac 1),
  21.572 -        (etac box_equals 1),
  21.573 -        (rtac beta_cfun_sprod 1),
  21.574 -        (rtac beta_cfun_sprod 1)
  21.575 -        ]);
  21.576 +Addsimps [beta_cfun_sprod];
  21.577  
  21.578 -qed_goalw "inst_sprod_pcpo2" thy [spair_def] "UU = (:UU,UU:)"
  21.579 - (fn prems =>
  21.580 -        [
  21.581 -        (rtac sym 1),
  21.582 -        (rtac trans 1),
  21.583 -        (rtac beta_cfun_sprod 1),
  21.584 -        (rtac sym 1),
  21.585 -        (rtac inst_sprod_pcpo 1)
  21.586 -        ]);
  21.587 +val prems = goalw thy [spair_def]
  21.588 +        "[| aa~=UU ; ba~=UU ; (:a,b:)=(:aa,ba:) |] ==> a=aa & b=ba";
  21.589 +by (cut_facts_tac prems 1);
  21.590 +by (etac inject_Ispair 1);
  21.591 +by (atac 1);
  21.592 +by (etac box_equals 1);
  21.593 +by (rtac beta_cfun_sprod 1);
  21.594 +by (rtac beta_cfun_sprod 1);
  21.595 +qed "inject_spair";
  21.596  
  21.597 -qed_goalw "strict_spair" thy [spair_def] 
  21.598 -        "(a=UU | b=UU) ==> (:a,b:)=UU"
  21.599 - (fn prems =>
  21.600 -        [
  21.601 -        (cut_facts_tac prems 1),
  21.602 -        (rtac trans 1),
  21.603 -        (rtac beta_cfun_sprod 1),
  21.604 -        (rtac trans 1),
  21.605 -        (rtac (inst_sprod_pcpo RS sym) 2),
  21.606 -        (etac strict_Ispair 1)
  21.607 -        ]);
  21.608 +val prems = goalw thy [spair_def] "UU = (:UU,UU:)";
  21.609 +by (rtac sym 1);
  21.610 +by (rtac trans 1);
  21.611 +by (rtac beta_cfun_sprod 1);
  21.612 +by (rtac sym 1);
  21.613 +by (rtac inst_sprod_pcpo 1);
  21.614 +qed "inst_sprod_pcpo2";
  21.615  
  21.616 -qed_goalw "strict_spair1" thy [spair_def] "(:UU,b:) = UU"
  21.617 - (fn prems =>
  21.618 -        [
  21.619 -        (stac beta_cfun_sprod 1),
  21.620 -        (rtac trans 1),
  21.621 -        (rtac (inst_sprod_pcpo RS sym) 2),
  21.622 -        (rtac strict_Ispair1 1)
  21.623 -        ]);
  21.624 +val prems = goalw thy [spair_def] 
  21.625 +        "(a=UU | b=UU) ==> (:a,b:)=UU";
  21.626 +by (cut_facts_tac prems 1);
  21.627 +by (rtac trans 1);
  21.628 +by (rtac beta_cfun_sprod 1);
  21.629 +by (rtac trans 1);
  21.630 +by (rtac (inst_sprod_pcpo RS sym) 2);
  21.631 +by (etac strict_Ispair 1);
  21.632 +qed "strict_spair";
  21.633  
  21.634 -qed_goalw "strict_spair2" thy [spair_def] "(:a,UU:) = UU"
  21.635 - (fn prems =>
  21.636 -        [
  21.637 -        (stac beta_cfun_sprod 1),
  21.638 -        (rtac trans 1),
  21.639 -        (rtac (inst_sprod_pcpo RS sym) 2),
  21.640 -        (rtac strict_Ispair2 1)
  21.641 -        ]);
  21.642 +val prems = goalw thy [spair_def] "(:UU,b:) = UU";
  21.643 +by (stac beta_cfun_sprod 1);
  21.644 +by (rtac trans 1);
  21.645 +by (rtac (inst_sprod_pcpo RS sym) 2);
  21.646 +by (rtac strict_Ispair1 1);
  21.647 +qed "strict_spair1";
  21.648  
  21.649 -qed_goalw "strict_spair_rev" thy [spair_def]
  21.650 -        "(:x,y:)~=UU ==> ~x=UU & ~y=UU"
  21.651 - (fn prems =>
  21.652 -        [
  21.653 -        (cut_facts_tac prems 1),
  21.654 -        (rtac strict_Ispair_rev 1),
  21.655 -        (rtac (beta_cfun_sprod RS subst) 1),
  21.656 -        (rtac (inst_sprod_pcpo RS subst) 1),
  21.657 -        (atac 1)
  21.658 -        ]);
  21.659 +val prems = goalw thy [spair_def] "(:a,UU:) = UU";
  21.660 +by (stac beta_cfun_sprod 1);
  21.661 +by (rtac trans 1);
  21.662 +by (rtac (inst_sprod_pcpo RS sym) 2);
  21.663 +by (rtac strict_Ispair2 1);
  21.664 +qed "strict_spair2";
  21.665 +
  21.666 +Addsimps [strict_spair1,strict_spair2];
  21.667 +
  21.668 +Goalw [spair_def] "(:x,y:)~=UU ==> ~x=UU & ~y=UU";
  21.669 +by (rtac strict_Ispair_rev 1);
  21.670 +by Auto_tac;  
  21.671 +qed "strict_spair_rev";
  21.672 +
  21.673 +Goalw [spair_def] "(:a,b:) = UU ==> (a = UU | b = UU)";
  21.674 +by (rtac defined_Ispair_rev 1);
  21.675 +by Auto_tac;  
  21.676 +qed "defined_spair_rev";
  21.677  
  21.678 -qed_goalw "defined_spair_rev" thy [spair_def]
  21.679 - "(:a,b:) = UU ==> (a = UU | b = UU)"
  21.680 - (fn prems =>
  21.681 -        [
  21.682 -        (cut_facts_tac prems 1),
  21.683 -        (rtac defined_Ispair_rev 1),
  21.684 -        (rtac (beta_cfun_sprod RS subst) 1),
  21.685 -        (rtac (inst_sprod_pcpo RS subst) 1),
  21.686 -        (atac 1)
  21.687 -        ]);
  21.688 +val prems = goalw thy [spair_def]
  21.689 +        "[|a~=UU; b~=UU|] ==> (:a,b:) ~= UU";
  21.690 +by (cut_facts_tac prems 1);
  21.691 +by (stac beta_cfun_sprod 1);
  21.692 +by (stac inst_sprod_pcpo 1);
  21.693 +by (etac defined_Ispair 1);
  21.694 +by (atac 1);
  21.695 +qed "defined_spair";
  21.696  
  21.697 -qed_goalw "defined_spair" thy [spair_def]
  21.698 -        "[|a~=UU; b~=UU|] ==> (:a,b:) ~= UU"
  21.699 - (fn prems =>
  21.700 -        [
  21.701 -        (cut_facts_tac prems 1),
  21.702 -        (stac beta_cfun_sprod 1),
  21.703 -        (stac inst_sprod_pcpo 1),
  21.704 -        (etac defined_Ispair 1),
  21.705 -        (atac 1)
  21.706 -        ]);
  21.707 -
  21.708 -qed_goalw "Exh_Sprod2" thy [spair_def]
  21.709 -        "z=UU | (? a b. z=(:a,b:) & a~=UU & b~=UU)"
  21.710 - (fn prems =>
  21.711 -        [
  21.712 -        (rtac (Exh_Sprod RS disjE) 1),
  21.713 -        (rtac disjI1 1),
  21.714 -        (stac inst_sprod_pcpo 1),
  21.715 -        (atac 1),
  21.716 -        (rtac disjI2 1),
  21.717 -        (etac exE 1),
  21.718 -        (etac exE 1),
  21.719 -        (rtac exI 1),
  21.720 -        (rtac exI 1),
  21.721 -        (rtac conjI 1),
  21.722 -        (stac beta_cfun_sprod 1),
  21.723 -        (fast_tac HOL_cs 1),
  21.724 -        (fast_tac HOL_cs 1)
  21.725 -        ]);
  21.726 +val prems = goalw thy [spair_def]
  21.727 +        "z=UU | (? a b. z=(:a,b:) & a~=UU & b~=UU)";
  21.728 +by (rtac (Exh_Sprod RS disjE) 1);
  21.729 +by (rtac disjI1 1);
  21.730 +by (stac inst_sprod_pcpo 1);
  21.731 +by (atac 1);
  21.732 +by (rtac disjI2 1);
  21.733 +by (etac exE 1);
  21.734 +by (etac exE 1);
  21.735 +by (rtac exI 1);
  21.736 +by (rtac exI 1);
  21.737 +by (rtac conjI 1);
  21.738 +by (stac beta_cfun_sprod 1);
  21.739 +by (fast_tac HOL_cs 1);
  21.740 +by (fast_tac HOL_cs 1);
  21.741 +qed "Exh_Sprod2";
  21.742  
  21.743  
  21.744 -qed_goalw "sprodE" thy [spair_def]
  21.745 -"[|p=UU ==> Q;!!x y. [|p=(:x,y:);x~=UU ; y~=UU|] ==> Q|] ==> Q"
  21.746 -(fn prems =>
  21.747 -        [
  21.748 -        (rtac IsprodE 1),
  21.749 -        (resolve_tac prems 1),
  21.750 -        (stac inst_sprod_pcpo 1),
  21.751 -        (atac 1),
  21.752 -        (resolve_tac prems 1),
  21.753 -        (atac 2),
  21.754 -        (atac 2),
  21.755 -        (stac beta_cfun_sprod 1),
  21.756 -        (atac 1)
  21.757 -        ]);
  21.758 +val [prem1,prem2] = Goalw [spair_def]
  21.759 +   "[|p=UU ==> Q;  !!x y. [| p=(:x,y:); x~=UU; y~=UU|] ==> Q|] ==> Q";
  21.760 +by (rtac IsprodE 1);
  21.761 +by (rtac prem1 1);
  21.762 +by (stac inst_sprod_pcpo 1);
  21.763 +by (atac 1);
  21.764 +by (rtac prem2 1);
  21.765 +by (atac 2);
  21.766 +by (atac 2);
  21.767 +by (stac beta_cfun_sprod 1);
  21.768 +by (atac 1);
  21.769 +qed "sprodE";
  21.770  
  21.771  
  21.772 -qed_goalw "strict_sfst" thy [sfst_def] 
  21.773 -        "p=UU==>sfst`p=UU"
  21.774 - (fn prems =>
  21.775 -        [
  21.776 -        (cut_facts_tac prems 1),
  21.777 -        (stac beta_cfun 1),
  21.778 -        (rtac cont_Isfst 1),
  21.779 -        (rtac strict_Isfst 1),
  21.780 -        (rtac (inst_sprod_pcpo RS subst) 1),
  21.781 -        (atac 1)
  21.782 -        ]);
  21.783 +val prems = goalw thy [sfst_def] 
  21.784 +        "p=UU==>sfst`p=UU";
  21.785 +by (cut_facts_tac prems 1);
  21.786 +by (stac beta_cfun 1);
  21.787 +by (rtac cont_Isfst 1);
  21.788 +by (rtac strict_Isfst 1);
  21.789 +by (rtac (inst_sprod_pcpo RS subst) 1);
  21.790 +by (atac 1);
  21.791 +qed "strict_sfst";
  21.792  
  21.793 -qed_goalw "strict_sfst1" thy [sfst_def,spair_def] 
  21.794 -        "sfst`(:UU,y:) = UU"
  21.795 - (fn prems =>
  21.796 -        [
  21.797 -        (stac beta_cfun_sprod 1),
  21.798 -        (stac beta_cfun 1),
  21.799 -        (rtac cont_Isfst 1),
  21.800 -        (rtac strict_Isfst1 1)
  21.801 -        ]);
  21.802 +val prems = goalw thy [sfst_def,spair_def] 
  21.803 +        "sfst`(:UU,y:) = UU";
  21.804 +by (stac beta_cfun_sprod 1);
  21.805 +by (stac beta_cfun 1);
  21.806 +by (rtac cont_Isfst 1);
  21.807 +by (rtac strict_Isfst1 1);
  21.808 +qed "strict_sfst1";
  21.809   
  21.810 -qed_goalw "strict_sfst2" thy [sfst_def,spair_def] 
  21.811 -        "sfst`(:x,UU:) = UU"
  21.812 - (fn prems =>
  21.813 -        [
  21.814 -        (stac beta_cfun_sprod 1),
  21.815 -        (stac beta_cfun 1),
  21.816 -        (rtac cont_Isfst 1),
  21.817 -        (rtac strict_Isfst2 1)
  21.818 -        ]);
  21.819 +val prems = goalw thy [sfst_def,spair_def] 
  21.820 +        "sfst`(:x,UU:) = UU";
  21.821 +by (stac beta_cfun_sprod 1);
  21.822 +by (stac beta_cfun 1);
  21.823 +by (rtac cont_Isfst 1);
  21.824 +by (rtac strict_Isfst2 1);
  21.825 +qed "strict_sfst2";
  21.826  
  21.827 -qed_goalw "strict_ssnd" thy [ssnd_def] 
  21.828 -        "p=UU==>ssnd`p=UU"
  21.829 - (fn prems =>
  21.830 -        [
  21.831 -        (cut_facts_tac prems 1),
  21.832 -        (stac beta_cfun 1),
  21.833 -        (rtac cont_Issnd 1),
  21.834 -        (rtac strict_Issnd 1),
  21.835 -        (rtac (inst_sprod_pcpo RS subst) 1),
  21.836 -        (atac 1)
  21.837 -        ]);
  21.838 +val prems = goalw thy [ssnd_def] 
  21.839 +        "p=UU==>ssnd`p=UU";
  21.840 +by (cut_facts_tac prems 1);
  21.841 +by (stac beta_cfun 1);
  21.842 +by (rtac cont_Issnd 1);
  21.843 +by (rtac strict_Issnd 1);
  21.844 +by (rtac (inst_sprod_pcpo RS subst) 1);
  21.845 +by (atac 1);
  21.846 +qed "strict_ssnd";
  21.847  
  21.848 -qed_goalw "strict_ssnd1" thy [ssnd_def,spair_def] 
  21.849 -        "ssnd`(:UU,y:) = UU"
  21.850 - (fn prems =>
  21.851 -        [
  21.852 -        (stac beta_cfun_sprod 1),
  21.853 -        (stac beta_cfun 1),
  21.854 -        (rtac cont_Issnd 1),
  21.855 -        (rtac strict_Issnd1 1)
  21.856 -        ]);
  21.857 +val prems = goalw thy [ssnd_def,spair_def] 
  21.858 +        "ssnd`(:UU,y:) = UU";
  21.859 +by (stac beta_cfun_sprod 1);
  21.860 +by (stac beta_cfun 1);
  21.861 +by (rtac cont_Issnd 1);
  21.862 +by (rtac strict_Issnd1 1);
  21.863 +qed "strict_ssnd1";
  21.864  
  21.865 -qed_goalw "strict_ssnd2" thy [ssnd_def,spair_def] 
  21.866 -        "ssnd`(:x,UU:) = UU"
  21.867 - (fn prems =>
  21.868 -        [
  21.869 -        (stac beta_cfun_sprod 1),
  21.870 -        (stac beta_cfun 1),
  21.871 -        (rtac cont_Issnd 1),
  21.872 -        (rtac strict_Issnd2 1)
  21.873 -        ]);
  21.874 +val prems = goalw thy [ssnd_def,spair_def] 
  21.875 +        "ssnd`(:x,UU:) = UU";
  21.876 +by (stac beta_cfun_sprod 1);
  21.877 +by (stac beta_cfun 1);
  21.878 +by (rtac cont_Issnd 1);
  21.879 +by (rtac strict_Issnd2 1);
  21.880 +qed "strict_ssnd2";
  21.881  
  21.882 -qed_goalw "sfst2" thy [sfst_def,spair_def] 
  21.883 -        "y~=UU ==>sfst`(:x,y:)=x"
  21.884 - (fn prems =>
  21.885 -        [
  21.886 -        (cut_facts_tac prems 1),
  21.887 -        (stac beta_cfun_sprod 1),
  21.888 -        (stac beta_cfun 1),
  21.889 -        (rtac cont_Isfst 1),
  21.890 -        (etac Isfst2 1)
  21.891 -        ]);
  21.892 +val prems = goalw thy [sfst_def,spair_def] 
  21.893 +        "y~=UU ==>sfst`(:x,y:)=x";
  21.894 +by (cut_facts_tac prems 1);
  21.895 +by (stac beta_cfun_sprod 1);
  21.896 +by (stac beta_cfun 1);
  21.897 +by (rtac cont_Isfst 1);
  21.898 +by (etac Isfst2 1);
  21.899 +qed "sfst2";
  21.900  
  21.901 -qed_goalw "ssnd2" thy [ssnd_def,spair_def] 
  21.902 -        "x~=UU ==>ssnd`(:x,y:)=y"
  21.903 - (fn prems =>
  21.904 -        [
  21.905 -        (cut_facts_tac prems 1),
  21.906 -        (stac beta_cfun_sprod 1),
  21.907 -        (stac beta_cfun 1),
  21.908 -        (rtac cont_Issnd 1),
  21.909 -        (etac Issnd2 1)
  21.910 -        ]);
  21.911 +val prems = goalw thy [ssnd_def,spair_def] 
  21.912 +        "x~=UU ==>ssnd`(:x,y:)=y";
  21.913 +by (cut_facts_tac prems 1);
  21.914 +by (stac beta_cfun_sprod 1);
  21.915 +by (stac beta_cfun 1);
  21.916 +by (rtac cont_Issnd 1);
  21.917 +by (etac Issnd2 1);
  21.918 +qed "ssnd2";
  21.919  
  21.920  
  21.921 -qed_goalw "defined_sfstssnd" thy [sfst_def,ssnd_def,spair_def]
  21.922 -        "p~=UU ==> sfst`p ~=UU & ssnd`p ~=UU"
  21.923 - (fn prems =>
  21.924 -        [
  21.925 -        (cut_facts_tac prems 1),
  21.926 -        (stac beta_cfun 1),
  21.927 -        (rtac cont_Issnd 1),
  21.928 -        (stac beta_cfun 1),
  21.929 -        (rtac cont_Isfst 1),
  21.930 -        (rtac defined_IsfstIssnd 1),
  21.931 -        (rtac (inst_sprod_pcpo RS subst) 1),
  21.932 -        (atac 1)
  21.933 -        ]);
  21.934 +val prems = goalw thy [sfst_def,ssnd_def,spair_def]
  21.935 +        "p~=UU ==> sfst`p ~=UU & ssnd`p ~=UU";
  21.936 +by (cut_facts_tac prems 1);
  21.937 +by (stac beta_cfun 1);
  21.938 +by (rtac cont_Issnd 1);
  21.939 +by (stac beta_cfun 1);
  21.940 +by (rtac cont_Isfst 1);
  21.941 +by (rtac defined_IsfstIssnd 1);
  21.942 +by (rtac (inst_sprod_pcpo RS subst) 1);
  21.943 +by (atac 1);
  21.944 +qed "defined_sfstssnd";
  21.945   
  21.946 +val prems = goalw thy [sfst_def,ssnd_def,spair_def] "(:sfst`p , ssnd`p:) = p";
  21.947 +by (stac beta_cfun_sprod 1);
  21.948 +by (stac beta_cfun 1);
  21.949 +by (rtac cont_Issnd 1);
  21.950 +by (stac beta_cfun 1);
  21.951 +by (rtac cont_Isfst 1);
  21.952 +by (rtac (surjective_pairing_Sprod RS sym) 1);
  21.953 +qed "surjective_pairing_Sprod2";
  21.954  
  21.955 -qed_goalw "surjective_pairing_Sprod2" thy 
  21.956 -        [sfst_def,ssnd_def,spair_def] "(:sfst`p , ssnd`p:) = p"
  21.957 - (fn prems =>
  21.958 -        [
  21.959 -        (stac beta_cfun_sprod 1),
  21.960 -        (stac beta_cfun 1),
  21.961 -        (rtac cont_Issnd 1),
  21.962 -        (stac beta_cfun 1),
  21.963 -        (rtac cont_Isfst 1),
  21.964 -        (rtac (surjective_pairing_Sprod RS sym) 1)
  21.965 -        ]);
  21.966 -
  21.967 -
  21.968 -qed_goalw "lub_sprod2" thy [sfst_def,ssnd_def,spair_def]
  21.969 +val prems = goalw thy [sfst_def,ssnd_def,spair_def]
  21.970  "[|chain(S)|] ==> range(S) <<| \
  21.971 -\ (: lub(range(%i. sfst`(S i))), lub(range(%i. ssnd`(S i))) :)"
  21.972 - (fn prems =>
  21.973 -        [
  21.974 -        (cut_facts_tac prems 1),
  21.975 -        (stac beta_cfun_sprod 1),
  21.976 -        (stac (beta_cfun RS ext) 1),
  21.977 -        (rtac cont_Issnd 1),
  21.978 -        (stac (beta_cfun RS ext) 1),
  21.979 -        (rtac cont_Isfst 1),
  21.980 -        (rtac lub_sprod 1),
  21.981 -        (resolve_tac prems 1)
  21.982 -        ]);
  21.983 +\ (: lub(range(%i. sfst`(S i))), lub(range(%i. ssnd`(S i))) :)";
  21.984 +by (cut_facts_tac prems 1);
  21.985 +by (stac beta_cfun_sprod 1);
  21.986 +by (stac (beta_cfun RS ext) 1);
  21.987 +by (rtac cont_Issnd 1);
  21.988 +by (stac (beta_cfun RS ext) 1);
  21.989 +by (rtac cont_Isfst 1);
  21.990 +by (rtac lub_sprod 1);
  21.991 +by (resolve_tac prems 1);
  21.992 +qed "lub_sprod2";
  21.993  
  21.994  
  21.995  bind_thm ("thelub_sprod2", lub_sprod2 RS thelubI);
  21.996 @@ -585,58 +492,52 @@
  21.997   (:lub (range (%i. sfst`(?S1 i))), lub (range (%i. ssnd`(?S1 i))):)" : thm
  21.998  *)
  21.999  
 21.1000 -qed_goalw "ssplit1" thy [ssplit_def]
 21.1001 -        "ssplit`f`UU=UU"
 21.1002 - (fn prems =>
 21.1003 -        [
 21.1004 -        (stac beta_cfun 1),
 21.1005 -        (Simp_tac 1),
 21.1006 -        (stac strictify1 1),
 21.1007 -        (rtac refl 1)
 21.1008 -        ]);
 21.1009 +val prems = goalw thy [ssplit_def]
 21.1010 +        "ssplit`f`UU=UU";
 21.1011 +by (stac beta_cfun 1);
 21.1012 +by (Simp_tac 1);
 21.1013 +by (stac strictify1 1);
 21.1014 +by (rtac refl 1);
 21.1015 +qed "ssplit1";
 21.1016  
 21.1017 -qed_goalw "ssplit2" thy [ssplit_def]
 21.1018 -        "[|x~=UU;y~=UU|] ==> ssplit`f`(:x,y:)= f`x`y"
 21.1019 - (fn prems =>
 21.1020 -        [
 21.1021 -        (stac beta_cfun 1),
 21.1022 -        (Simp_tac 1),
 21.1023 -        (stac strictify2 1),
 21.1024 -        (rtac defined_spair 1),
 21.1025 -        (resolve_tac prems 1),
 21.1026 -        (resolve_tac prems 1),
 21.1027 -        (stac beta_cfun 1),
 21.1028 -        (Simp_tac 1),
 21.1029 -        (stac sfst2 1),
 21.1030 -        (resolve_tac prems 1),
 21.1031 -        (stac ssnd2 1),
 21.1032 -        (resolve_tac prems 1),
 21.1033 -        (rtac refl 1)
 21.1034 -        ]);
 21.1035 +val prems = goalw thy [ssplit_def]
 21.1036 +        "[|x~=UU;y~=UU|] ==> ssplit`f`(:x,y:)= f`x`y";
 21.1037 +by (stac beta_cfun 1);
 21.1038 +by (Simp_tac 1);
 21.1039 +by (stac strictify2 1);
 21.1040 +by (rtac defined_spair 1);
 21.1041 +by (resolve_tac prems 1);
 21.1042 +by (resolve_tac prems 1);
 21.1043 +by (stac beta_cfun 1);
 21.1044 +by (Simp_tac 1);
 21.1045 +by (stac sfst2 1);
 21.1046 +by (resolve_tac prems 1);
 21.1047 +by (stac ssnd2 1);
 21.1048 +by (resolve_tac prems 1);
 21.1049 +by (rtac refl 1);
 21.1050 +qed "ssplit2";
 21.1051  
 21.1052  
 21.1053 -qed_goalw "ssplit3" thy [ssplit_def]
 21.1054 -  "ssplit`spair`z=z"
 21.1055 - (fn prems =>
 21.1056 -        [
 21.1057 -        (stac beta_cfun 1),
 21.1058 -        (Simp_tac 1),
 21.1059 -        (case_tac "z=UU" 1),
 21.1060 -        (hyp_subst_tac 1),
 21.1061 -        (rtac strictify1 1),
 21.1062 -        (rtac trans 1),
 21.1063 -        (rtac strictify2 1),
 21.1064 -        (atac 1),
 21.1065 -        (stac beta_cfun 1),
 21.1066 -        (Simp_tac 1),
 21.1067 -        (rtac surjective_pairing_Sprod2 1)
 21.1068 -        ]);
 21.1069 +val prems = goalw thy [ssplit_def]
 21.1070 +  "ssplit`spair`z=z";
 21.1071 +by (stac beta_cfun 1);
 21.1072 +by (Simp_tac 1);
 21.1073 +by (case_tac "z=UU" 1);
 21.1074 +by (hyp_subst_tac 1);
 21.1075 +by (rtac strictify1 1);
 21.1076 +by (rtac trans 1);
 21.1077 +by (rtac strictify2 1);
 21.1078 +by (atac 1);
 21.1079 +by (stac beta_cfun 1);
 21.1080 +by (Simp_tac 1);
 21.1081 +by (rtac surjective_pairing_Sprod2 1);
 21.1082 +qed "ssplit3";
 21.1083  
 21.1084  (* ------------------------------------------------------------------------ *)
 21.1085  (* install simplifier for Sprod                                             *)
 21.1086  (* ------------------------------------------------------------------------ *)
 21.1087  
 21.1088 -val Sprod_rews = [strict_spair1,strict_spair2,strict_sfst1,strict_sfst2,
 21.1089 +val Sprod_rews = [strict_sfst1,strict_sfst2,
 21.1090                  strict_ssnd1,strict_ssnd2,sfst2,ssnd2,defined_spair,
 21.1091                  ssplit1,ssplit2];
 21.1092  Addsimps Sprod_rews;
    22.1 --- a/src/HOLCF/Ssum0.ML	Tue Jul 04 14:58:40 2000 +0200
    22.2 +++ b/src/HOLCF/Ssum0.ML	Tue Jul 04 15:58:11 2000 +0200
    22.3 @@ -10,23 +10,19 @@
    22.4  (* A non-emptyness result for Sssum                                         *)
    22.5  (* ------------------------------------------------------------------------ *)
    22.6  
    22.7 -qed_goalw "SsumIl" Ssum0.thy [Ssum_def] "Sinl_Rep(a):Ssum"
    22.8 - (fn prems =>
    22.9 -        [
   22.10 -        (rtac CollectI 1),
   22.11 -        (rtac disjI1 1),
   22.12 -        (rtac exI 1),
   22.13 -        (rtac refl 1)
   22.14 -        ]);
   22.15 +val prems = goalw Ssum0.thy [Ssum_def] "Sinl_Rep(a):Ssum";
   22.16 +by (rtac CollectI 1);
   22.17 +by (rtac disjI1 1);
   22.18 +by (rtac exI 1);
   22.19 +by (rtac refl 1);
   22.20 +qed "SsumIl";
   22.21  
   22.22 -qed_goalw "SsumIr" Ssum0.thy [Ssum_def] "Sinr_Rep(a):Ssum"
   22.23 - (fn prems =>
   22.24 -        [
   22.25 -        (rtac CollectI 1),
   22.26 -        (rtac disjI2 1),
   22.27 -        (rtac exI 1),
   22.28 -        (rtac refl 1)
   22.29 -        ]);
   22.30 +val prems = goalw Ssum0.thy [Ssum_def] "Sinr_Rep(a):Ssum";
   22.31 +by (rtac CollectI 1);
   22.32 +by (rtac disjI2 1);
   22.33 +by (rtac exI 1);
   22.34 +by (rtac refl 1);
   22.35 +qed "SsumIr";
   22.36  
   22.37  Goal "inj_on Abs_Ssum Ssum";
   22.38  by (rtac inj_on_inverseI 1);
   22.39 @@ -37,58 +33,48 @@
   22.40  (* Strictness of Sinr_Rep, Sinl_Rep and Isinl, Isinr                        *)
   22.41  (* ------------------------------------------------------------------------ *)
   22.42  
   22.43 -qed_goalw "strict_SinlSinr_Rep" Ssum0.thy [Sinr_Rep_def,Sinl_Rep_def]
   22.44 - "Sinl_Rep(UU) = Sinr_Rep(UU)"
   22.45 - (fn prems =>
   22.46 -        [
   22.47 -        (rtac ext 1),
   22.48 -        (rtac ext 1),
   22.49 -        (rtac ext 1),
   22.50 -        (fast_tac HOL_cs 1)
   22.51 -        ]);
   22.52 +val prems = goalw Ssum0.thy [Sinr_Rep_def,Sinl_Rep_def]
   22.53 + "Sinl_Rep(UU) = Sinr_Rep(UU)";
   22.54 +by (rtac ext 1);
   22.55 +by (rtac ext 1);
   22.56 +by (rtac ext 1);
   22.57 +by (fast_tac HOL_cs 1);
   22.58 +qed "strict_SinlSinr_Rep";
   22.59  
   22.60 -qed_goalw "strict_IsinlIsinr" Ssum0.thy [Isinl_def,Isinr_def]
   22.61 - "Isinl(UU) = Isinr(UU)"
   22.62 - (fn prems =>
   22.63 -        [
   22.64 -        (rtac (strict_SinlSinr_Rep RS arg_cong) 1)
   22.65 -        ]);
   22.66 +val prems = goalw Ssum0.thy [Isinl_def,Isinr_def]
   22.67 + "Isinl(UU) = Isinr(UU)";
   22.68 +by (rtac (strict_SinlSinr_Rep RS arg_cong) 1);
   22.69 +qed "strict_IsinlIsinr";
   22.70  
   22.71  
   22.72  (* ------------------------------------------------------------------------ *)
   22.73  (* distinctness of  Sinl_Rep, Sinr_Rep and Isinl, Isinr                     *)
   22.74  (* ------------------------------------------------------------------------ *)
   22.75  
   22.76 -qed_goalw "noteq_SinlSinr_Rep" Ssum0.thy [Sinl_Rep_def,Sinr_Rep_def]
   22.77 -        "(Sinl_Rep(a) = Sinr_Rep(b)) ==> a=UU & b=UU"
   22.78 - (fn prems =>
   22.79 -        [
   22.80 -        (rtac conjI 1),
   22.81 -        (case_tac "a=UU" 1),
   22.82 -        (atac 1),
   22.83 -        (rtac ((hd prems) RS fun_cong RS fun_cong RS fun_cong RS iffD2 
   22.84 -        RS mp RS conjunct1 RS sym) 1),
   22.85 -        (fast_tac HOL_cs 1),
   22.86 -        (atac 1),
   22.87 -        (case_tac "b=UU" 1),
   22.88 -        (atac 1),
   22.89 -        (rtac ((hd prems) RS fun_cong RS fun_cong RS fun_cong RS iffD1 
   22.90 -        RS mp RS conjunct1 RS sym) 1),
   22.91 -        (fast_tac HOL_cs 1),
   22.92 -        (atac 1)
   22.93 -        ]);
   22.94 +val prems = goalw Ssum0.thy [Sinl_Rep_def,Sinr_Rep_def]
   22.95 +        "(Sinl_Rep(a) = Sinr_Rep(b)) ==> a=UU & b=UU";
   22.96 +by (rtac conjI 1);
   22.97 +by (case_tac "a=UU" 1);
   22.98 +by (atac 1);
   22.99 +by (rtac ((hd prems) RS fun_cong RS fun_cong RS fun_cong RS iffD2  RS mp RS conjunct1 RS sym) 1);
  22.100 +by (fast_tac HOL_cs 1);
  22.101 +by (atac 1);
  22.102 +by (case_tac "b=UU" 1);
  22.103 +by (atac 1);
  22.104 +by (rtac ((hd prems) RS fun_cong RS fun_cong RS fun_cong RS iffD1  RS mp RS conjunct1 RS sym) 1);
  22.105 +by (fast_tac HOL_cs 1);
  22.106 +by (atac 1);
  22.107 +qed "noteq_SinlSinr_Rep";
  22.108  
  22.109  
  22.110 -qed_goalw "noteq_IsinlIsinr" Ssum0.thy [Isinl_def,Isinr_def]
  22.111 -        "Isinl(a)=Isinr(b) ==> a=UU & b=UU"
  22.112 - (fn prems =>
  22.113 -        [
  22.114 -        (cut_facts_tac prems 1),
  22.115 -        (rtac noteq_SinlSinr_Rep 1),
  22.116 -        (etac (inj_on_Abs_Ssum  RS inj_onD) 1),
  22.117 -        (rtac SsumIl 1),
  22.118 -        (rtac SsumIr 1)
  22.119 -        ]);
  22.120 +val prems = goalw Ssum0.thy [Isinl_def,Isinr_def]
  22.121 +        "Isinl(a)=Isinr(b) ==> a=UU & b=UU";
  22.122 +by (cut_facts_tac prems 1);
  22.123 +by (rtac noteq_SinlSinr_Rep 1);
  22.124 +by (etac (inj_on_Abs_Ssum  RS inj_onD) 1);
  22.125 +by (rtac SsumIl 1);
  22.126 +by (rtac SsumIr 1);
  22.127 +qed "noteq_IsinlIsinr";
  22.128  
  22.129  
  22.130  
  22.131 @@ -96,49 +82,37 @@
  22.132  (* injectivity of Sinl_Rep, Sinr_Rep and Isinl, Isinr                       *)
  22.133  (* ------------------------------------------------------------------------ *)
  22.134  
  22.135 -qed_goalw "inject_Sinl_Rep1" Ssum0.thy [Sinl_Rep_def]
  22.136 - "(Sinl_Rep(a) = Sinl_Rep(UU)) ==> a=UU"
  22.137 - (fn prems =>
  22.138 -        [
  22.139 -        (case_tac "a=UU" 1),
  22.140 -        (atac 1),
  22.141 -        (rtac ((hd prems) RS fun_cong RS fun_cong RS fun_cong 
  22.142 -        RS iffD2 RS mp RS conjunct1 RS sym) 1),
  22.143 -        (fast_tac HOL_cs 1),
  22.144 -        (atac 1)
  22.145 -        ]);
  22.146 +val prems = goalw Ssum0.thy [Sinl_Rep_def]
  22.147 + "(Sinl_Rep(a) = Sinl_Rep(UU)) ==> a=UU";
  22.148 +by (case_tac "a=UU" 1);
  22.149 +by (atac 1);
  22.150 +by (rtac ((hd prems) RS fun_cong RS fun_cong RS fun_cong  RS iffD2 RS mp RS conjunct1 RS sym) 1);
  22.151 +by (fast_tac HOL_cs 1);
  22.152 +by (atac 1);
  22.153 +qed "inject_Sinl_Rep1";
  22.154  
  22.155 -qed_goalw "inject_Sinr_Rep1" Ssum0.thy [Sinr_Rep_def]
  22.156 - "(Sinr_Rep(b) = Sinr_Rep(UU)) ==> b=UU"
  22.157 - (fn prems =>
  22.158 -        [
  22.159 -        (case_tac "b=UU" 1),
  22.160 -        (atac 1),
  22.161 -        (rtac ((hd prems) RS fun_cong RS fun_cong RS fun_cong 
  22.162 -        RS iffD2 RS mp RS conjunct1 RS sym) 1),
  22.163 -        (fast_tac HOL_cs 1),
  22.164 -        (atac 1)
  22.165 -        ]);
  22.166 +val prems = goalw Ssum0.thy [Sinr_Rep_def]
  22.167 + "(Sinr_Rep(b) = Sinr_Rep(UU)) ==> b=UU";
  22.168 +by (case_tac "b=UU" 1);
  22.169 +by (atac 1);
  22.170 +by (rtac ((hd prems) RS fun_cong RS fun_cong RS fun_cong  RS iffD2 RS mp RS conjunct1 RS sym) 1);
  22.171 +by (fast_tac HOL_cs 1);
  22.172 +by (atac 1);
  22.173 +qed "inject_Sinr_Rep1";
  22.174  
  22.175 -qed_goalw "inject_Sinl_Rep2" Ssum0.thy [Sinl_Rep_def]
  22.176 -"[| a1~=UU ; a2~=UU ; Sinl_Rep(a1)=Sinl_Rep(a2) |] ==> a1=a2"
  22.177 - (fn prems =>
  22.178 -        [
  22.179 -        (rtac ((nth_elem (2,prems)) RS fun_cong  RS fun_cong RS fun_cong 
  22.180 -        RS iffD1 RS mp RS conjunct1) 1),
  22.181 -        (fast_tac HOL_cs 1),
  22.182 -        (resolve_tac prems 1)
  22.183 -        ]);
  22.184 +val prems = goalw Ssum0.thy [Sinl_Rep_def]
  22.185 +"[| a1~=UU ; a2~=UU ; Sinl_Rep(a1)=Sinl_Rep(a2) |] ==> a1=a2";
  22.186 +by (rtac ((nth_elem (2,prems)) RS fun_cong  RS fun_cong RS fun_cong  RS iffD1 RS mp RS conjunct1) 1);
  22.187 +by (fast_tac HOL_cs 1);
  22.188 +by (resolve_tac prems 1);
  22.189 +qed "inject_Sinl_Rep2";
  22.190  
  22.191 -qed_goalw "inject_Sinr_Rep2" Ssum0.thy [Sinr_Rep_def]
  22.192 -"[|b1~=UU ; b2~=UU ; Sinr_Rep(b1)=Sinr_Rep(b2) |] ==> b1=b2"
  22.193 - (fn prems =>
  22.194 -        [
  22.195 -        (rtac ((nth_elem (2,prems)) RS fun_cong  RS fun_cong RS fun_cong 
  22.196 -        RS iffD1 RS mp RS conjunct1) 1),
  22.197 -        (fast_tac HOL_cs 1),
  22.198 -        (resolve_tac prems 1)
  22.199 -        ]);
  22.200 +val prems = goalw Ssum0.thy [Sinr_Rep_def]
  22.201 +"[|b1~=UU ; b2~=UU ; Sinr_Rep(b1)=Sinr_Rep(b2) |] ==> b1=b2";
  22.202 +by (rtac ((nth_elem (2,prems)) RS fun_cong  RS fun_cong RS fun_cong  RS iffD1 RS mp RS conjunct1) 1);
  22.203 +by (fast_tac HOL_cs 1);
  22.204 +by (resolve_tac prems 1);
  22.205 +qed "inject_Sinr_Rep2";
  22.206  
  22.207  Goal "Sinl_Rep(a1)=Sinl_Rep(a2) ==> a1=a2";
  22.208  by (case_tac "a1=UU" 1);
  22.209 @@ -166,27 +140,23 @@
  22.210  by (atac 1);
  22.211  qed "inject_Sinr_Rep";
  22.212  
  22.213 -qed_goalw "inject_Isinl" Ssum0.thy [Isinl_def]
  22.214 -"Isinl(a1)=Isinl(a2)==> a1=a2"
  22.215 - (fn prems =>
  22.216 -        [
  22.217 -        (cut_facts_tac prems 1),
  22.218 -        (rtac inject_Sinl_Rep 1),
  22.219 -        (etac (inj_on_Abs_Ssum  RS inj_onD) 1),
  22.220 -        (rtac SsumIl 1),
  22.221 -        (rtac SsumIl 1)
  22.222 -        ]);
  22.223 +val prems = goalw Ssum0.thy [Isinl_def]
  22.224 +"Isinl(a1)=Isinl(a2)==> a1=a2";
  22.225 +by (cut_facts_tac prems 1);
  22.226 +by (rtac inject_Sinl_Rep 1);
  22.227 +by (etac (inj_on_Abs_Ssum  RS inj_onD) 1);
  22.228 +by (rtac SsumIl 1);
  22.229 +by (rtac SsumIl 1);
  22.230 +qed "inject_Isinl";
  22.231  
  22.232 -qed_goalw "inject_Isinr" Ssum0.thy [Isinr_def]
  22.233 -"Isinr(b1)=Isinr(b2) ==> b1=b2"
  22.234 - (fn prems =>
  22.235 -        [
  22.236 -        (cut_facts_tac prems 1),
  22.237 -        (rtac inject_Sinr_Rep 1),
  22.238 -        (etac (inj_on_Abs_Ssum  RS inj_onD) 1),
  22.239 -        (rtac SsumIr 1),
  22.240 -        (rtac SsumIr 1)
  22.241 -        ]);
  22.242 +val prems = goalw Ssum0.thy [Isinr_def]
  22.243 +"Isinr(b1)=Isinr(b2) ==> b1=b2";
  22.244 +by (cut_facts_tac prems 1);
  22.245 +by (rtac inject_Sinr_Rep 1);
  22.246 +by (etac (inj_on_Abs_Ssum  RS inj_onD) 1);
  22.247 +by (rtac SsumIr 1);
  22.248 +by (rtac SsumIr 1);
  22.249 +qed "inject_Isinr";
  22.250  
  22.251  Goal "a1~=a2 ==> Isinl(a1) ~= Isinl(a2)";
  22.252  by (rtac contrapos 1);
  22.253 @@ -205,46 +175,44 @@
  22.254  (* choice of the bottom representation is arbitrary                         *)
  22.255  (* ------------------------------------------------------------------------ *)
  22.256  
  22.257 -qed_goalw "Exh_Ssum" Ssum0.thy [Isinl_def,Isinr_def]
  22.258 -        "z=Isinl(UU) | (? a. z=Isinl(a) & a~=UU) | (? b. z=Isinr(b) & b~=UU)"
  22.259 - (fn prems =>
  22.260 -        [
  22.261 -        (rtac (rewrite_rule [Ssum_def] Rep_Ssum RS CollectE) 1),
  22.262 -        (etac disjE 1),
  22.263 -        (etac exE 1),
  22.264 -        (case_tac "z= Abs_Ssum(Sinl_Rep(UU))" 1),
  22.265 -        (etac disjI1 1),
  22.266 -        (rtac disjI2 1),
  22.267 -        (rtac disjI1 1),
  22.268 -        (rtac exI 1),
  22.269 -        (rtac conjI 1),
  22.270 -        (rtac (Rep_Ssum_inverse RS sym RS trans) 1),
  22.271 -        (etac arg_cong 1),
  22.272 -        (res_inst_tac [("Q","Sinl_Rep(a)=Sinl_Rep(UU)")] contrapos 1),
  22.273 -        (etac arg_cong 2),
  22.274 -        (etac contrapos 1),
  22.275 -        (rtac (Rep_Ssum_inverse RS sym RS trans) 1),
  22.276 -        (rtac trans 1),
  22.277 -        (etac arg_cong 1),
  22.278 -        (etac arg_cong 1),
  22.279 -        (etac exE 1),
  22.280 -        (case_tac "z= Abs_Ssum(Sinl_Rep(UU))" 1),
  22.281 -        (etac disjI1 1),
  22.282 -        (rtac disjI2 1),
  22.283 -        (rtac disjI2 1),
  22.284 -        (rtac exI 1),
  22.285 -        (rtac conjI 1),
  22.286 -        (rtac (Rep_Ssum_inverse RS sym RS trans) 1),
  22.287 -        (etac arg_cong 1),
  22.288 -        (res_inst_tac [("Q","Sinr_Rep(b)=Sinl_Rep(UU)")] contrapos 1),
  22.289 -        (hyp_subst_tac 2),
  22.290 -        (rtac (strict_SinlSinr_Rep RS sym) 2),
  22.291 -        (etac contrapos 1),
  22.292 -        (rtac (Rep_Ssum_inverse RS sym RS trans) 1),
  22.293 -        (rtac trans 1),
  22.294 -        (etac arg_cong 1),
  22.295 -        (etac arg_cong 1)
  22.296 -        ]);
  22.297 +val prems = goalw Ssum0.thy [Isinl_def,Isinr_def]
  22.298 +        "z=Isinl(UU) | (? a. z=Isinl(a) & a~=UU) | (? b. z=Isinr(b) & b~=UU)";
  22.299 +by (rtac (rewrite_rule [Ssum_def] Rep_Ssum RS CollectE) 1);
  22.300 +by (etac disjE 1);
  22.301 +by (etac exE 1);
  22.302 +by (case_tac "z= Abs_Ssum(Sinl_Rep(UU))" 1);
  22.303 +by (etac disjI1 1);
  22.304 +by (rtac disjI2 1);
  22.305 +by (rtac disjI1 1);
  22.306 +by (rtac exI 1);
  22.307 +by (rtac conjI 1);
  22.308 +by (rtac (Rep_Ssum_inverse RS sym RS trans) 1);
  22.309 +by (etac arg_cong 1);
  22.310 +by (res_inst_tac [("Q","Sinl_Rep(a)=Sinl_Rep(UU)")] contrapos 1);
  22.311 +by (etac arg_cong 2);
  22.312 +by (etac contrapos 1);
  22.313 +by (rtac (Rep_Ssum_inverse RS sym RS trans) 1);
  22.314 +by (rtac trans 1);
  22.315 +by (etac arg_cong 1);
  22.316 +by (etac arg_cong 1);
  22.317 +by (etac exE 1);
  22.318 +by (case_tac "z= Abs_Ssum(Sinl_Rep(UU))" 1);
  22.319 +by (etac disjI1 1);
  22.320 +by (rtac disjI2 1);
  22.321 +by (rtac disjI2 1);
  22.322 +by (rtac exI 1);
  22.323 +by (rtac conjI 1);
  22.324 +by (rtac (Rep_Ssum_inverse RS sym RS trans) 1);
  22.325 +by (etac arg_cong 1);
  22.326 +by (res_inst_tac [("Q","Sinr_Rep(b)=Sinl_Rep(UU)")] contrapos 1);
  22.327 +by (hyp_subst_tac 2);
  22.328 +by (rtac (strict_SinlSinr_Rep RS sym) 2);
  22.329 +by (etac contrapos 1);
  22.330 +by (rtac (Rep_Ssum_inverse RS sym RS trans) 1);
  22.331 +by (rtac trans 1);
  22.332 +by (etac arg_cong 1);
  22.333 +by (etac arg_cong 1);
  22.334 +qed "Exh_Ssum";
  22.335  
  22.336  (* ------------------------------------------------------------------------ *)
  22.337  (* elimination rules for the strict sum ++                                  *)
  22.338 @@ -282,83 +250,77 @@
  22.339  (* rewrites for Iwhen                                                       *)
  22.340  (* ------------------------------------------------------------------------ *)
  22.341  
  22.342 -qed_goalw "Iwhen1" Ssum0.thy [Iwhen_def]
  22.343 -        "Iwhen f g (Isinl UU) = UU"
  22.344 - (fn prems =>
  22.345 -        [
  22.346 -        (rtac select_equality 1),
  22.347 -        (rtac conjI 1),
  22.348 -        (fast_tac HOL_cs  1),
  22.349 -        (rtac conjI 1),
  22.350 -        (strip_tac 1),
  22.351 -        (res_inst_tac [("P","a=UU")] notE 1),
  22.352 -        (fast_tac HOL_cs  1),
  22.353 -        (rtac inject_Isinl 1),
  22.354 -        (rtac sym 1),
  22.355 -        (fast_tac HOL_cs  1),
  22.356 -        (strip_tac 1),
  22.357 -        (res_inst_tac [("P","b=UU")] notE 1),
  22.358 -        (fast_tac HOL_cs  1),
  22.359 -        (rtac inject_Isinr 1),
  22.360 -        (rtac sym 1),
  22.361 -        (rtac (strict_IsinlIsinr RS subst) 1),
  22.362 -        (fast_tac HOL_cs  1),
  22.363 -        (fast_tac HOL_cs  1)
  22.364 -        ]);
  22.365 +val prems = goalw Ssum0.thy [Iwhen_def]
  22.366 +        "Iwhen f g (Isinl UU) = UU";
  22.367 +by (rtac select_equality 1);
  22.368 +by (rtac conjI 1);
  22.369 +by (fast_tac HOL_cs  1);
  22.370 +by (rtac conjI 1);
  22.371 +by (strip_tac 1);
  22.372 +by (res_inst_tac [("P","a=UU")] notE 1);
  22.373 +by (fast_tac HOL_cs  1);
  22.374 +by (rtac inject_Isinl 1);
  22.375 +by (rtac sym 1);
  22.376 +by (fast_tac HOL_cs  1);
  22.377 +by (strip_tac 1);
  22.378 +by (res_inst_tac [("P","b=UU")] notE 1);
  22.379 +by (fast_tac HOL_cs  1);
  22.380 +by (rtac inject_Isinr 1);
  22.381 +by (rtac sym 1);
  22.382 +by (rtac (strict_IsinlIsinr RS subst) 1);
  22.383 +by (fast_tac HOL_cs  1);
  22.384 +by (fast_tac HOL_cs  1);
  22.385 +qed "Iwhen1";
  22.386  
  22.387  
  22.388 -qed_goalw "Iwhen2" Ssum0.thy [Iwhen_def]
  22.389 -        "x~=UU ==> Iwhen f g (Isinl x) = f`x"
  22.390 - (fn prems =>
  22.391 -        [
  22.392 -        (cut_facts_tac prems 1),
  22.393 -        (rtac select_equality 1),
  22.394 -        (fast_tac HOL_cs  2),
  22.395 -        (rtac conjI 1),
  22.396 -        (strip_tac 1),
  22.397 -        (res_inst_tac [("P","x=UU")] notE 1),
  22.398 -        (atac 1),
  22.399 -        (rtac inject_Isinl 1),
  22.400 -        (atac 1),
  22.401 -        (rtac conjI 1),
  22.402 -        (strip_tac 1),
  22.403 -        (rtac cfun_arg_cong 1),
  22.404 -        (rtac inject_Isinl 1),
  22.405 -        (fast_tac HOL_cs  1),
  22.406 -        (strip_tac 1),
  22.407 -        (res_inst_tac [("P","Isinl(x) = Isinr(b)")] notE 1),
  22.408 -        (fast_tac HOL_cs  2),
  22.409 -        (rtac contrapos 1),
  22.410 -        (etac noteq_IsinlIsinr 2),
  22.411 -        (fast_tac HOL_cs  1)
  22.412 -        ]);
  22.413 +val prems = goalw Ssum0.thy [Iwhen_def]
  22.414 +        "x~=UU ==> Iwhen f g (Isinl x) = f`x";
  22.415 +by (cut_facts_tac prems 1);
  22.416 +by (rtac select_equality 1);
  22.417 +by (fast_tac HOL_cs  2);
  22.418 +by (rtac conjI 1);
  22.419 +by (strip_tac 1);
  22.420 +by (res_inst_tac [("P","x=UU")] notE 1);
  22.421 +by (atac 1);
  22.422 +by (rtac inject_Isinl 1);
  22.423 +by (atac 1);
  22.424 +by (rtac conjI 1);
  22.425 +by (strip_tac 1);
  22.426 +by (rtac cfun_arg_cong 1);
  22.427 +by (rtac inject_Isinl 1);
  22.428 +by (fast_tac HOL_cs  1);
  22.429 +by (strip_tac 1);
  22.430 +by (res_inst_tac [("P","Isinl(x) = Isinr(b)")] notE 1);
  22.431 +by (fast_tac HOL_cs  2);
  22.432 +by (rtac contrapos 1);
  22.433 +by (etac noteq_IsinlIsinr 2);
  22.434 +by (fast_tac HOL_cs  1);
  22.435 +qed "Iwhen2";
  22.436  
  22.437 -qed_goalw "Iwhen3" Ssum0.thy [Iwhen_def]
  22.438 -        "y~=UU ==> Iwhen f g (Isinr y) = g`y"
  22.439 - (fn prems =>
  22.440 -        [
  22.441 -        (cut_facts_tac prems 1),
  22.442 -        (rtac select_equality 1),
  22.443 -        (fast_tac HOL_cs  2),
  22.444 -        (rtac conjI 1),
  22.445 -        (strip_tac 1),
  22.446 -        (res_inst_tac [("P","y=UU")] notE 1),
  22.447 -        (atac 1),
  22.448 -        (rtac inject_Isinr 1),
  22.449 -        (rtac (strict_IsinlIsinr RS subst) 1),
  22.450 -        (atac 1),
  22.451 -        (rtac conjI 1),
  22.452 -        (strip_tac 1),
  22.453 -        (res_inst_tac [("P","Isinr(y) = Isinl(a)")] notE 1),
  22.454 -        (fast_tac HOL_cs  2),
  22.455 -        (rtac contrapos 1),
  22.456 -        (etac (sym RS noteq_IsinlIsinr) 2),
  22.457 -        (fast_tac HOL_cs  1),
  22.458 -        (strip_tac 1),
  22.459 -        (rtac cfun_arg_cong 1),
  22.460 -        (rtac inject_Isinr 1),
  22.461 -        (fast_tac HOL_cs  1)
  22.462 -        ]);
  22.463 +val prems = goalw Ssum0.thy [Iwhen_def]
  22.464 +        "y~=UU ==> Iwhen f g (Isinr y) = g`y";
  22.465 +by (cut_facts_tac prems 1);
  22.466 +by (rtac select_equality 1);
  22.467 +by (fast_tac HOL_cs  2);
  22.468 +by (rtac conjI 1);
  22.469 +by (strip_tac 1);
  22.470 +by (res_inst_tac [("P","y=UU")] notE 1);
  22.471 +by (atac 1);
  22.472 +by (rtac inject_Isinr 1);
  22.473 +by (rtac (strict_IsinlIsinr RS subst) 1);
  22.474 +by (atac 1);
  22.475 +by (rtac conjI 1);
  22.476 +by (strip_tac 1);
  22.477 +by (res_inst_tac [("P","Isinr(y) = Isinl(a)")] notE 1);
  22.478 +by (fast_tac HOL_cs  2);
  22.479 +by (rtac contrapos 1);
  22.480 +by (etac (sym RS noteq_IsinlIsinr) 2);
  22.481 +by (fast_tac HOL_cs  1);
  22.482 +by (strip_tac 1);
  22.483 +by (rtac cfun_arg_cong 1);
  22.484 +by (rtac inject_Isinr 1);
  22.485 +by (fast_tac HOL_cs  1);
  22.486 +qed "Iwhen3";
  22.487  
  22.488  (* ------------------------------------------------------------------------ *)
  22.489  (* instantiate the simplifier                                               *)
    23.1 --- a/src/HOLCF/Ssum1.ML	Tue Jul 04 14:58:40 2000 +0200
    23.2 +++ b/src/HOLCF/Ssum1.ML	Tue Jul 04 15:58:11 2000 +0200
    23.3 @@ -6,8 +6,6 @@
    23.4  Partial ordering for the strict sum ++
    23.5  *)
    23.6  
    23.7 -local 
    23.8 -
    23.9  fun eq_left s1 s2 = 
   23.10          (
   23.11          (res_inst_tac [("s",s1),("t",s2)] (inject_Isinl RS subst) 1)
   23.12 @@ -36,174 +34,163 @@
   23.13          THEN (atac 2)
   23.14          THEN (etac sym 1))
   23.15  
   23.16 -in
   23.17 +val prems = goalw thy [less_ssum_def]
   23.18 +"[|s1=Isinl(x::'a); s2=Isinl(y::'a)|] ==> s1 << s2 = (x << y)";
   23.19 +by (cut_facts_tac prems 1);
   23.20 +by (rtac select_equality 1);
   23.21 +by (dtac conjunct1 2);
   23.22 +by (dtac spec 2);
   23.23 +by (dtac spec 2);
   23.24 +by (etac mp 2);
   23.25 +by (fast_tac HOL_cs 2);
   23.26 +by (rtac conjI 1);
   23.27 +by (strip_tac 1);
   23.28 +by (etac conjE 1);
   23.29 +by (eq_left "x" "u");
   23.30 +by (eq_left "y" "xa");
   23.31 +by (rtac refl 1);
   23.32 +by (rtac conjI 1);
   23.33 +by (strip_tac 1);
   23.34 +by (etac conjE 1);
   23.35 +by (UU_left "x");
   23.36 +by (UU_right "v");
   23.37 +by (Simp_tac 1);
   23.38 +by (rtac conjI 1);
   23.39 +by (strip_tac 1);
   23.40 +by (etac conjE 1);
   23.41 +by (eq_left "x" "u");
   23.42 +by (UU_left "y");
   23.43 +by (rtac iffI 1);
   23.44 +by (etac UU_I 1);
   23.45 +by (res_inst_tac [("s","x"),("t","UU::'a")] subst 1);
   23.46 +by (atac 1);
   23.47 +by (rtac refl_less 1);
   23.48 +by (strip_tac 1);
   23.49 +by (etac conjE 1);
   23.50 +by (UU_left "x");
   23.51 +by (UU_right "v");
   23.52 +by (Simp_tac 1);
   23.53 +qed "less_ssum1a";
   23.54 +
   23.55  
   23.56 -val less_ssum1a = prove_goalw thy [less_ssum_def]
   23.57 -"[|s1=Isinl(x::'a); s2=Isinl(y::'a)|] ==> s1 << s2 = (x << y)"
   23.58 - (fn prems =>
   23.59 -        [
   23.60 -        (cut_facts_tac prems 1),
   23.61 -        (rtac select_equality 1),
   23.62 -        (dtac conjunct1 2),
   23.63 -        (dtac spec 2),
   23.64 -        (dtac spec 2),
   23.65 -        (etac mp 2),
   23.66 -        (fast_tac HOL_cs 2),
   23.67 -        (rtac conjI 1),
   23.68 -        (strip_tac 1),
   23.69 -        (etac conjE 1),
   23.70 -        (eq_left "x" "u"),
   23.71 -        (eq_left "y" "xa"),
   23.72 -        (rtac refl 1),
   23.73 -        (rtac conjI 1),
   23.74 -        (strip_tac 1),
   23.75 -        (etac conjE 1),
   23.76 -        (UU_left "x"),
   23.77 -        (UU_right "v"),
   23.78 -        (Simp_tac 1),
   23.79 -        (rtac conjI 1),
   23.80 -        (strip_tac 1),
   23.81 -        (etac conjE 1),
   23.82 -        (eq_left "x" "u"),
   23.83 -        (UU_left "y"),
   23.84 -        (rtac iffI 1),
   23.85 -        (etac UU_I 1),
   23.86 -        (res_inst_tac [("s","x"),("t","UU::'a")] subst 1),
   23.87 -        (atac 1),
   23.88 -        (rtac refl_less 1),
   23.89 -        (strip_tac 1),
   23.90 -        (etac conjE 1),
   23.91 -        (UU_left "x"),
   23.92 -        (UU_right "v"),
   23.93 -        (Simp_tac 1)
   23.94 -        ]);
   23.95 +val prems = goalw thy [less_ssum_def]
   23.96 +"[|s1=Isinr(x::'b); s2=Isinr(y::'b)|] ==> s1 << s2 = (x << y)";
   23.97 +by (cut_facts_tac prems 1);
   23.98 +by (rtac select_equality 1);
   23.99 +by (dtac conjunct2 2);
  23.100 +by (dtac conjunct1 2);
  23.101 +by (dtac spec 2);
  23.102 +by (dtac spec 2);
  23.103 +by (etac mp 2);
  23.104 +by (fast_tac HOL_cs 2);
  23.105 +by (rtac conjI 1);
  23.106 +by (strip_tac 1);
  23.107 +by (etac conjE 1);
  23.108 +by (UU_right "x");
  23.109 +by (UU_left "u");
  23.110 +by (Simp_tac 1);
  23.111 +by (rtac conjI 1);
  23.112 +by (strip_tac 1);
  23.113 +by (etac conjE 1);
  23.114 +by (eq_right "x" "v");
  23.115 +by (eq_right "y" "ya");
  23.116 +by (rtac refl 1);
  23.117 +by (rtac conjI 1);
  23.118 +by (strip_tac 1);
  23.119 +by (etac conjE 1);
  23.120 +by (UU_right "x");
  23.121 +by (UU_left "u");
  23.122 +by (Simp_tac 1);
  23.123 +by (strip_tac 1);
  23.124 +by (etac conjE 1);
  23.125 +by (eq_right "x" "v");
  23.126 +by (UU_right "y");
  23.127 +by (rtac iffI 1);
  23.128 +by (etac UU_I 1);
  23.129 +by (res_inst_tac [("s","UU::'b"),("t","x")] subst 1);
  23.130 +by (etac sym 1);
  23.131 +by (rtac refl_less 1);
  23.132 +qed "less_ssum1b";
  23.133  
  23.134  
  23.135 -val less_ssum1b = prove_goalw thy [less_ssum_def]
  23.136 -"[|s1=Isinr(x::'b); s2=Isinr(y::'b)|] ==> s1 << s2 = (x << y)"
  23.137 - (fn prems =>
  23.138 -        [
  23.139 -        (cut_facts_tac prems 1),
  23.140 -        (rtac select_equality 1),
  23.141 -        (dtac conjunct2 2),
  23.142 -        (dtac conjunct1 2),
  23.143 -        (dtac spec 2),
  23.144 -        (dtac spec 2),
  23.145 -        (etac mp 2),
  23.146 -        (fast_tac HOL_cs 2),
  23.147 -        (rtac conjI 1),
  23.148 -        (strip_tac 1),
  23.149 -        (etac conjE 1),
  23.150 -        (UU_right "x"),
  23.151 -        (UU_left "u"),
  23.152 -        (Simp_tac 1),
  23.153 -        (rtac conjI 1),
  23.154 -        (strip_tac 1),
  23.155 -        (etac conjE 1),
  23.156 -        (eq_right "x" "v"),
  23.157 -        (eq_right "y" "ya"),
  23.158 -        (rtac refl 1),
  23.159 -        (rtac conjI 1),
  23.160 -        (strip_tac 1),
  23.161 -        (etac conjE 1),
  23.162 -        (UU_right "x"),
  23.163 -        (UU_left "u"),
  23.164 -        (Simp_tac 1),
  23.165 -        (strip_tac 1),
  23.166 -        (etac conjE 1),
  23.167 -        (eq_right "x" "v"),
  23.168 -        (UU_right "y"),
  23.169 -        (rtac iffI 1),
  23.170 -        (etac UU_I 1),
  23.171 -        (res_inst_tac [("s","UU::'b"),("t","x")] subst 1),
  23.172 -        (etac sym 1),
  23.173 -        (rtac refl_less 1)
  23.174 -        ]);
  23.175 +val prems = goalw thy [less_ssum_def]
  23.176 +"[|s1=Isinl(x::'a); s2=Isinr(y::'b)|] ==> s1 << s2 = ((x::'a) = UU)";
  23.177 +by (cut_facts_tac prems 1);
  23.178 +by (rtac select_equality 1);
  23.179 +by (rtac conjI 1);
  23.180 +by (strip_tac 1);
  23.181 +by (etac conjE 1);
  23.182 +by (eq_left  "x" "u");
  23.183 +by (UU_left "xa");
  23.184 +by (rtac iffI 1);
  23.185 +by (res_inst_tac [("s","x"),("t","UU::'a")] subst 1);
  23.186 +by (atac 1);
  23.187 +by (rtac refl_less 1);
  23.188 +by (etac UU_I 1);
  23.189 +by (rtac conjI 1);
  23.190 +by (strip_tac 1);
  23.191 +by (etac conjE 1);
  23.192 +by (UU_left "x");
  23.193 +by (UU_right "v");
  23.194 +by (Simp_tac 1);
  23.195 +by (rtac conjI 1);
  23.196 +by (strip_tac 1);
  23.197 +by (etac conjE 1);
  23.198 +by (eq_left  "x" "u");
  23.199 +by (rtac refl 1);
  23.200 +by (strip_tac 1);
  23.201 +by (etac conjE 1);
  23.202 +by (UU_left "x");
  23.203 +by (UU_right "v");
  23.204 +by (Simp_tac 1);
  23.205 +by (dtac conjunct2 1);
  23.206 +by (dtac conjunct2 1);
  23.207 +by (dtac conjunct1 1);
  23.208 +by (dtac spec 1);
  23.209 +by (dtac spec 1);
  23.210 +by (etac mp 1);
  23.211 +by (fast_tac HOL_cs 1);
  23.212 +qed "less_ssum1c";
  23.213  
  23.214  
  23.215 -val less_ssum1c = prove_goalw thy [less_ssum_def]
  23.216 -"[|s1=Isinl(x::'a); s2=Isinr(y::'b)|] ==> s1 << s2 = ((x::'a) = UU)"
  23.217 - (fn prems =>
  23.218 -        [
  23.219 -        (cut_facts_tac prems 1),
  23.220 -        (rtac select_equality 1),
  23.221 -        (rtac conjI 1),
  23.222 -        (strip_tac 1),
  23.223 -        (etac conjE 1),
  23.224 -        (eq_left  "x" "u"),
  23.225 -        (UU_left "xa"),
  23.226 -        (rtac iffI 1),
  23.227 -        (res_inst_tac [("s","x"),("t","UU::'a")] subst 1),
  23.228 -        (atac 1),
  23.229 -        (rtac refl_less 1),
  23.230 -        (etac UU_I 1),
  23.231 -        (rtac conjI 1),
  23.232 -        (strip_tac 1),
  23.233 -        (etac conjE 1),
  23.234 -        (UU_left "x"),
  23.235 -        (UU_right "v"),
  23.236 -        (Simp_tac 1),
  23.237 -        (rtac conjI 1),
  23.238 -        (strip_tac 1),
  23.239 -        (etac conjE 1),
  23.240 -        (eq_left  "x" "u"),
  23.241 -        (rtac refl 1),
  23.242 -        (strip_tac 1),
  23.243 -        (etac conjE 1),
  23.244 -        (UU_left "x"),
  23.245 -        (UU_right "v"),
  23.246 -        (Simp_tac 1),
  23.247 -        (dtac conjunct2 1),
  23.248 -        (dtac conjunct2 1),
  23.249 -        (dtac conjunct1 1),
  23.250 -        (dtac spec 1),
  23.251 -        (dtac spec 1),
  23.252 -        (etac mp 1),
  23.253 -        (fast_tac HOL_cs 1)
  23.254 -        ]);
  23.255 -
  23.256 -
  23.257 -val less_ssum1d = prove_goalw thy [less_ssum_def]
  23.258 -"[|s1=Isinr(x); s2=Isinl(y)|] ==> s1 << s2 = (x = UU)"
  23.259 - (fn prems =>
  23.260 -        [
  23.261 -        (cut_facts_tac prems 1),
  23.262 -