converted theory ex/Limit to Isar script, but it still needs work!
authorpaulson
Mon Apr 15 10:18:01 2002 +0200 (2002-04-15)
changeset 13085bfdb0534c8ec
parent 13084 9fbbd7c79c65
child 13086 3bd1df57ee00
converted theory ex/Limit to Isar script, but it still needs work!
src/ZF/IsaMakefile
src/ZF/ex/Limit.ML
src/ZF/ex/Limit.thy
     1.1 --- a/src/ZF/IsaMakefile	Mon Apr 15 10:05:11 2002 +0200
     1.2 +++ b/src/ZF/IsaMakefile	Mon Apr 15 10:18:01 2002 +0200
     1.3 @@ -128,7 +128,7 @@
     1.4  
     1.5  $(LOG)/ZF-ex.gz: $(OUT)/ZF ex/ROOT.ML \
     1.6    ex/BinEx.thy ex/CoUnit.thy ex/Commutation.thy \
     1.7 -  ex/Limit.ML ex/Limit.thy ex/LList.thy ex/Primes.thy \
     1.8 +  ex/Limit.thy ex/LList.thy ex/Primes.thy \
     1.9    ex/NatSum.thy ex/Ramsey.thy ex/misc.thy
    1.10  	@$(ISATOOL) usedir $(OUT)/ZF ex
    1.11  
     2.1 --- a/src/ZF/ex/Limit.ML	Mon Apr 15 10:05:11 2002 +0200
     2.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     2.3 @@ -1,2383 +0,0 @@
     2.4 -(*  Title:      ZF/ex/Limit
     2.5 -    ID:         $Id$
     2.6 -    Author:     Sten Agerholm
     2.7 -
     2.8 -The inverse limit construction.
     2.9 -
    2.10 -(Proofs tidied up considerably by lcp)
    2.11 -*)
    2.12 -   
    2.13 -val nat_linear_le = [nat_into_Ord,nat_into_Ord] MRS Ord_linear_le;
    2.14 -
    2.15 -(*----------------------------------------------------------------------*)
    2.16 -(* Useful goal commands.                                                *)
    2.17 -(*----------------------------------------------------------------------*)
    2.18 -
    2.19 -val brr = fn thl => fn n => by (REPEAT(ares_tac thl n));
    2.20 -
    2.21 -(*----------------------------------------------------------------------*)
    2.22 -(* Basic results.                                                       *)
    2.23 -(*----------------------------------------------------------------------*)
    2.24 -
    2.25 -Goalw [set_def] "x \\<in> fst(D) ==> x \\<in> set(D)";
    2.26 -by (assume_tac 1);
    2.27 -qed "set_I";
    2.28 -
    2.29 -Goalw [rel_def] "<x,y>:snd(D) ==> rel(D,x,y)";
    2.30 -by (assume_tac 1);
    2.31 -qed "rel_I";
    2.32 -
    2.33 -Goalw [rel_def] "rel(D,x,y) ==> <x,y>:snd(D)";
    2.34 -by (assume_tac 1);
    2.35 -qed "rel_E";
    2.36 -
    2.37 -(*----------------------------------------------------------------------*)
    2.38 -(* I/E/D rules for po and cpo.                                          *)
    2.39 -(*----------------------------------------------------------------------*)
    2.40 -
    2.41 -Goalw [po_def] "[|po(D); x \\<in> set(D)|] ==> rel(D,x,x)";
    2.42 -by (Blast_tac 1);
    2.43 -qed "po_refl";
    2.44 -
    2.45 -Goalw [po_def] "[|po(D); rel(D,x,y); rel(D,y,z); x \\<in> set(D);  \
    2.46 -\                 y \\<in> set(D); z \\<in> set(D)|] ==> rel(D,x,z)";
    2.47 -by (Blast_tac 1);
    2.48 -qed "po_trans";
    2.49 -
    2.50 -Goalw [po_def]
    2.51 -    "[|po(D); rel(D,x,y); rel(D,y,x); x \\<in> set(D); y \\<in> set(D)|] ==> x = y";
    2.52 -by (Blast_tac 1);
    2.53 -qed "po_antisym";
    2.54 -
    2.55 -val prems = Goalw [po_def]
    2.56 -    "[| !!x. x \\<in> set(D) ==> rel(D,x,x);   \
    2.57 -\       !!x y z. [| rel(D,x,y); rel(D,y,z); x \\<in> set(D); y \\<in> set(D); z \\<in> set(D)|] ==> \
    2.58 -\                rel(D,x,z);  \
    2.59 -\       !!x y. [| rel(D,x,y); rel(D,y,x); x \\<in> set(D); y \\<in> set(D)|] ==> x=y |] ==> \
    2.60 -\    po(D)";
    2.61 -by (blast_tac (claset() addIs prems) 1);
    2.62 -qed "poI";
    2.63 -
    2.64 -val prems = Goalw [cpo_def]
    2.65 -    "[| po(D); !!X. chain(D,X) ==> islub(D,X,x(D,X))|] ==> cpo(D)";
    2.66 -by (blast_tac (claset() addIs prems) 1);
    2.67 -qed "cpoI";
    2.68 -
    2.69 -Goalw [cpo_def] "cpo(D) ==> po(D)";
    2.70 -by (Blast_tac 1);
    2.71 -qed "cpo_po";
    2.72 -
    2.73 -Goal "[|cpo(D); x \\<in> set(D)|] ==> rel(D,x,x)";
    2.74 -by (blast_tac (claset() addIs [po_refl, cpo_po]) 1);
    2.75 -qed "cpo_refl";
    2.76 -
    2.77 -Addsimps [cpo_refl];
    2.78 -AddSIs   [cpo_refl];
    2.79 -AddTCs   [cpo_refl];
    2.80 -
    2.81 -Goal "[|cpo(D); rel(D,x,y); rel(D,y,z); x \\<in> set(D);  \
    2.82 -\       y \\<in> set(D); z \\<in> set(D)|] ==> rel(D,x,z)";
    2.83 -by (blast_tac (claset() addIs [cpo_po, po_trans]) 1);
    2.84 -qed "cpo_trans";
    2.85 -
    2.86 -Goal "[|cpo(D); rel(D,x,y); rel(D,y,x); x \\<in> set(D); y \\<in> set(D)|] ==> x = y";
    2.87 -by (blast_tac (claset() addIs [cpo_po, po_antisym]) 1);
    2.88 -qed "cpo_antisym";
    2.89 -
    2.90 -val [cpo,chain,ex] = Goalw [cpo_def] 
    2.91 -  "[|cpo(D); chain(D,X);  !!x. islub(D,X,x) ==> R|] ==> R";
    2.92 -by (rtac (chain RS (cpo RS conjunct2 RS spec RS mp) RS exE) 1); 
    2.93 -by (etac ex 1);
    2.94 -qed "cpo_islub";
    2.95 -
    2.96 -(*----------------------------------------------------------------------*)
    2.97 -(* Theorems about isub and islub.                                       *)
    2.98 -(*----------------------------------------------------------------------*)
    2.99 -
   2.100 -Goalw [islub_def] "islub(D,X,x) ==> isub(D,X,x)";
   2.101 -by (Asm_simp_tac 1);
   2.102 -qed "islub_isub";
   2.103 -
   2.104 -Goalw [islub_def,isub_def] "islub(D,X,x) ==> x \\<in> set(D)";
   2.105 -by (Asm_simp_tac 1);
   2.106 -qed "islub_in";
   2.107 -
   2.108 -Goalw [islub_def,isub_def] "[|islub(D,X,x); n \\<in> nat|] ==> rel(D,X`n,x)";
   2.109 -by (Asm_simp_tac 1);
   2.110 -qed "islub_ub";
   2.111 -
   2.112 -Goalw [islub_def] "[|islub(D,X,x); isub(D,X,y)|] ==> rel(D,x,y)";
   2.113 -by (Blast_tac 1);
   2.114 -qed "islub_least";
   2.115 -
   2.116 -val prems = Goalw [islub_def]  (* islubI *)
   2.117 -    "[|isub(D,X,x); !!y. isub(D,X,y) ==> rel(D,x,y)|] ==> islub(D,X,x)";
   2.118 -by (blast_tac (claset() addIs prems) 1);
   2.119 -qed "islubI";
   2.120 -
   2.121 -val prems = Goalw [isub_def]  (* isubI *)
   2.122 -    "[|x \\<in> set(D);  !!n. n \\<in> nat ==> rel(D,X`n,x)|] ==> isub(D,X,x)";
   2.123 -by (blast_tac (claset() addIs prems) 1);
   2.124 -qed "isubI";
   2.125 -
   2.126 -val prems = Goalw [isub_def]  (* isubE *)
   2.127 -    "[|isub(D,X,x); [|x \\<in> set(D);  !!n. n \\<in> nat==>rel(D,X`n,x)|] ==> P \
   2.128 -\    |] ==> P";
   2.129 -by (asm_simp_tac (simpset() addsimps prems) 1);
   2.130 -qed "isubE";
   2.131 -
   2.132 -Goalw [isub_def] "isub(D,X,x) ==> x \\<in> set(D)";
   2.133 -by (Asm_simp_tac 1);
   2.134 -qed "isubD1";
   2.135 -
   2.136 -Goalw [isub_def] "[|isub(D,X,x); n \\<in> nat|]==>rel(D,X`n,x)";
   2.137 -by (Asm_simp_tac 1);
   2.138 -qed "isubD2";
   2.139 -
   2.140 -Goal "[|islub(D,X,x); islub(D,X,y); cpo(D)|] ==> x = y";
   2.141 -by (blast_tac (claset() addIs [cpo_antisym,islub_least,
   2.142 -                               islub_isub,islub_in]) 1);
   2.143 -qed "islub_unique";
   2.144 -
   2.145 -(*----------------------------------------------------------------------*)
   2.146 -(* lub gives the least upper bound of chains.                           *)
   2.147 -(*----------------------------------------------------------------------*)
   2.148 -
   2.149 -Goalw [lub_def] "[|chain(D,X); cpo(D)|] ==> islub(D,X,lub(D,X))";
   2.150 -by (best_tac (claset() addEs [cpo_islub] addIs [theI, islub_unique]) 1);
   2.151 -qed "cpo_lub";
   2.152 -
   2.153 -(*----------------------------------------------------------------------*)
   2.154 -(* Theorems about chains.                                               *)
   2.155 -(*----------------------------------------------------------------------*)
   2.156 -
   2.157 -val prems = Goalw [chain_def]
   2.158 - "[|X \\<in> nat->set(D);  !!n. n \\<in> nat ==> rel(D,X`n,X`succ(n))|] ==> chain(D,X)";
   2.159 -by (blast_tac (claset() addIs prems) 1);
   2.160 -qed "chainI";
   2.161 -
   2.162 -Goalw [chain_def] "chain(D,X) ==> X \\<in> nat -> set(D)";
   2.163 -by (Asm_simp_tac 1);
   2.164 -qed "chain_fun";
   2.165 -
   2.166 -Goalw [chain_def] "[|chain(D,X); n \\<in> nat|] ==> X`n \\<in> set(D)";
   2.167 -by (blast_tac (claset() addDs [apply_type]) 1);
   2.168 -qed "chain_in";
   2.169 -
   2.170 -Goalw [chain_def] "[|chain(D,X); n \\<in> nat|] ==> rel(D, X ` n, X ` succ(n))";
   2.171 -by (Blast_tac 1);
   2.172 -qed "chain_rel";
   2.173 -
   2.174 -Addsimps [chain_in, chain_rel];
   2.175 -AddTCs   [chain_fun, chain_in, chain_rel];
   2.176 -
   2.177 -Goal "[|chain(D,X); cpo(D); n \\<in> nat; m \\<in> nat|] ==> rel(D,X`n,(X`(m #+ n)))";
   2.178 -by (induct_tac "m" 1);
   2.179 -by (auto_tac (claset() addIs [cpo_trans], simpset()));  
   2.180 -qed "chain_rel_gen_add";
   2.181 -
   2.182 -Goal  (* chain_rel_gen *)
   2.183 -    "[|n le m; chain(D,X); cpo(D); m \\<in> nat|] ==> rel(D,X`n,X`m)";
   2.184 -by (ftac lt_nat_in_nat 1 THEN etac nat_succI 1);
   2.185 -by (etac rev_mp 1);  (*prepare the induction*)
   2.186 -by (induct_tac "m" 1);
   2.187 -by (auto_tac (claset() addIs [cpo_trans],
   2.188 -	      simpset() addsimps [le_iff]));
   2.189 -qed "chain_rel_gen";
   2.190 -
   2.191 -(*----------------------------------------------------------------------*)
   2.192 -(* Theorems about pcpos and bottom.                                     *)
   2.193 -(*----------------------------------------------------------------------*)
   2.194 -
   2.195 -val prems = Goalw [pcpo_def]  (* pcpoI *)
   2.196 -    "[|!!y. y \\<in> set(D)==>rel(D,x,y); x \\<in> set(D); cpo(D)|]==>pcpo(D)";
   2.197 -by (auto_tac (claset() addIs prems, simpset()));
   2.198 -qed "pcpoI";
   2.199 -
   2.200 -Goalw [pcpo_def] "pcpo(D) ==> cpo(D)";
   2.201 -by (etac conjunct1 1);
   2.202 -qed "pcpo_cpo";
   2.203 -
   2.204 -Goalw [pcpo_def] (* pcpo_bot_ex1 *)
   2.205 -    "pcpo(D) ==> \\<exists>! x. x \\<in> set(D) & (\\<forall>y \\<in> set(D). rel(D,x,y))";
   2.206 -by (blast_tac (claset() addIs [cpo_antisym]) 1);
   2.207 -qed "pcpo_bot_ex1";
   2.208 -
   2.209 -Goalw [bot_def] (* bot_least *)
   2.210 -    "[| pcpo(D); y \\<in> set(D)|] ==> rel(D,bot(D),y)";
   2.211 -by (best_tac (claset() addIs [pcpo_bot_ex1 RS theI2]) 1);
   2.212 -qed "bot_least";
   2.213 -
   2.214 -Goalw [bot_def] (* bot_in *)
   2.215 -    "pcpo(D) ==> bot(D):set(D)";
   2.216 -by (best_tac (claset() addIs [pcpo_bot_ex1 RS theI2]) 1);
   2.217 -qed "bot_in";
   2.218 -
   2.219 -AddTCs [pcpo_cpo, bot_least, bot_in];
   2.220 -
   2.221 -val prems = Goal  (* bot_unique *)
   2.222 -    "[| pcpo(D); x \\<in> set(D); !!y. y \\<in> set(D) ==> rel(D,x,y)|] ==> x = bot(D)";
   2.223 -by (blast_tac (claset() addIs ([cpo_antisym,pcpo_cpo,bot_in,bot_least]@
   2.224 -                               prems)) 1);
   2.225 -qed "bot_unique";
   2.226 -
   2.227 -(*----------------------------------------------------------------------*)
   2.228 -(* Constant chains and lubs and cpos.                                   *)
   2.229 -(*----------------------------------------------------------------------*)
   2.230 -
   2.231 -Goalw [chain_def] "[|x \\<in> set(D); cpo(D)|] ==> chain(D,(\\<lambda>n \\<in> nat. x))";
   2.232 -by (asm_simp_tac (simpset() addsimps [lam_type, nat_succI]) 1);
   2.233 -qed "chain_const";
   2.234 -
   2.235 -Goalw [islub_def,isub_def] 
   2.236 -   "[|x \\<in> set(D); cpo(D)|] ==> islub(D,(\\<lambda>n \\<in> nat. x),x)";
   2.237 -by (Asm_simp_tac 1);
   2.238 -by (Blast_tac 1);
   2.239 -qed "islub_const";
   2.240 -
   2.241 -Goal "[|x \\<in> set(D); cpo(D)|] ==> lub(D,\\<lambda>n \\<in> nat. x) = x";
   2.242 -by (blast_tac (claset() addIs [islub_unique, cpo_lub,
   2.243 -			       chain_const, islub_const]) 1);
   2.244 -qed "lub_const";
   2.245 -
   2.246 -(*----------------------------------------------------------------------*)
   2.247 -(* Taking the suffix of chains has no effect on ub's.                   *) 
   2.248 -(*----------------------------------------------------------------------*)
   2.249 -
   2.250 -Goalw [isub_def,suffix_def]  (* isub_suffix *)
   2.251 -    "[| chain(D,X); cpo(D) |] ==> isub(D,suffix(X,n),x) <-> isub(D,X,x)";
   2.252 -by Safe_tac;
   2.253 -by (dres_inst_tac [("x","na")] bspec 1);
   2.254 -by (auto_tac (claset() addIs [cpo_trans, chain_rel_gen_add], simpset()));
   2.255 -qed "isub_suffix";
   2.256 -
   2.257 -Goalw [islub_def]  (* islub_suffix *)
   2.258 -  "[|chain(D,X); cpo(D)|] ==> islub(D,suffix(X,n),x) <-> islub(D,X,x)";
   2.259 -by (asm_simp_tac (simpset() addsimps [isub_suffix]) 1);
   2.260 -qed "islub_suffix";
   2.261 -
   2.262 -Goalw [lub_def]  (* lub_suffix *)
   2.263 -    "[|chain(D,X); cpo(D)|] ==> lub(D,suffix(X,n)) = lub(D,X)";
   2.264 -by (asm_simp_tac (simpset() addsimps [islub_suffix]) 1);
   2.265 -qed "lub_suffix";
   2.266 -
   2.267 -(*----------------------------------------------------------------------*)
   2.268 -(* Dominate and subchain.                                               *) 
   2.269 -(*----------------------------------------------------------------------*)
   2.270 -
   2.271 -val prems = Goalw [dominate_def]
   2.272 -  "[| !!m. m \\<in> nat ==> n(m):nat; !!m. m \\<in> nat ==> rel(D,X`m,Y`n(m))|] ==>   \
   2.273 -\  dominate(D,X,Y)";
   2.274 -by (blast_tac (claset() addIs prems) 1);
   2.275 -qed "dominateI"; 
   2.276 -
   2.277 -Goalw [isub_def, dominate_def]
   2.278 -  "[|dominate(D,X,Y); isub(D,Y,x); cpo(D);  \
   2.279 -\    X \\<in> nat->set(D); Y \\<in> nat->set(D)|] ==> isub(D,X,x)";
   2.280 -by (Asm_full_simp_tac 1);  
   2.281 -by (blast_tac (claset() addIs [cpo_trans] addSIs [apply_funtype]) 1);
   2.282 -qed "dominate_isub";
   2.283 -
   2.284 -Goalw [islub_def]
   2.285 -  "[|dominate(D,X,Y); islub(D,X,x); islub(D,Y,y); cpo(D);  \
   2.286 -\    X \\<in> nat->set(D); Y \\<in> nat->set(D)|] ==> rel(D,x,y)";
   2.287 -by (blast_tac (claset() addIs [dominate_isub]) 1);
   2.288 -qed "dominate_islub";
   2.289 -
   2.290 -Goalw [isub_def, subchain_def]
   2.291 -     "[|subchain(Y,X); isub(D,X,x)|] ==> isub(D,Y,x)";
   2.292 -by (Force_tac 1);
   2.293 -qed "subchain_isub";
   2.294 -
   2.295 -Goal "[|dominate(D,X,Y); subchain(Y,X); islub(D,X,x); islub(D,Y,y); cpo(D);  \
   2.296 -\    X \\<in> nat->set(D); Y \\<in> nat->set(D)|] ==> x = y";
   2.297 -by (blast_tac (claset() addIs [cpo_antisym, dominate_islub, islub_least,
   2.298 -			       subchain_isub, islub_isub, islub_in]) 1);
   2.299 -qed "dominate_islub_eq";
   2.300 -
   2.301 -(*----------------------------------------------------------------------*)
   2.302 -(* Matrix.                                                              *) 
   2.303 -(*----------------------------------------------------------------------*)
   2.304 -
   2.305 -Goalw [matrix_def]  (* matrix_fun *)
   2.306 -    "matrix(D,M) ==> M \\<in> nat -> (nat -> set(D))";
   2.307 -by (Asm_simp_tac 1);
   2.308 -qed "matrix_fun";
   2.309 -
   2.310 -Goal "[|matrix(D,M); n \\<in> nat|] ==> M`n \\<in> nat -> set(D)";
   2.311 -by (blast_tac (claset() addIs [apply_funtype, matrix_fun]) 1);
   2.312 -qed "matrix_in_fun";
   2.313 -
   2.314 -Goal "[|matrix(D,M); n \\<in> nat; m \\<in> nat|] ==> M`n`m \\<in> set(D)";
   2.315 -by (blast_tac (claset() addIs [apply_funtype, matrix_in_fun]) 1);
   2.316 -qed "matrix_in";
   2.317 -
   2.318 -Goalw [matrix_def]  (* matrix_rel_1_0 *)
   2.319 -    "[|matrix(D,M); n \\<in> nat; m \\<in> nat|] ==> rel(D,M`n`m,M`succ(n)`m)";
   2.320 -by (Asm_simp_tac 1);
   2.321 -qed "matrix_rel_1_0";
   2.322 -
   2.323 -Goalw [matrix_def]  (* matrix_rel_0_1 *)
   2.324 -    "[|matrix(D,M); n \\<in> nat; m \\<in> nat|] ==> rel(D,M`n`m,M`n`succ(m))";
   2.325 -by (Asm_simp_tac 1);
   2.326 -qed "matrix_rel_0_1";
   2.327 -
   2.328 -Goalw [matrix_def]  (* matrix_rel_1_1 *)
   2.329 -    "[|matrix(D,M); n \\<in> nat; m \\<in> nat|] ==> rel(D,M`n`m,M`succ(n)`succ(m))";
   2.330 -by (Asm_simp_tac 1);
   2.331 -qed "matrix_rel_1_1";
   2.332 -
   2.333 -Goal "f \\<in> X->Y->Z ==> (\\<lambda>y \\<in> Y. \\<lambda>x \\<in> X. f`x`y):Y->X->Z";
   2.334 -by (blast_tac (claset() addIs [lam_type, apply_funtype]) 1);
   2.335 -qed "fun_swap";
   2.336 -
   2.337 -Goalw [matrix_def]  (* matrix_sym_axis *)
   2.338 -    "matrix(D,M) ==> matrix(D,\\<lambda>m \\<in> nat. \\<lambda>n \\<in> nat. M`n`m)";
   2.339 -by (asm_simp_tac (simpset() addsimps [fun_swap]) 1);
   2.340 -qed "matrix_sym_axis";
   2.341 -
   2.342 -Goalw [chain_def]  (* matrix_chain_diag *)
   2.343 -    "matrix(D,M) ==> chain(D,\\<lambda>n \\<in> nat. M`n`n)";
   2.344 -by (auto_tac (claset() addIs [lam_type, matrix_in, matrix_rel_1_1], 
   2.345 -              simpset()));
   2.346 -qed "matrix_chain_diag";
   2.347 -
   2.348 -Goalw [chain_def]  (* matrix_chain_left *)
   2.349 -    "[|matrix(D,M); n \\<in> nat|] ==> chain(D,M`n)";
   2.350 -by (auto_tac (claset() addIs [matrix_fun RS apply_type, matrix_in, 
   2.351 -                              matrix_rel_0_1],   simpset()));
   2.352 -qed "matrix_chain_left";
   2.353 -
   2.354 -Goalw [chain_def]  (* matrix_chain_right *)
   2.355 -    "[|matrix(D,M); m \\<in> nat|] ==> chain(D,\\<lambda>n \\<in> nat. M`n`m)";
   2.356 -by (auto_tac (claset() addIs [lam_type,matrix_in,matrix_rel_1_0],
   2.357 -	      simpset()));
   2.358 -qed "matrix_chain_right";
   2.359 -
   2.360 -val xprem::yprem::prems = Goalw [matrix_def]  (* matrix_chainI *)
   2.361 -    "[|!!x. x \\<in> nat==>chain(D,M`x);  !!y. y \\<in> nat==>chain(D,\\<lambda>x \\<in> nat. M`x`y);   \
   2.362 -\      M \\<in> nat->nat->set(D); cpo(D)|] ==> matrix(D,M)";
   2.363 -by Safe_tac;
   2.364 -by (cut_inst_tac[("y1","m"),("n","n")] (yprem RS chain_rel) 2);
   2.365 -by (Asm_full_simp_tac 4);
   2.366 -by (rtac cpo_trans 5);
   2.367 -by (cut_inst_tac[("y1","m"),("n","n")] (yprem RS chain_rel) 6);
   2.368 -by (Asm_full_simp_tac 8);
   2.369 -by (typecheck_tac (tcset() addTCs (chain_fun RS apply_type)::
   2.370 -		                  xprem::yprem::prems));
   2.371 -qed "matrix_chainI";
   2.372 -
   2.373 -Goal "[|m \\<in> nat; rel(D, (\\<lambda>n \\<in> nat. M`n`n)`m, y)|] ==> rel(D,M`m`m, y)";
   2.374 -by (Asm_full_simp_tac 1);
   2.375 -qed "lemma";
   2.376 -
   2.377 -Goal "[|x \\<in> nat; m \\<in> nat; rel(D,(\\<lambda>n \\<in> nat. M`n`m1)`x,(\\<lambda>n \\<in> nat. M`n`m1)`m)|] \
   2.378 -\     ==> rel(D,M`x`m1,M`m`m1)";
   2.379 -by (Asm_full_simp_tac 1);
   2.380 -qed "lemma2";
   2.381 -
   2.382 -Goalw [isub_def]  (* isub_lemma *)
   2.383 -    "[|isub(D, \\<lambda>n \\<in> nat. M`n`n, y); matrix(D,M); cpo(D)|] ==>  \
   2.384 -\    isub(D, \\<lambda>n \\<in> nat. lub(D,\\<lambda>m \\<in> nat. M`n`m), y)";
   2.385 -by Safe_tac;
   2.386 -by (Asm_simp_tac 1);
   2.387 -by (forward_tac [matrix_fun RS apply_type] 1);
   2.388 -by (assume_tac 1);
   2.389 -by (Asm_simp_tac 1);
   2.390 -by (rtac (matrix_chain_left RS cpo_lub RS islub_least) 1);
   2.391 -by (REPEAT (assume_tac 1));
   2.392 -by (rewtac isub_def);
   2.393 -by Safe_tac;
   2.394 -by (excluded_middle_tac "n le na" 1);
   2.395 -by (rtac cpo_trans 1);
   2.396 -by (assume_tac 1);
   2.397 -by (rtac (not_le_iff_lt RS iffD1 RS leI RS chain_rel_gen) 1);
   2.398 -by (assume_tac 3);
   2.399 -by (REPEAT(ares_tac [nat_into_Ord,matrix_chain_left] 1));
   2.400 -by (rtac lemma 1);
   2.401 -by (assume_tac 1);
   2.402 -by (Blast_tac 1);
   2.403 -by (REPEAT(ares_tac [matrix_in] 1));
   2.404 -by (rtac cpo_trans 1);
   2.405 -by (assume_tac 1);
   2.406 -by (rtac lemma2 1);
   2.407 -by (rtac lemma 4);
   2.408 -by (Blast_tac 5);
   2.409 -by (REPEAT(ares_tac [chain_rel_gen,matrix_chain_right,matrix_in,isubD1] 1));
   2.410 -qed "isub_lemma";
   2.411 -
   2.412 -Goalw [chain_def]  (* matrix_chain_lub *)
   2.413 -    "[|matrix(D,M); cpo(D)|] ==> chain(D,\\<lambda>n \\<in> nat. lub(D,\\<lambda>m \\<in> nat. M`n`m))";
   2.414 -by Safe_tac;
   2.415 -by (rtac lam_type 1);
   2.416 -by (rtac islub_in 1);
   2.417 -by (rtac cpo_lub 1);
   2.418 -by (assume_tac 2);
   2.419 -by (Asm_simp_tac 2);
   2.420 -by (rtac chainI 1);
   2.421 -by (rtac lam_type 1);
   2.422 -by (REPEAT(ares_tac [matrix_in] 1));
   2.423 -by (Asm_simp_tac 1);
   2.424 -by (rtac matrix_rel_0_1 1);
   2.425 -by (REPEAT(assume_tac 1));
   2.426 -by (asm_simp_tac (simpset() addsimps 
   2.427 -		  [matrix_chain_left RS chain_fun RS eta]) 1);
   2.428 -by (rtac dominate_islub 1);
   2.429 -by (rtac cpo_lub 3);
   2.430 -by (rtac cpo_lub 2);
   2.431 -by (rewtac dominate_def);
   2.432 -by (REPEAT(ares_tac [matrix_chain_left,nat_succI,chain_fun] 2));
   2.433 -by (blast_tac (claset() addIs [matrix_rel_1_0]) 1);
   2.434 -qed "matrix_chain_lub";
   2.435 -
   2.436 -Goal  (* isub_eq *)
   2.437 -    "[|matrix(D,M); cpo(D)|] ==>  \
   2.438 -\    isub(D,(\\<lambda>n \\<in> nat. lub(D,\\<lambda>m \\<in> nat. M`n`m)),y) <->  \
   2.439 -\    isub(D,(\\<lambda>n \\<in> nat. M`n`n),y)";
   2.440 -by (rtac iffI 1);
   2.441 -by (rtac dominate_isub 1);
   2.442 -by (assume_tac 2);
   2.443 -by (rewtac dominate_def);
   2.444 -by (rtac ballI 1);
   2.445 -by (rtac bexI 1);
   2.446 -by Auto_tac;  
   2.447 -by (asm_simp_tac (simpset() addsimps 
   2.448 -		  [matrix_chain_left RS chain_fun RS eta]) 1);
   2.449 -by (rtac islub_ub 1);
   2.450 -by (rtac cpo_lub 1);
   2.451 -by (REPEAT(ares_tac [matrix_chain_left,matrix_chain_diag,chain_fun,
   2.452 -                     matrix_chain_lub, isub_lemma] 1));
   2.453 -qed "isub_eq";
   2.454 -
   2.455 -Goalw [lub_def]  
   2.456 -    "lub(D,(\\<lambda>n \\<in> nat. lub(D,\\<lambda>m \\<in> nat. M`n`m))) =   \
   2.457 -\    (THE x. islub(D, (\\<lambda>n \\<in> nat. lub(D,\\<lambda>m \\<in> nat. M`n`m)), x))";
   2.458 -by (Blast_tac 1);
   2.459 -qed "lemma1";
   2.460 -
   2.461 -Goalw [lub_def]  
   2.462 -    "lub(D,(\\<lambda>n \\<in> nat. M`n`n)) =   \
   2.463 -\    (THE x. islub(D, (\\<lambda>n \\<in> nat. M`n`n), x))";
   2.464 -by (Blast_tac 1);
   2.465 -qed "lemma2";
   2.466 -
   2.467 -Goal  (* lub_matrix_diag *)
   2.468 -    "[|matrix(D,M); cpo(D)|] ==>  \
   2.469 -\    lub(D,(\\<lambda>n \\<in> nat. lub(D,\\<lambda>m \\<in> nat. M`n`m))) =  \
   2.470 -\    lub(D,(\\<lambda>n \\<in> nat. M`n`n))";
   2.471 -by (simp_tac (simpset() addsimps [lemma1,lemma2]) 1);
   2.472 -by (asm_simp_tac (simpset() addsimps [islub_def, isub_eq]) 1);
   2.473 -qed "lub_matrix_diag";
   2.474 -
   2.475 -Goal  (* lub_matrix_diag_sym *)
   2.476 -    "[|matrix(D,M); cpo(D)|] ==>  \
   2.477 -\    lub(D,(\\<lambda>m \\<in> nat. lub(D,\\<lambda>n \\<in> nat. M`n`m))) =  \
   2.478 -\    lub(D,(\\<lambda>n \\<in> nat. M`n`n))";
   2.479 -by (dtac (matrix_sym_axis RS lub_matrix_diag) 1);
   2.480 -by Auto_tac;
   2.481 -qed "lub_matrix_diag_sym";
   2.482 -
   2.483 -(*----------------------------------------------------------------------*)
   2.484 -(* I/E/D rules for mono and cont.                                       *)
   2.485 -(*----------------------------------------------------------------------*)
   2.486 -
   2.487 -val prems = Goalw [mono_def]  (* monoI *)
   2.488 -    "[|f \\<in> set(D)->set(E);   \
   2.489 -\      !!x y. [|rel(D,x,y); x \\<in> set(D); y \\<in> set(D)|] ==> rel(E,f`x,f`y)|] ==>   \
   2.490 -\     f \\<in> mono(D,E)";
   2.491 -by (blast_tac(claset() addSIs prems) 1);
   2.492 -qed "monoI";
   2.493 -
   2.494 -Goalw [mono_def] "f \\<in> mono(D,E) ==> f \\<in> set(D)->set(E)";
   2.495 -by (Fast_tac 1);
   2.496 -qed "mono_fun";
   2.497 -
   2.498 -Goal "[|f \\<in> mono(D,E); x \\<in> set(D)|] ==> f`x \\<in> set(E)";
   2.499 -by (blast_tac(claset() addSIs [mono_fun RS apply_type]) 1);
   2.500 -qed "mono_map";
   2.501 -
   2.502 -Goalw [mono_def]
   2.503 -    "[|f \\<in> mono(D,E); rel(D,x,y); x \\<in> set(D); y \\<in> set(D)|] ==> rel(E,f`x,f`y)";
   2.504 -by (Blast_tac 1);
   2.505 -qed "mono_mono";
   2.506 -
   2.507 -val prems = Goalw [cont_def,mono_def]  (* contI *)
   2.508 -    "[|f \\<in> set(D)->set(E);   \
   2.509 -\      !!x y. [|rel(D,x,y); x \\<in> set(D); y \\<in> set(D)|] ==> rel(E,f`x,f`y);   \
   2.510 -\      !!X. chain(D,X) ==> f`lub(D,X) = lub(E,\\<lambda>n \\<in> nat. f`(X`n))|] ==>   \
   2.511 -\     f \\<in> cont(D,E)";
   2.512 -by (fast_tac(claset() addSIs prems) 1);
   2.513 -qed "contI";
   2.514 -
   2.515 -Goalw [cont_def] "f \\<in> cont(D,E) ==> f \\<in> mono(D,E)";
   2.516 -by (Blast_tac 1);
   2.517 -qed "cont2mono";
   2.518 -
   2.519 -Goalw [cont_def] "f \\<in> cont(D,E) ==> f \\<in> set(D)->set(E)";
   2.520 -by (rtac mono_fun 1);
   2.521 -by (Blast_tac 1);
   2.522 -qed "cont_fun";
   2.523 -
   2.524 -Goal "[|f \\<in> cont(D,E); x \\<in> set(D)|] ==> f`x \\<in> set(E)";
   2.525 -by (blast_tac(claset() addSIs [cont_fun RS apply_type]) 1);
   2.526 -qed "cont_map";
   2.527 -
   2.528 -AddTCs [comp_fun, cont_fun, cont_map];
   2.529 -
   2.530 -Goalw [cont_def]
   2.531 -    "[|f \\<in> cont(D,E); rel(D,x,y); x \\<in> set(D); y \\<in> set(D)|] ==> rel(E,f`x,f`y)";
   2.532 -by (blast_tac(claset() addSIs [mono_mono]) 1);
   2.533 -qed "cont_mono";
   2.534 -
   2.535 -Goalw [cont_def]
   2.536 -    "[|f \\<in> cont(D,E); chain(D,X)|] ==> f`(lub(D,X)) = lub(E,\\<lambda>n \\<in> nat. f`(X`n))";
   2.537 -by (Blast_tac 1);
   2.538 -qed "cont_lub";
   2.539 -
   2.540 -(*----------------------------------------------------------------------*)
   2.541 -(* Continuity and chains.                                               *) 
   2.542 -(*----------------------------------------------------------------------*)
   2.543 -
   2.544 -Goal "[|f \\<in> mono(D,E); chain(D,X)|] ==> chain(E,\\<lambda>n \\<in> nat. f`(X`n))";
   2.545 -by (simp_tac (simpset() addsimps [chain_def]) 1);
   2.546 -by (blast_tac(claset() addIs [lam_type, mono_map, chain_in, 
   2.547 -			      mono_mono, chain_rel]) 1);
   2.548 -qed "mono_chain";
   2.549 -
   2.550 -Goal "[|f \\<in> cont(D,E); chain(D,X)|] ==> chain(E,\\<lambda>n \\<in> nat. f`(X`n))";
   2.551 -by (blast_tac(claset() addIs [mono_chain, cont2mono]) 1);
   2.552 -qed "cont_chain";
   2.553 -
   2.554 -(*----------------------------------------------------------------------*)
   2.555 -(* I/E/D rules about (set+rel) cf, the continuous function space.       *)
   2.556 -(*----------------------------------------------------------------------*)
   2.557 -
   2.558 -(* The following development more difficult with cpo-as-relation approach. *)
   2.559 -
   2.560 -Goalw [set_def,cf_def] "f \\<in> set(cf(D,E)) ==> f \\<in> cont(D,E)";
   2.561 -by (Asm_full_simp_tac 1);
   2.562 -qed "cf_cont";
   2.563 -
   2.564 -Goalw [set_def,cf_def]  (* Non-trivial with relation *)
   2.565 -    "f \\<in> cont(D,E) ==> f \\<in> set(cf(D,E))";
   2.566 -by (Asm_full_simp_tac 1);
   2.567 -qed "cont_cf";
   2.568 -
   2.569 -(* rel_cf originally an equality. Now stated as two rules. Seemed easiest. 
   2.570 -   Besides, now complicated by typing assumptions. *)
   2.571 -
   2.572 -val prems = Goal
   2.573 -    "[|!!x. x \\<in> set(D) ==> rel(E,f`x,g`x); f \\<in> cont(D,E); g \\<in> cont(D,E)|] ==> \
   2.574 -\    rel(cf(D,E),f,g)";
   2.575 -by (asm_simp_tac (simpset() addsimps [rel_I, cf_def]@prems) 1);
   2.576 -qed "rel_cfI";
   2.577 -
   2.578 -Goalw [rel_def,cf_def] "[|rel(cf(D,E),f,g); x \\<in> set(D)|] ==> rel(E,f`x,g`x)";
   2.579 -by (Asm_full_simp_tac 1);
   2.580 -qed "rel_cf";
   2.581 -
   2.582 -(*----------------------------------------------------------------------*)
   2.583 -(* Theorems about the continuous function space.                        *)
   2.584 -(*----------------------------------------------------------------------*)
   2.585 -
   2.586 -Goal  (* chain_cf *)
   2.587 -    "[| chain(cf(D,E),X); x \\<in> set(D)|] ==> chain(E,\\<lambda>n \\<in> nat. X`n`x)";
   2.588 -by (rtac chainI 1);
   2.589 -by (blast_tac (claset() addIs [lam_type, apply_funtype, cont_fun,
   2.590 -                               cf_cont,chain_in]) 1);
   2.591 -by (Asm_simp_tac 1);
   2.592 -by (blast_tac (claset() addIs [rel_cf,chain_rel]) 1);
   2.593 -qed "chain_cf";
   2.594 -
   2.595 -Goal  (* matrix_lemma *)
   2.596 -    "[|chain(cf(D,E),X); chain(D,Xa); cpo(D); cpo(E) |] ==>   \
   2.597 -\    matrix(E,\\<lambda>x \\<in> nat. \\<lambda>xa \\<in> nat. X`x`(Xa`xa))";
   2.598 -by (rtac matrix_chainI 1);
   2.599 -by Auto_tac;  
   2.600 -by (rtac chainI 1);
   2.601 -by (blast_tac (claset() addIs [lam_type, apply_funtype, cont_fun,
   2.602 -                               cf_cont,chain_in]) 1);
   2.603 -by (Asm_simp_tac 1);
   2.604 -by (blast_tac (claset() addIs [cont_mono, nat_succI, chain_rel,
   2.605 -                               cf_cont,chain_in]) 1);
   2.606 -by (rtac chainI 1);
   2.607 -by (blast_tac (claset() addIs [lam_type, apply_funtype, cont_fun,
   2.608 -                               cf_cont,chain_in]) 1);
   2.609 -by (Asm_simp_tac 1);
   2.610 -by (rtac rel_cf 1);
   2.611 -brr [chain_in,chain_rel] 1;
   2.612 -by (blast_tac (claset() addIs [lam_type, apply_funtype, cont_fun,
   2.613 -                               cf_cont,chain_in]) 1);
   2.614 -qed "matrix_lemma";
   2.615 -
   2.616 -Goal  (* chain_cf_lub_cont *)
   2.617 -    "[|chain(cf(D,E),X); cpo(D); cpo(E) |] ==> \
   2.618 -\    (\\<lambda>x \\<in> set(D). lub(E, \\<lambda>n \\<in> nat. X ` n ` x)) \\<in> cont(D, E)";
   2.619 -by (rtac contI 1);
   2.620 -by (rtac lam_type 1);
   2.621 -by (REPEAT(ares_tac[chain_cf RS cpo_lub RS islub_in] 1));
   2.622 -by (Asm_simp_tac 1);
   2.623 -by (rtac dominate_islub 1);
   2.624 -by (REPEAT(ares_tac[chain_cf RS cpo_lub] 2));
   2.625 -by (rtac dominateI 1);
   2.626 -by (assume_tac 1);
   2.627 -by (Asm_simp_tac 1);
   2.628 -by (REPEAT(ares_tac [chain_in RS cf_cont RS cont_mono] 1));
   2.629 -by (REPEAT(ares_tac [chain_cf RS chain_fun] 1));
   2.630 -by (stac beta 1);
   2.631 -by (REPEAT(ares_tac [cpo_lub RS islub_in] 1));
   2.632 -by (asm_simp_tac(simpset() addsimps[chain_in RS cf_cont RS cont_lub]) 1);
   2.633 -by (forward_tac[matrix_lemma RS lub_matrix_diag]1);
   2.634 -by (REPEAT (assume_tac 1));
   2.635 -by (asm_full_simp_tac(simpset() addsimps[chain_in RS beta]) 1);
   2.636 -by (dtac (matrix_lemma RS lub_matrix_diag_sym) 1);
   2.637 -by Auto_tac;
   2.638 -qed "chain_cf_lub_cont";
   2.639 -
   2.640 -Goal  (* islub_cf *)
   2.641 -    "[| chain(cf(D,E),X); cpo(D); cpo(E)|] ==>   \
   2.642 -\     islub(cf(D,E), X, \\<lambda>x \\<in> set(D). lub(E,\\<lambda>n \\<in> nat. X`n`x))";
   2.643 -by (rtac islubI 1);
   2.644 -by (rtac isubI 1);
   2.645 -by (rtac (chain_cf_lub_cont RS cont_cf) 1);
   2.646 -by (REPEAT (assume_tac 1));
   2.647 -by (rtac rel_cfI 1);
   2.648 -by (fast_tac (claset() addSDs [chain_cf RS cpo_lub RS islub_ub]
   2.649 -                       addss simpset()) 1);
   2.650 -by (blast_tac (claset() addIs [cf_cont,chain_in]) 1);
   2.651 -by (blast_tac (claset() addIs [cont_cf,chain_cf_lub_cont]) 1);
   2.652 -by (rtac rel_cfI 1);
   2.653 -by (Asm_simp_tac 1);
   2.654 -by (REPEAT (blast_tac (claset() addIs [chain_cf_lub_cont,isubD1,cf_cont]) 2));
   2.655 -by (best_tac (claset() addIs [chain_cf RS cpo_lub RS islub_least,
   2.656 -			      cf_cont RS cont_fun RS apply_type, isubI]
   2.657 -		       addEs [isubD2 RS rel_cf, isubD1]
   2.658 -                       addss simpset()) 1);
   2.659 -qed "islub_cf";
   2.660 -
   2.661 -Goal  (* cpo_cf *)
   2.662 -    "[| cpo(D); cpo(E)|] ==> cpo(cf(D,E))";
   2.663 -by (rtac (poI RS cpoI) 1);
   2.664 -by (rtac rel_cfI 1);
   2.665 -brr[cpo_refl, cf_cont RS cont_fun RS apply_type, cf_cont] 1;
   2.666 -by (rtac rel_cfI 1);
   2.667 -by (rtac cpo_trans 1);
   2.668 -by (assume_tac 1);
   2.669 -by (etac rel_cf 1);
   2.670 -by (assume_tac 1);
   2.671 -by (rtac rel_cf 1);
   2.672 -by (assume_tac 1);
   2.673 -brr[cf_cont RS cont_fun RS apply_type,cf_cont]1;
   2.674 -by (rtac fun_extension 1);
   2.675 -brr[cf_cont RS cont_fun]1;
   2.676 -by (fast_tac (claset() addIs [islub_cf]) 2);
   2.677 -by (blast_tac (claset() addIs [cpo_antisym,rel_cf,
   2.678 -			       cf_cont RS cont_fun RS apply_type]) 1);
   2.679 -
   2.680 -qed "cpo_cf";
   2.681 -
   2.682 -AddTCs [cpo_cf];
   2.683 -
   2.684 -Goal "[| chain(cf(D,E),X); cpo(D); cpo(E)|] ==>   \
   2.685 -\     lub(cf(D,E), X) = (\\<lambda>x \\<in> set(D). lub(E,\\<lambda>n \\<in> nat. X`n`x))";
   2.686 -by (blast_tac (claset() addIs [islub_unique,cpo_lub,islub_cf,cpo_cf]) 1);
   2.687 -qed "lub_cf";
   2.688 -
   2.689 -Goal "[|y \\<in> set(E); cpo(D); cpo(E)|] ==> (\\<lambda>x \\<in> set(D).y) \\<in> cont(D,E)";
   2.690 -by (rtac contI 1);
   2.691 -by (Asm_simp_tac 2);
   2.692 -by (blast_tac (claset() addIs [lam_type]) 1);
   2.693 -by (asm_simp_tac(simpset() addsimps [chain_in, cpo_lub RS islub_in,
   2.694 -				     lub_const]) 1);
   2.695 -qed "const_cont";
   2.696 -
   2.697 -Goal "[|cpo(D); pcpo(E); y \\<in> cont(D,E)|]==>rel(cf(D,E),(\\<lambda>x \\<in> set(D).bot(E)),y)";
   2.698 -by (rtac rel_cfI 1);
   2.699 -by (Asm_simp_tac 1);
   2.700 -by (ALLGOALS (type_solver_tac (tcset() addTCs [cont_fun, const_cont]) []));
   2.701 -qed "cf_least";
   2.702 -
   2.703 -Goal  (* pcpo_cf *)
   2.704 -    "[|cpo(D); pcpo(E)|] ==> pcpo(cf(D,E))";
   2.705 -by (rtac pcpoI 1);
   2.706 -brr[cf_least, bot_in, const_cont RS cont_cf, cf_cont, cpo_cf, pcpo_cpo] 1;
   2.707 -qed "pcpo_cf";
   2.708 -
   2.709 -Goal  (* bot_cf *)
   2.710 -    "[|cpo(D); pcpo(E)|] ==> bot(cf(D,E)) = (\\<lambda>x \\<in> set(D).bot(E))";
   2.711 -by (blast_tac (claset() addIs [bot_unique RS sym, pcpo_cf, cf_least, 
   2.712 -                   bot_in RS const_cont RS cont_cf, cf_cont, pcpo_cpo])1);
   2.713 -qed "bot_cf";
   2.714 -
   2.715 -(*----------------------------------------------------------------------*)
   2.716 -(* Identity and composition.                                            *)
   2.717 -(*----------------------------------------------------------------------*)
   2.718 -
   2.719 -Goal  (* id_cont *)
   2.720 -    "cpo(D) ==> id(set(D)):cont(D,D)";
   2.721 -by (asm_simp_tac(simpset() addsimps[id_type, contI, cpo_lub RS islub_in, 
   2.722 -				    chain_fun RS eta]) 1);
   2.723 -qed "id_cont";
   2.724 -
   2.725 -AddTCs [id_cont];
   2.726 -
   2.727 -val comp_cont_apply = cont_fun RSN(2,cont_fun RS comp_fun_apply);
   2.728 -
   2.729 -Goal  (* comp_pres_cont *)
   2.730 -    "[| f \\<in> cont(D',E); g \\<in> cont(D,D'); cpo(D)|] ==> f O g \\<in> cont(D,E)";
   2.731 -by (rtac contI 1);
   2.732 -by (stac comp_cont_apply 2);
   2.733 -by (stac comp_cont_apply 5);
   2.734 -by (rtac cont_mono 8);
   2.735 -by (rtac cont_mono 9); (* 15 subgoals *)
   2.736 -by Typecheck_tac; (* proves all but the lub case *)
   2.737 -by (stac comp_cont_apply 1);
   2.738 -by (stac cont_lub 4);
   2.739 -by (stac cont_lub 6);
   2.740 -by (asm_full_simp_tac(simpset() addsimps [comp_cont_apply,chain_in]) 8);
   2.741 -by (auto_tac (claset() addIs [cpo_lub RS islub_in, cont_chain], simpset()));
   2.742 -qed "comp_pres_cont";
   2.743 -
   2.744 -AddTCs [comp_pres_cont];
   2.745 -
   2.746 -Goal  (* comp_mono *)
   2.747 -    "[| f \\<in> cont(D',E); g \\<in> cont(D,D'); f':cont(D',E); g':cont(D,D');   \
   2.748 -\       rel(cf(D',E),f,f'); rel(cf(D,D'),g,g'); cpo(D); cpo(E) |] ==>   \
   2.749 -\    rel(cf(D,E),f O g,f' O g')";
   2.750 -by (rtac rel_cfI 1); (* extra proof obl: f O g and f' O g' cont. Extra asm cpo(D). *)
   2.751 -by (stac comp_cont_apply 1);
   2.752 -by (stac comp_cont_apply 4);
   2.753 -by (rtac cpo_trans 7);
   2.754 -by (REPEAT (ares_tac [rel_cf,cont_mono,cont_map,comp_pres_cont] 1));
   2.755 -qed "comp_mono";
   2.756 -
   2.757 -Goal  (* chain_cf_comp *)
   2.758 -    "[| chain(cf(D',E),X); chain(cf(D,D'),Y); cpo(D); cpo(E)|] ==>  \
   2.759 -\    chain(cf(D,E),\\<lambda>n \\<in> nat. X`n O Y`n)";
   2.760 -by (rtac chainI 1);
   2.761 -by (Asm_simp_tac 2);
   2.762 -by (rtac rel_cfI 2);
   2.763 -by (stac comp_cont_apply 2);
   2.764 -by (stac comp_cont_apply 5); 
   2.765 -by (rtac cpo_trans 8); 
   2.766 -by (rtac rel_cf 9);
   2.767 -by (rtac cont_mono 11);
   2.768 -brr[lam_type, comp_pres_cont, cont_cf, chain_in RS cf_cont, cont_map, chain_rel,rel_cf,nat_succI] 1;
   2.769 -qed "chain_cf_comp";
   2.770 -
   2.771 -Goal  (* comp_lubs *)
   2.772 -    "[| chain(cf(D',E),X); chain(cf(D,D'),Y); cpo(D); cpo(D'); cpo(E)|] ==>  \
   2.773 -\    lub(cf(D',E),X) O lub(cf(D,D'),Y) = lub(cf(D,E),\\<lambda>n \\<in> nat. X`n O Y`n)";
   2.774 -by (rtac fun_extension 1);
   2.775 -by (stac lub_cf 3);
   2.776 -brr[comp_fun, cf_cont RS cont_fun, cpo_lub RS islub_in, cpo_cf, chain_cf_comp] 1;
   2.777 -by (asm_simp_tac(simpset()
   2.778 -		 addsimps[chain_in RS 
   2.779 -			  cf_cont RSN(3,chain_in RS 
   2.780 -				      cf_cont RS comp_cont_apply)]) 1);
   2.781 -by (stac comp_cont_apply 1);
   2.782 -brr[cpo_lub RS islub_in RS cf_cont, cpo_cf] 1;
   2.783 -by (asm_simp_tac(simpset() addsimps
   2.784 -		 [lub_cf,chain_cf, chain_in RS cf_cont RS cont_lub,
   2.785 -		  chain_cf RS cpo_lub RS islub_in]) 1);
   2.786 -by (cut_inst_tac[("M","\\<lambda>xa \\<in> nat. \\<lambda>xb \\<in> nat. X`xa`(Y`xb`x)")]
   2.787 -   lub_matrix_diag 1);
   2.788 -by (Asm_full_simp_tac 3);
   2.789 -by (rtac matrix_chainI 1);
   2.790 -by (Asm_simp_tac 1);
   2.791 -by (Asm_simp_tac 2);
   2.792 -by (dtac (chain_in RS cf_cont) 1 THEN atac 1);
   2.793 -by (fast_tac (claset() addDs [chain_cf RSN(2,cont_chain)]
   2.794 -	      addss simpset()) 1);
   2.795 -by (rtac chain_cf 1);
   2.796 -by (REPEAT (ares_tac [cont_fun RS apply_type, chain_in RS cf_cont, 
   2.797 -		      lam_type] 1));
   2.798 -qed "comp_lubs";
   2.799 -
   2.800 -(*----------------------------------------------------------------------*)
   2.801 -(* Theorems about projpair.                                             *)
   2.802 -(*----------------------------------------------------------------------*)
   2.803 -
   2.804 -Goalw [projpair_def]  (* projpairI *)
   2.805 -    "[| e \\<in> cont(D,E); p \\<in> cont(E,D); p O e = id(set(D));   \
   2.806 -\       rel(cf(E,E))(e O p)(id(set(E)))|] ==> projpair(D,E,e,p)";
   2.807 -by (Fast_tac 1);
   2.808 -qed "projpairI";
   2.809 -
   2.810 -Goalw [projpair_def] "projpair(D,E,e,p) ==> e \\<in> cont(D,E)";
   2.811 -by Auto_tac;  
   2.812 -qed "projpair_e_cont";
   2.813 -
   2.814 -Goalw [projpair_def] "projpair(D,E,e,p) ==> p \\<in> cont(E,D)";
   2.815 -by Auto_tac;  
   2.816 -qed "projpair_p_cont";
   2.817 -
   2.818 -Goalw [projpair_def] "projpair(D,E,e,p) ==> p O e = id(set(D))";
   2.819 -by Auto_tac;  
   2.820 -qed "projpair_eq";
   2.821 -
   2.822 -Goalw [projpair_def] "projpair(D,E,e,p) ==> rel(cf(E,E))(e O p)(id(set(E)))";
   2.823 -by Auto_tac;  
   2.824 -qed "projpair_rel";
   2.825 -
   2.826 -val projpairDs = [projpair_e_cont,projpair_p_cont,projpair_eq,projpair_rel];
   2.827 -
   2.828 -(*----------------------------------------------------------------------*)
   2.829 -(* NB! projpair_e_cont and projpair_p_cont cannot be used repeatedly    *)
   2.830 -(*     at the same time since both match a goal of the form f \\<in> cont(X,Y).*)
   2.831 -(*----------------------------------------------------------------------*)
   2.832 -
   2.833 -(*----------------------------------------------------------------------*)
   2.834 -(* Uniqueness of embedding projection pairs.                            *)
   2.835 -(*----------------------------------------------------------------------*)
   2.836 -
   2.837 -val id_comp = fun_is_rel RS left_comp_id;
   2.838 -val comp_id = fun_is_rel RS right_comp_id;
   2.839 -
   2.840 -val prems = goal thy (* lemma1 *)
   2.841 -    "[|cpo(D); cpo(E); projpair(D,E,e,p); projpair(D,E,e',p');  \
   2.842 -\      rel(cf(D,E),e,e')|] ==> rel(cf(E,D),p',p)";
   2.843 -val [_,_,p1,p2,_] = prems;
   2.844 -(* The two theorems proj_e_cont and proj_p_cont are useless unless they 
   2.845 -   are used manually, one at a time. Therefore the following contl.     *)
   2.846 -val contl = [p1 RS projpair_e_cont,p1 RS projpair_p_cont,
   2.847 -            p2 RS projpair_e_cont,p2 RS projpair_p_cont];
   2.848 -by (rtac (p2 RS projpair_p_cont RS cont_fun RS id_comp RS subst) 1);
   2.849 -by (rtac (p1 RS projpair_eq RS subst) 1);
   2.850 -by (rtac cpo_trans 1);
   2.851 -brr(cpo_cf::prems) 1; 
   2.852 -(* The following corresponds to EXISTS_TAC, non-trivial instantiation. *)
   2.853 -by (res_inst_tac[("f","p O (e' O p')")]cont_cf 4);
   2.854 -by (stac comp_assoc 1);
   2.855 -brr(cpo_refl::cpo_cf::cont_cf::comp_mono::comp_pres_cont::(contl@prems)) 1;
   2.856 -by (res_inst_tac[("P","%x. rel(cf(E,D),p O e' O p',x)")]
   2.857 -    (p1 RS projpair_p_cont RS cont_fun RS comp_id RS subst) 1);
   2.858 -by (rtac comp_mono 1);
   2.859 -brr(cpo_refl::cpo_cf::cont_cf::comp_mono::comp_pres_cont::id_cont::
   2.860 -    projpair_rel::(contl@prems)) 1;
   2.861 -val lemma1 = result();
   2.862 -
   2.863 -val prems = goal thy (* lemma2 *)
   2.864 -    "[|cpo(D); cpo(E); projpair(D,E,e,p); projpair(D,E,e',p');  \
   2.865 -\      rel(cf(E,D),p',p)|] ==> rel(cf(D,E),e,e')";
   2.866 -val [_,_,p1,p2,_] = prems;
   2.867 -val contl = [p1 RS projpair_e_cont,p1 RS projpair_p_cont,
   2.868 -            p2 RS projpair_e_cont,p2 RS projpair_p_cont];
   2.869 -by (rtac (p1 RS projpair_e_cont RS cont_fun RS comp_id RS subst) 1);
   2.870 -by (rtac (p2 RS projpair_eq RS subst) 1);
   2.871 -by (rtac cpo_trans 1);
   2.872 -brr(cpo_cf::prems) 1; 
   2.873 -by (res_inst_tac[("f","(e O p) O e'")]cont_cf 4);
   2.874 -by (stac comp_assoc 1);
   2.875 -brr((cpo_cf RS cpo_refl)::cont_cf::comp_mono::comp_pres_cont::(contl@prems)) 1;
   2.876 -by (res_inst_tac[("P","%x. rel(cf(D,E),(e O p) O e',x)")]
   2.877 -    (p2 RS projpair_e_cont RS cont_fun RS id_comp RS subst) 1);
   2.878 -brr((cpo_cf RS cpo_refl)::cont_cf::comp_mono::id_cont::comp_pres_cont::projpair_rel::(contl@prems)) 1;
   2.879 -val lemma2 = result();
   2.880 -
   2.881 -val prems = goal thy (* projpair_unique *)
   2.882 -    "[|cpo(D); cpo(E); projpair(D,E,e,p); projpair(D,E,e',p')|] ==>  \
   2.883 -\    (e=e')<->(p=p')";
   2.884 -val [_,_,p1,p2] = prems;
   2.885 -val contl = [p1 RS projpair_e_cont,p1 RS projpair_p_cont,
   2.886 -            p2 RS projpair_e_cont,p2 RS projpair_p_cont];
   2.887 -by (rtac iffI 1);
   2.888 -by (rtac cpo_antisym 1);
   2.889 -by (rtac lemma1 2);
   2.890 -(* First some existentials are instantiated. *)
   2.891 -by (resolve_tac prems 4);
   2.892 -by (resolve_tac prems 4);
   2.893 -by (Asm_simp_tac 4);
   2.894 -brr([cpo_cf,cpo_refl,cont_cf,projpair_e_cont]@prems) 1;
   2.895 -by (rtac lemma1 1);
   2.896 -by (REPEAT (ares_tac prems 1));
   2.897 -by (Asm_simp_tac 1); 
   2.898 -brr(cpo_cf::cpo_refl::cont_cf::(contl @ prems)) 1;
   2.899 -by (rtac cpo_antisym 1);
   2.900 -by (rtac lemma2 2);
   2.901 -(* First some existentials are instantiated. *)
   2.902 -by (resolve_tac prems 4);
   2.903 -by (resolve_tac prems 4);
   2.904 -by (Asm_simp_tac 4);
   2.905 -brr([cpo_cf,cpo_refl,cont_cf,projpair_p_cont]@prems) 1;
   2.906 -by (rtac lemma2 1);
   2.907 -by (REPEAT (ares_tac prems 1));
   2.908 -by (Asm_simp_tac 1); 
   2.909 -brr(cpo_cf::cpo_refl::cont_cf::(contl @ prems)) 1;
   2.910 -qed "projpair_unique";
   2.911 -
   2.912 -(* Slightly different, more asms, since THE chooses the unique element. *)
   2.913 -
   2.914 -Goalw [emb_def,Rp_def] (* embRp *)
   2.915 -    "[|emb(D,E,e); cpo(D); cpo(E)|] ==> projpair(D,E,e,Rp(D,E,e))";
   2.916 -by (rtac theI2 1);
   2.917 -by (assume_tac 2);
   2.918 -by (blast_tac (claset() addIs [projpair_unique RS iffD1]) 1);
   2.919 -qed "embRp";
   2.920 -
   2.921 -Goalw [emb_def] "projpair(D,E,e,p) ==> emb(D,E,e)";
   2.922 -by Auto_tac;  
   2.923 -qed "embI";
   2.924 -
   2.925 -Goal "[|projpair(D,E,e,p); cpo(D); cpo(E)|] ==> Rp(D,E,e) = p";
   2.926 -by (blast_tac (claset() addIs [embRp, embI, projpair_unique RS iffD1]) 1);
   2.927 -qed "Rp_unique";
   2.928 -
   2.929 -Goalw [emb_def] "emb(D,E,e) ==> e \\<in> cont(D,E)";
   2.930 -by (blast_tac (claset() addIs [projpair_e_cont]) 1);
   2.931 -qed "emb_cont";
   2.932 -
   2.933 -(* The following three theorems have cpo asms due to THE (uniqueness). *)
   2.934 -
   2.935 -bind_thm ("Rp_cont", embRp RS projpair_p_cont);
   2.936 -bind_thm ("embRp_eq", embRp RS projpair_eq);
   2.937 -bind_thm ("embRp_rel", embRp RS projpair_rel);
   2.938 -
   2.939 -AddTCs [emb_cont, Rp_cont];
   2.940 -
   2.941 -Goal  (* embRp_eq_thm *)
   2.942 -    "[|emb(D,E,e); x \\<in> set(D); cpo(D); cpo(E)|] ==> Rp(D,E,e)`(e`x) = x";
   2.943 -by (rtac (comp_fun_apply RS subst) 1);
   2.944 -brr[Rp_cont,emb_cont,cont_fun] 1;
   2.945 -by (stac embRp_eq 1);
   2.946 -by (auto_tac (claset() addIs [id_conv], simpset()));
   2.947 -qed "embRp_eq_thm";
   2.948 -
   2.949 -
   2.950 -(*----------------------------------------------------------------------*)
   2.951 -(* The identity embedding.                                              *)
   2.952 -(*----------------------------------------------------------------------*)
   2.953 -
   2.954 -Goalw [projpair_def]  (* projpair_id *)
   2.955 -    "cpo(D) ==> projpair(D,D,id(set(D)),id(set(D)))";
   2.956 -by Safe_tac;
   2.957 -brr[id_cont,id_comp,id_type] 1;
   2.958 -by (stac id_comp 1); (* Matches almost anything *)
   2.959 -brr[id_cont,id_type,cpo_refl,cpo_cf,cont_cf] 1;
   2.960 -qed "projpair_id";
   2.961 -
   2.962 -Goal  (* emb_id *)
   2.963 -    "cpo(D) ==> emb(D,D,id(set(D)))";
   2.964 -by (auto_tac (claset() addIs [embI,projpair_id], simpset()));
   2.965 -qed "emb_id";
   2.966 -
   2.967 -Goal  (* Rp_id *)
   2.968 -    "cpo(D) ==> Rp(D,D,id(set(D))) = id(set(D))";
   2.969 -by (auto_tac (claset() addIs [Rp_unique,projpair_id], simpset()));
   2.970 -qed "Rp_id";
   2.971 -
   2.972 -(*----------------------------------------------------------------------*)
   2.973 -(* Composition preserves embeddings.                                    *)
   2.974 -(*----------------------------------------------------------------------*)
   2.975 -
   2.976 -(* Considerably shorter, only partly due to a simpler comp_assoc. *)
   2.977 -(* Proof in HOL-ST: 70 lines (minus 14 due to comp_assoc complication). *)
   2.978 -(* Proof in Isa/ZF: 23 lines (compared to 56: 60% reduction). *)
   2.979 -
   2.980 -Goalw [projpair_def]  (* lemma *)
   2.981 -    "[|emb(D,D',e); emb(D',E,e'); cpo(D); cpo(D'); cpo(E)|] ==>  \
   2.982 -\    projpair(D,E,e' O e,(Rp(D,D',e)) O (Rp(D',E,e')))";
   2.983 -by Safe_tac;
   2.984 -brr[comp_pres_cont,Rp_cont,emb_cont] 1;
   2.985 -by (rtac (comp_assoc RS subst) 1);
   2.986 -by (res_inst_tac[("t1","e'")](comp_assoc RS ssubst) 1);
   2.987 -by (stac embRp_eq 1); (* Matches everything due to subst/ssubst. *)
   2.988 -by (REPEAT (assume_tac 1));
   2.989 -by (stac comp_id 1);
   2.990 -brr[cont_fun,Rp_cont,embRp_eq] 1;
   2.991 -by (rtac (comp_assoc RS subst) 1);
   2.992 -by (res_inst_tac[("t1","Rp(D,D',e)")](comp_assoc RS ssubst) 1);
   2.993 -by (rtac cpo_trans 1);
   2.994 -brr[cpo_cf] 1;
   2.995 -by (rtac comp_mono 1);
   2.996 -by (rtac cpo_refl 6);
   2.997 -brr[cont_cf,Rp_cont] 7; 
   2.998 -brr[cpo_cf] 6;
   2.999 -by (rtac comp_mono 5);
  2.1000 -brr[embRp_rel] 10;
  2.1001 -brr[cpo_cf RS cpo_refl, cont_cf,Rp_cont] 9;
  2.1002 -by (stac comp_id 10);
  2.1003 -by (rtac embRp_rel 11); 
  2.1004 -(* There are 16 subgoals at this point. All are proved immediately by: *)
  2.1005 -by (REPEAT (ares_tac [comp_pres_cont,Rp_cont,id_cont,
  2.1006 -		      emb_cont,cont_fun,cont_cf] 1));
  2.1007 -val lemma = result();
  2.1008 -
  2.1009 -(* The use of RS is great in places like the following, both ugly in HOL. *)
  2.1010 -
  2.1011 -val emb_comp = lemma RS embI;
  2.1012 -val Rp_comp = lemma RS Rp_unique;
  2.1013 -
  2.1014 -(*----------------------------------------------------------------------*)
  2.1015 -(* Infinite cartesian product.                                          *)
  2.1016 -(*----------------------------------------------------------------------*)
  2.1017 -
  2.1018 -Goalw [set_def,iprod_def]  (* iprodI *)
  2.1019 -    "x:(\\<Pi>n \\<in> nat. set(DD`n)) ==> x \\<in> set(iprod(DD))";
  2.1020 -by (Asm_full_simp_tac 1);
  2.1021 -qed "iprodI";
  2.1022 -
  2.1023 -Goalw [set_def,iprod_def]  (* iprodE *)
  2.1024 -    "x \\<in> set(iprod(DD)) ==> x:(\\<Pi>n \\<in> nat. set(DD`n))";
  2.1025 -by (Asm_full_simp_tac 1);
  2.1026 -qed "iprodE";
  2.1027 -
  2.1028 -(* Contains typing conditions in contrast to HOL-ST *)
  2.1029 -
  2.1030 -val prems = Goalw [iprod_def] (* rel_iprodI *)
  2.1031 -    "[|!!n. n \\<in> nat ==> rel(DD`n,f`n,g`n); f:(\\<Pi>n \\<in> nat. set(DD`n));  \
  2.1032 -\      g:(\\<Pi>n \\<in> nat. set(DD`n))|] ==> rel(iprod(DD),f,g)";
  2.1033 -by (rtac rel_I 1);
  2.1034 -by (Simp_tac 1);
  2.1035 -by Safe_tac;
  2.1036 -by (REPEAT (ares_tac prems 1));
  2.1037 -qed "rel_iprodI";
  2.1038 -
  2.1039 -Goalw [iprod_def]
  2.1040 -    "[|rel(iprod(DD),f,g); n \\<in> nat|] ==> rel(DD`n,f`n,g`n)";
  2.1041 -by (fast_tac (claset() addDs [rel_E] addss simpset()) 1);
  2.1042 -qed "rel_iprodE";
  2.1043 -
  2.1044 -(* Some special theorems like dProdApIn_cpo and other `_cpo' 
  2.1045 -   probably not needed in Isabelle, wait and see. *)
  2.1046 -
  2.1047 -val prems = Goalw [chain_def]  (* chain_iprod *)
  2.1048 -    "[|chain(iprod(DD),X);  !!n. n \\<in> nat ==> cpo(DD`n); n \\<in> nat|] ==>  \
  2.1049 -\    chain(DD`n,\\<lambda>m \\<in> nat. X`m`n)";
  2.1050 -by Safe_tac;
  2.1051 -by (rtac lam_type 1);
  2.1052 -by (rtac apply_type 1);
  2.1053 -by (rtac iprodE 1);
  2.1054 -by (etac (hd prems RS conjunct1 RS apply_type) 1);
  2.1055 -by (resolve_tac prems 1);
  2.1056 -by (asm_simp_tac(simpset() addsimps prems) 1);
  2.1057 -by (rtac rel_iprodE 1);
  2.1058 -by (asm_simp_tac (simpset() addsimps prems) 1);
  2.1059 -by (resolve_tac prems 1);
  2.1060 -qed "chain_iprod";
  2.1061 -
  2.1062 -val prems = Goalw [islub_def,isub_def]  (* islub_iprod *)
  2.1063 -    "[|chain(iprod(DD),X);  !!n. n \\<in> nat ==> cpo(DD`n)|] ==>   \
  2.1064 -\    islub(iprod(DD),X,\\<lambda>n \\<in> nat. lub(DD`n,\\<lambda>m \\<in> nat. X`m`n))";
  2.1065 -by Safe_tac;
  2.1066 -by (rtac iprodI 1);
  2.1067 -by (rtac lam_type 1); 
  2.1068 -brr((chain_iprod RS cpo_lub RS islub_in)::prems) 1;
  2.1069 -by (rtac rel_iprodI 1);
  2.1070 -by (Asm_simp_tac 1);
  2.1071 -(* Here, HOL resolution is handy, Isabelle resolution bad. *)
  2.1072 -by (res_inst_tac[("P","%t. rel(DD`na,t,lub(DD`na,\\<lambda>x \\<in> nat. X`x`na))"),
  2.1073 -    ("b1","%n. X`n`na")](beta RS subst) 1);
  2.1074 -brr((chain_iprod RS cpo_lub RS islub_ub)::iprodE::chain_in::prems) 1;
  2.1075 -brr(iprodI::lam_type::(chain_iprod RS cpo_lub RS islub_in)::prems) 1;
  2.1076 -by (rtac rel_iprodI 1);
  2.1077 -by (Asm_simp_tac 1);
  2.1078 -brr(islub_least::(chain_iprod RS cpo_lub)::prems) 1;
  2.1079 -by (rewtac isub_def);
  2.1080 -by Safe_tac;
  2.1081 -by (etac (iprodE RS apply_type) 1);
  2.1082 -by (assume_tac 1);
  2.1083 -by (Asm_simp_tac 1);
  2.1084 -by (dtac bspec 1);
  2.1085 -by (etac rel_iprodE 2);
  2.1086 -brr(lam_type::(chain_iprod RS cpo_lub RS islub_in)::iprodE::prems) 1;
  2.1087 -qed "islub_iprod";
  2.1088 -
  2.1089 -val prems = Goal (* cpo_iprod *)
  2.1090 -    "(!!n. n \\<in> nat ==> cpo(DD`n)) ==> cpo(iprod(DD))";
  2.1091 -brr[cpoI,poI] 1;
  2.1092 -by (rtac rel_iprodI 1); (* not repeated: want to solve 1 and leave 2 unchanged *)
  2.1093 -brr(cpo_refl::(iprodE RS apply_type)::iprodE::prems) 1;
  2.1094 -by (rtac rel_iprodI 1);
  2.1095 -by (dtac rel_iprodE 1);
  2.1096 -by (dtac rel_iprodE 2);
  2.1097 -brr(cpo_trans::(iprodE RS apply_type)::iprodE::prems) 1;
  2.1098 -by (rtac fun_extension 1);
  2.1099 -brr(cpo_antisym::rel_iprodE::(iprodE RS apply_type)::iprodE::prems) 1;
  2.1100 -brr(islub_iprod::prems) 1;
  2.1101 -qed "cpo_iprod";
  2.1102 -
  2.1103 -AddTCs [cpo_iprod];
  2.1104 -
  2.1105 -val prems = Goalw [islub_def,isub_def]  (* lub_iprod *)
  2.1106 -    "[|chain(iprod(DD),X);  !!n. n \\<in> nat ==> cpo(DD`n)|] ==>   \
  2.1107 -\    lub(iprod(DD),X) = (\\<lambda>n \\<in> nat. lub(DD`n,\\<lambda>m \\<in> nat. X`m`n))";
  2.1108 -brr((cpo_lub RS islub_unique)::islub_iprod::cpo_iprod::prems) 1;
  2.1109 -qed "lub_iprod";
  2.1110 -
  2.1111 -(*----------------------------------------------------------------------*)
  2.1112 -(* The notion of subcpo.                                                *)
  2.1113 -(*----------------------------------------------------------------------*)
  2.1114 -
  2.1115 -val prems = Goalw [subcpo_def]  (* subcpoI *)
  2.1116 -    "[|set(D)<=set(E);  \
  2.1117 -\      !!x y. [|x \\<in> set(D); y \\<in> set(D)|] ==> rel(D,x,y)<->rel(E,x,y);  \
  2.1118 -\      !!X. chain(D,X) ==> lub(E,X) \\<in> set(D)|] ==> subcpo(D,E)";
  2.1119 -by Safe_tac;
  2.1120 -by (asm_full_simp_tac(simpset() addsimps prems) 2);
  2.1121 -by (asm_simp_tac(simpset() addsimps prems) 2);
  2.1122 -brr(prems@[subsetD]) 1;
  2.1123 -qed "subcpoI";
  2.1124 -
  2.1125 -Goalw [subcpo_def] "subcpo(D,E) ==> set(D)<=set(E)";
  2.1126 -by Auto_tac;  
  2.1127 -qed "subcpo_subset";
  2.1128 -
  2.1129 -Goalw [subcpo_def]  
  2.1130 -    "[|subcpo(D,E); x \\<in> set(D); y \\<in> set(D)|] ==> rel(D,x,y)<->rel(E,x,y)";
  2.1131 -by (Blast_tac 1);
  2.1132 -qed "subcpo_rel_eq";
  2.1133 -
  2.1134 -val subcpo_relD1 = subcpo_rel_eq RS iffD1;
  2.1135 -val subcpo_relD2 = subcpo_rel_eq RS iffD2;
  2.1136 -
  2.1137 -Goalw [subcpo_def] "[|subcpo(D,E); chain(D,X)|] ==> lub(E,X) \\<in> set(D)";
  2.1138 -by (Blast_tac 1);
  2.1139 -qed "subcpo_lub";
  2.1140 -
  2.1141 -Goal "[|subcpo(D,E); chain(D,X)|] ==> chain(E,X)";
  2.1142 -by (rtac (Pi_type RS chainI) 1);
  2.1143 -by (REPEAT
  2.1144 -    (blast_tac (claset() addIs [chain_fun, subcpo_relD1, 
  2.1145 -				subcpo_subset RS subsetD,
  2.1146 -				chain_in, chain_rel]) 1));
  2.1147 -qed "chain_subcpo";
  2.1148 -
  2.1149 -Goal "[|subcpo(D,E); chain(D,X); isub(D,X,x)|] ==> isub(E,X,x)";
  2.1150 -by (blast_tac (claset() addIs [isubI, subcpo_relD1,subcpo_relD1, 
  2.1151 -			       chain_in, isubD1, isubD2,
  2.1152 -			       subcpo_subset RS subsetD,
  2.1153 -			       chain_in, chain_rel]) 1);
  2.1154 -qed "ub_subcpo";
  2.1155 -        
  2.1156 -Goal "[|subcpo(D,E); cpo(E); chain(D,X)|] ==> islub(D,X,lub(E,X))";
  2.1157 -by (blast_tac (claset() addIs [islubI, isubI, subcpo_lub, 
  2.1158 -			       subcpo_relD2, chain_in, 
  2.1159 -			       islub_ub, islub_least, cpo_lub,
  2.1160 -			       chain_subcpo, isubD1, ub_subcpo]) 1);
  2.1161 -qed "islub_subcpo";
  2.1162 -
  2.1163 -Goal "[|subcpo(D,E); cpo(E)|] ==> cpo(D)";
  2.1164 -brr[cpoI,poI]1;
  2.1165 -by (asm_full_simp_tac(simpset() addsimps[subcpo_rel_eq]) 1);
  2.1166 -brr[cpo_refl, subcpo_subset RS subsetD] 1;
  2.1167 -by (rotate_tac ~3 1);
  2.1168 -by (asm_full_simp_tac(simpset() addsimps[subcpo_rel_eq]) 1);
  2.1169 -by (blast_tac (claset() addIs [subcpo_subset RS subsetD, cpo_trans]) 1);
  2.1170 -(* Changing the order of the assumptions, otherwise full_simp doesn't work. *)
  2.1171 -by (rotate_tac ~2 1);
  2.1172 -by (asm_full_simp_tac(simpset() addsimps[subcpo_rel_eq]) 1);
  2.1173 -by (blast_tac (claset() addIs [cpo_antisym, subcpo_subset RS subsetD])  1);
  2.1174 -by (fast_tac (claset() addIs [islub_subcpo])  1);
  2.1175 -qed "subcpo_cpo";
  2.1176 -
  2.1177 -Goal "[|subcpo(D,E); cpo(E); chain(D,X)|] ==> lub(D,X) = lub(E,X)";
  2.1178 -by (blast_tac (claset() addIs [cpo_lub RS islub_unique, 
  2.1179 -			       islub_subcpo, subcpo_cpo])  1);
  2.1180 -qed "lub_subcpo";
  2.1181 -
  2.1182 -(*----------------------------------------------------------------------*)
  2.1183 -(* Making subcpos using mkcpo.                                          *)
  2.1184 -(*----------------------------------------------------------------------*)
  2.1185 -
  2.1186 -Goalw [set_def,mkcpo_def] "[|x \\<in> set(D); P(x)|] ==> x \\<in> set(mkcpo(D,P))";
  2.1187 -by Auto_tac;
  2.1188 -qed "mkcpoI";
  2.1189 -
  2.1190 -(* Old proof where cpos are non-reflexive relations.
  2.1191 -by (rewtac set_def); (* Annoying, cannot just rewrite once. *)
  2.1192 -by (rtac CollectI 1);
  2.1193 -by (rtac domainI 1);
  2.1194 -by (rtac CollectI 1);
  2.1195 -(* Now, work on subgoal 2 (and 3) to instantiate unknown. *)
  2.1196 -by (Simp_tac 2);
  2.1197 -by (rtac conjI 2);
  2.1198 -by (rtac conjI 3);
  2.1199 -by (resolve_tac prems 3);
  2.1200 -by (simp_tac(simpset() addsimps [rewrite_rule[set_def](hd prems)]) 1);
  2.1201 -by (resolve_tac prems 1);
  2.1202 -by (rtac cpo_refl 1);
  2.1203 -by (resolve_tac prems 1);
  2.1204 -by (rtac rel_I 1);
  2.1205 -by (rtac CollectI 1);
  2.1206 -by (fast_tac(claset() addSIs [rewrite_rule[set_def](hd prems)]) 1);
  2.1207 -by (Simp_tac 1);
  2.1208 -brr[conjI,cpo_refl] 1;
  2.1209 -*)
  2.1210 -
  2.1211 -Goalw [set_def,mkcpo_def]  (* mkcpoD1 *)
  2.1212 -    "x \\<in> set(mkcpo(D,P))==> x \\<in> set(D)";
  2.1213 -by (Asm_full_simp_tac 1);
  2.1214 -qed "mkcpoD1";
  2.1215 -
  2.1216 -Goalw [set_def,mkcpo_def]  (* mkcpoD2 *)
  2.1217 -    "x \\<in> set(mkcpo(D,P))==> P(x)";
  2.1218 -by (Asm_full_simp_tac 1);
  2.1219 -qed "mkcpoD2";
  2.1220 -
  2.1221 -Goalw [rel_def,mkcpo_def]  (* rel_mkcpoE *)
  2.1222 -    "rel(mkcpo(D,P),x,y) ==> rel(D,x,y)";
  2.1223 -by (Asm_full_simp_tac 1);
  2.1224 -qed "rel_mkcpoE";
  2.1225 -
  2.1226 -Goalw [mkcpo_def,rel_def,set_def]
  2.1227 -    "[|x \\<in> set(D); y \\<in> set(D)|] ==> rel(mkcpo(D,P),x,y) <-> rel(D,x,y)";
  2.1228 -by Auto_tac;  
  2.1229 -qed "rel_mkcpo";
  2.1230 -
  2.1231 -Goal  (* chain_mkcpo *)
  2.1232 -    "chain(mkcpo(D,P),X) ==> chain(D,X)";
  2.1233 -by (rtac chainI 1);
  2.1234 -by (blast_tac (claset() addIs [Pi_type, chain_fun, chain_in RS mkcpoD1]) 1);
  2.1235 -by (blast_tac (claset() addIs [rel_mkcpo RS iffD1, chain_rel, mkcpoD1, 
  2.1236 -                               chain_in,nat_succI]) 1);
  2.1237 -qed "chain_mkcpo";
  2.1238 -
  2.1239 -val prems = Goal  (* subcpo_mkcpo *)
  2.1240 -    "[|!!X. chain(mkcpo(D,P),X) ==> P(lub(D,X)); cpo(D)|] ==>   \
  2.1241 -\    subcpo(mkcpo(D,P),D)";
  2.1242 -brr(subcpoI::subsetI::prems) 1;
  2.1243 -by (rtac rel_mkcpo 2);
  2.1244 -by (REPEAT(etac mkcpoD1 1)); 
  2.1245 -brr(mkcpoI::(cpo_lub RS islub_in)::chain_mkcpo::prems) 1;
  2.1246 -qed "subcpo_mkcpo";
  2.1247 -
  2.1248 -(*----------------------------------------------------------------------*)
  2.1249 -(* Embedding projection chains of cpos.                                 *)
  2.1250 -(*----------------------------------------------------------------------*)
  2.1251 -
  2.1252 -val prems = Goalw [emb_chain_def]  (* emb_chainI *)
  2.1253 -    "[|!!n. n \\<in> nat ==> cpo(DD`n);   \
  2.1254 -\      !!n. n \\<in> nat ==> emb(DD`n,DD`succ(n),ee`n)|] ==> emb_chain(DD,ee)";
  2.1255 -by Safe_tac;
  2.1256 -by (REPEAT (ares_tac prems 1));
  2.1257 -qed "emb_chainI";
  2.1258 -
  2.1259 -Goalw [emb_chain_def] "[|emb_chain(DD,ee); n \\<in> nat|] ==> cpo(DD`n)";
  2.1260 -by (Fast_tac 1);
  2.1261 -qed "emb_chain_cpo";
  2.1262 -
  2.1263 -AddTCs [emb_chain_cpo];
  2.1264 -
  2.1265 -Goalw [emb_chain_def] 
  2.1266 -    "[|emb_chain(DD,ee); n \\<in> nat|] ==> emb(DD`n,DD`succ(n),ee`n)";
  2.1267 -by (Fast_tac 1);
  2.1268 -qed "emb_chain_emb";
  2.1269 -
  2.1270 -(*----------------------------------------------------------------------*)
  2.1271 -(* Dinf, the inverse Limit.                                             *)
  2.1272 -(*----------------------------------------------------------------------*)
  2.1273 -
  2.1274 -val prems = Goalw [Dinf_def]  (* DinfI *)
  2.1275 -    "[|x:(\\<Pi>n \\<in> nat. set(DD`n));  \
  2.1276 -\      !!n. n \\<in> nat ==> Rp(DD`n,DD`succ(n),ee`n)`(x`succ(n)) = x`n|] ==>   \
  2.1277 -\    x \\<in> set(Dinf(DD,ee))";
  2.1278 -brr(mkcpoI::iprodI::ballI::prems) 1;
  2.1279 -qed "DinfI";
  2.1280 -
  2.1281 -Goalw [Dinf_def] "x \\<in> set(Dinf(DD,ee)) ==> x:(\\<Pi>n \\<in> nat. set(DD`n))";
  2.1282 -by (etac (mkcpoD1 RS iprodE) 1);
  2.1283 -qed "Dinf_prod";
  2.1284 -
  2.1285 -Goalw [Dinf_def]
  2.1286 -    "[|x \\<in> set(Dinf(DD,ee)); n \\<in> nat|] ==>   \
  2.1287 -\    Rp(DD`n,DD`succ(n),ee`n)`(x`succ(n)) = x`n";
  2.1288 -by (blast_tac (claset() addDs [mkcpoD2])  1);
  2.1289 -qed "Dinf_eq";
  2.1290 -
  2.1291 -val prems = Goalw [Dinf_def] 
  2.1292 -    "[|!!n. n \\<in> nat ==> rel(DD`n,x`n,y`n);  \
  2.1293 -\      x:(\\<Pi>n \\<in> nat. set(DD`n)); y:(\\<Pi>n \\<in> nat. set(DD`n))|] ==>   \
  2.1294 -\    rel(Dinf(DD,ee),x,y)";
  2.1295 -by (rtac (rel_mkcpo RS iffD2) 1);
  2.1296 -brr(rel_iprodI::iprodI::prems) 1;
  2.1297 -qed "rel_DinfI";
  2.1298 -
  2.1299 -Goalw [Dinf_def] "[|rel(Dinf(DD,ee),x,y); n \\<in> nat|] ==> rel(DD`n,x`n,y`n)";
  2.1300 -by (etac (rel_mkcpoE RS rel_iprodE) 1);
  2.1301 -by (assume_tac 1);
  2.1302 -qed "rel_Dinf";
  2.1303 -
  2.1304 -Goalw [Dinf_def] "chain(Dinf(DD,ee),X) ==> chain(iprod(DD),X)";
  2.1305 -by (etac chain_mkcpo 1);
  2.1306 -qed "chain_Dinf";
  2.1307 -
  2.1308 -Goalw [Dinf_def]  (* subcpo_Dinf *)
  2.1309 -    "emb_chain(DD,ee) ==> subcpo(Dinf(DD,ee),iprod(DD))";
  2.1310 -by (rtac subcpo_mkcpo 1);
  2.1311 -by (fold_tac [Dinf_def]);
  2.1312 -by (rtac ballI 1);
  2.1313 -by (stac lub_iprod 1);
  2.1314 -brr[chain_Dinf, emb_chain_cpo] 1;
  2.1315 -by (Asm_simp_tac 1);
  2.1316 -by (stac (Rp_cont RS cont_lub) 1);
  2.1317 -brr[emb_chain_cpo,emb_chain_emb,nat_succI,chain_iprod,chain_Dinf] 1;
  2.1318 -(* Useful simplification, ugly in HOL. *)
  2.1319 -by (asm_simp_tac(simpset() addsimps[Dinf_eq,chain_in]) 1);
  2.1320 -by (auto_tac (claset() addIs [cpo_iprod,emb_chain_cpo], simpset()));
  2.1321 -qed "subcpo_Dinf";
  2.1322 -
  2.1323 -(* Simple example of existential reasoning in Isabelle versus HOL. *)
  2.1324 -
  2.1325 -Goal "emb_chain(DD,ee) ==> cpo(Dinf(DD,ee))";
  2.1326 -by (rtac subcpo_cpo 1);
  2.1327 -by (etac subcpo_Dinf 1);
  2.1328 -by (auto_tac (claset() addIs [cpo_iprod, emb_chain_cpo], simpset()));
  2.1329 -qed "cpo_Dinf";
  2.1330 -
  2.1331 -(* Again and again the proofs are much easier to WRITE in Isabelle, but 
  2.1332 -  the proof steps are essentially the same (I think). *)
  2.1333 -
  2.1334 -Goal  (* lub_Dinf *)
  2.1335 -    "[|chain(Dinf(DD,ee),X); emb_chain(DD,ee)|] ==>  \
  2.1336 -\    lub(Dinf(DD,ee),X) = (\\<lambda>n \\<in> nat. lub(DD`n,\\<lambda>m \\<in> nat. X`m`n))";
  2.1337 -by (stac (subcpo_Dinf RS lub_subcpo) 1);
  2.1338 -by (auto_tac (claset() addIs [cpo_iprod,emb_chain_cpo,lub_iprod,chain_Dinf], simpset()));
  2.1339 -qed "lub_Dinf";
  2.1340 -
  2.1341 -(*----------------------------------------------------------------------*)
  2.1342 -(* Generalising embedddings D_m -> D_{m+1} to embeddings D_m -> D_n,    *)
  2.1343 -(* defined as eps(DD,ee,m,n), via e_less and e_gr.                      *)
  2.1344 -(*----------------------------------------------------------------------*)
  2.1345 -
  2.1346 -Goalw [e_less_def]  (* e_less_eq *)
  2.1347 -    "m \\<in> nat ==> e_less(DD,ee,m,m) = id(set(DD`m))";
  2.1348 -by (asm_simp_tac (simpset() addsimps[diff_self_eq_0]) 1);
  2.1349 -qed "e_less_eq";
  2.1350 - 
  2.1351 -Goal "succ(m#+n)#-m = succ(natify(n))";
  2.1352 -by (Asm_simp_tac 1);
  2.1353 -val lemma_succ_sub = result();
  2.1354 -
  2.1355 -Goalw [e_less_def]
  2.1356 -     "e_less(DD,ee,m,succ(m#+k)) = (ee`(m#+k))O(e_less(DD,ee,m,m#+k))";
  2.1357 -by (asm_simp_tac (simpset() addsimps [lemma_succ_sub,diff_add_inverse]) 1);
  2.1358 -qed "e_less_add";
  2.1359 -
  2.1360 -Goal "n \\<in> nat ==> succ(n) = n #+ 1";
  2.1361 -by (Asm_simp_tac 1);
  2.1362 -qed "add1";
  2.1363 -
  2.1364 -Goal "[| m le n; n \\<in> nat |] ==> \\<exists>k \\<in> nat. n = m #+ k";
  2.1365 -by (dtac less_imp_succ_add 1);
  2.1366 -by Auto_tac;  
  2.1367 -val lemma_le_exists = result();
  2.1368 -
  2.1369 -val prems = Goal
  2.1370 -    "[| m le n;  !!x. [|n=m#+x; x \\<in> nat|] ==> Q;  n \\<in> nat |] ==> Q";
  2.1371 -by (rtac (lemma_le_exists RS bexE) 1);
  2.1372 -by (DEPTH_SOLVE (ares_tac prems 1));
  2.1373 -qed "le_exists";
  2.1374 -
  2.1375 -Goal "[| m le n;  n \\<in> nat |] ==>   \
  2.1376 -\     e_less(DD,ee,m,succ(n)) = ee`n O e_less(DD,ee,m,n)";
  2.1377 -by (rtac le_exists 1);
  2.1378 -by (assume_tac 1);
  2.1379 -by (asm_simp_tac(simpset() addsimps[e_less_add]) 1);
  2.1380 -by (assume_tac 1);
  2.1381 -qed "e_less_le";
  2.1382 -
  2.1383 -(* All theorems assume variables m and n are natural numbers. *)
  2.1384 -
  2.1385 -Goal "m \\<in> nat ==> e_less(DD,ee,m,succ(m)) = ee`m O id(set(DD`m))";
  2.1386 -by (asm_simp_tac(simpset() addsimps[e_less_le, e_less_eq]) 1);
  2.1387 -qed "e_less_succ";
  2.1388 -
  2.1389 -val prems = Goal
  2.1390 -    "[|!!n. n \\<in> nat ==> emb(DD`n,DD`succ(n),ee`n); m \\<in> nat|] ==>   \
  2.1391 -\    e_less(DD,ee,m,succ(m)) = ee`m";
  2.1392 -by (asm_simp_tac(simpset() addsimps e_less_succ::prems) 1);
  2.1393 -by (stac comp_id 1);
  2.1394 -brr(emb_cont::cont_fun::refl::prems) 1;
  2.1395 -qed "e_less_succ_emb";
  2.1396 -
  2.1397 -(* Compare this proof with the HOL one, here we do type checking. *)
  2.1398 -(* In any case the one below was very easy to write. *)
  2.1399 -
  2.1400 -Goal "[| emb_chain(DD,ee); m \\<in> nat |] ==>   \
  2.1401 -\     emb(DD`m, DD`(m#+k), e_less(DD,ee,m,m#+k))";
  2.1402 -by (subgoal_tac "emb(DD`m, DD`(m#+natify(k)), e_less(DD,ee,m,m#+natify(k)))" 1);
  2.1403 -by (res_inst_tac [("n","natify(k)")] nat_induct 2);
  2.1404 -by (ALLGOALS (asm_full_simp_tac (simpset() addsimps[e_less_eq])));
  2.1405 -brr[emb_id,emb_chain_cpo] 1;
  2.1406 -by (asm_simp_tac(simpset() addsimps[e_less_add]) 1);
  2.1407 -by (auto_tac (claset() addIs [emb_comp,emb_chain_emb,emb_chain_cpo,add_type],
  2.1408 -	      simpset()));
  2.1409 -qed "emb_e_less_add";
  2.1410 -
  2.1411 -Goal "[| m le n;  emb_chain(DD,ee);  n \\<in> nat |] ==>   \
  2.1412 -\    emb(DD`m, DD`n, e_less(DD,ee,m,n))";
  2.1413 -by (ftac lt_nat_in_nat 1);
  2.1414 -by (etac nat_succI 1);
  2.1415 -(* same proof as e_less_le *)
  2.1416 -by (rtac le_exists 1);
  2.1417 -by (assume_tac 1);
  2.1418 -by (asm_simp_tac(simpset() addsimps[emb_e_less_add]) 1);
  2.1419 -by (assume_tac 1);
  2.1420 -qed "emb_e_less";
  2.1421 -
  2.1422 -Goal "[|f=f'; g=g'|] ==> f O g = f' O g'";
  2.1423 -by (Asm_simp_tac 1);
  2.1424 -qed "comp_mono_eq";
  2.1425 -
  2.1426 -(* Typing, typing, typing, three irritating assumptions. Extra theorems
  2.1427 -   needed in proof, but no real difficulty. *)
  2.1428 -(* Note also the object-level implication for induction on k. This
  2.1429 -   must be removed later to allow the theorems to be used for simp. 
  2.1430 -   Therefore this theorem is only a lemma. *)
  2.1431 -
  2.1432 -Goal  (* e_less_split_add_lemma *)
  2.1433 -    "[| emb_chain(DD,ee); m \\<in> nat; n \\<in> nat; k \\<in> nat|] ==>  \
  2.1434 -\    n le k --> \
  2.1435 -\    e_less(DD,ee,m,m#+k) = e_less(DD,ee,m#+n,m#+k) O e_less(DD,ee,m,m#+n)";
  2.1436 -by (induct_tac "k" 1);
  2.1437 -by (asm_full_simp_tac(simpset() addsimps [e_less_eq, id_type RS id_comp]) 1);
  2.1438 -by (asm_simp_tac(ZF_ss addsimps[le_succ_iff]) 1);
  2.1439 -by (rtac impI 1);
  2.1440 -by (etac disjE 1);
  2.1441 -by (etac impE 1);
  2.1442 -by (assume_tac 1);
  2.1443 -by (asm_simp_tac(ZF_ss addsimps[add_succ_right, e_less_add, add_type,nat_succI]) 1);
  2.1444 -(* Again and again, simplification is a pain. When does it work, when not? *)
  2.1445 -by (stac e_less_le 1);
  2.1446 -brr[add_le_mono,nat_le_refl,add_type,nat_succI] 1;
  2.1447 -by (stac comp_assoc 1);
  2.1448 -brr[comp_mono_eq,refl] 1;
  2.1449 -by (asm_simp_tac(ZF_ss addsimps[e_less_eq,add_type,nat_succI]) 1);
  2.1450 -by (stac id_comp 1); (* simp cannot unify/inst right, use brr below(?). *)
  2.1451 -by (REPEAT (ares_tac [emb_e_less_add RS emb_cont RS cont_fun, refl,
  2.1452 -		      nat_succI] 1));
  2.1453 -qed "e_less_split_add_lemma";
  2.1454 -
  2.1455 -Goal "[| n le k; emb_chain(DD,ee); m \\<in> nat; n \\<in> nat; k \\<in> nat|] ==>  \
  2.1456 -\     e_less(DD,ee,m,m#+k) = e_less(DD,ee,m#+n,m#+k) O e_less(DD,ee,m,m#+n)";
  2.1457 -by (blast_tac (claset() addIs [e_less_split_add_lemma RS mp]) 1);
  2.1458 -qed "e_less_split_add";
  2.1459 -
  2.1460 -Goalw [e_gr_def]  (* e_gr_eq *)
  2.1461 -    "m \\<in> nat ==> e_gr(DD,ee,m,m) = id(set(DD`m))";
  2.1462 -by (asm_simp_tac (simpset() addsimps[diff_self_eq_0]) 1);
  2.1463 -qed "e_gr_eq";
  2.1464 -
  2.1465 -Goalw [e_gr_def] (* e_gr_add *)
  2.1466 -    "[|n \\<in> nat; k \\<in> nat|] ==>    \
  2.1467 -\         e_gr(DD,ee,succ(n#+k),n) =   \
  2.1468 -\         e_gr(DD,ee,n#+k,n) O Rp(DD`(n#+k),DD`succ(n#+k),ee`(n#+k))";
  2.1469 -by (asm_simp_tac (simpset() addsimps [lemma_succ_sub,diff_add_inverse]) 1);
  2.1470 -qed "e_gr_add";
  2.1471 -
  2.1472 -Goal "[|n le m; m \\<in> nat; n \\<in> nat|] ==>   \
  2.1473 -\    e_gr(DD,ee,succ(m),n) = e_gr(DD,ee,m,n) O Rp(DD`m,DD`succ(m),ee`m)";
  2.1474 -by (etac le_exists 1);
  2.1475 -by (asm_simp_tac(simpset() addsimps[e_gr_add]) 1);
  2.1476 -by (REPEAT (assume_tac 1));
  2.1477 -qed "e_gr_le";
  2.1478 -
  2.1479 -Goal "m \\<in> nat ==>   \
  2.1480 -\    e_gr(DD,ee,succ(m),m) = id(set(DD`m)) O Rp(DD`m,DD`succ(m),ee`m)";
  2.1481 -by (asm_simp_tac(simpset() addsimps[e_gr_le,e_gr_eq]) 1);
  2.1482 -qed "e_gr_succ";
  2.1483 -
  2.1484 -(* Cpo asm's due to THE uniqueness. *)
  2.1485 -
  2.1486 -Goal "[|emb_chain(DD,ee); m \\<in> nat|] ==>   \
  2.1487 -\    e_gr(DD,ee,succ(m),m) = Rp(DD`m,DD`succ(m),ee`m)";
  2.1488 -by (asm_simp_tac(simpset() addsimps[e_gr_succ]) 1);
  2.1489 -by (blast_tac (claset() addIs [id_comp, Rp_cont,cont_fun,
  2.1490 -			       emb_chain_cpo,emb_chain_emb])  1);
  2.1491 -qed "e_gr_succ_emb";
  2.1492 -
  2.1493 -Goal  (* e_gr_fun_add *)
  2.1494 -    "[|emb_chain(DD,ee); n \\<in> nat; k \\<in> nat|] ==>   \
  2.1495 -\    e_gr(DD,ee,n#+k,n): set(DD`(n#+k))->set(DD`n)";
  2.1496 -by (induct_tac "k" 1);
  2.1497 -by (asm_simp_tac(simpset() addsimps[e_gr_eq,id_type]) 1);
  2.1498 -by (asm_simp_tac(simpset() addsimps[e_gr_add]) 1);
  2.1499 -brr[comp_fun, Rp_cont, cont_fun, emb_chain_emb, emb_chain_cpo, add_type, nat_succI] 1;
  2.1500 -qed "e_gr_fun_add";
  2.1501 -
  2.1502 -Goal  (* e_gr_fun *)
  2.1503 -    "[|n le m; emb_chain(DD,ee); m \\<in> nat; n \\<in> nat|] ==>   \
  2.1504 -\    e_gr(DD,ee,m,n): set(DD`m)->set(DD`n)";
  2.1505 -by (rtac le_exists 1);
  2.1506 -by (assume_tac 1);
  2.1507 -by (asm_simp_tac(simpset() addsimps[e_gr_fun_add]) 1);
  2.1508 -by (REPEAT (assume_tac 1));
  2.1509 -qed "e_gr_fun";
  2.1510 -
  2.1511 -Goal  (* e_gr_split_add_lemma *)
  2.1512 -    "[| emb_chain(DD,ee); m \\<in> nat; n \\<in> nat; k \\<in> nat|] ==>  \
  2.1513 -\    m le k --> \
  2.1514 -\    e_gr(DD,ee,n#+k,n) = e_gr(DD,ee,n#+m,n) O e_gr(DD,ee,n#+k,n#+m)";
  2.1515 -by (induct_tac "k" 1);
  2.1516 -by (rtac impI 1);
  2.1517 -by (asm_full_simp_tac(simpset() addsimps
  2.1518 -		      [le0_iff, e_gr_eq, id_type RS comp_id]) 1);
  2.1519 -by (asm_simp_tac(ZF_ss addsimps[le_succ_iff]) 1);
  2.1520 -by (rtac impI 1);
  2.1521 -by (etac disjE 1);
  2.1522 -by (etac impE 1);
  2.1523 -by (assume_tac 1);
  2.1524 -by (asm_simp_tac(ZF_ss addsimps[add_succ_right, e_gr_add, add_type,nat_succI]) 1);
  2.1525 -(* Again and again, simplification is a pain. When does it work, when not? *)
  2.1526 -by (stac e_gr_le 1);
  2.1527 -brr[add_le_mono,nat_le_refl,add_type,nat_succI] 1;
  2.1528 -by (stac comp_assoc 1);
  2.1529 -brr[comp_mono_eq,refl] 1;
  2.1530 -(* New direct subgoal *)
  2.1531 -by (asm_simp_tac(ZF_ss addsimps[e_gr_eq,add_type,nat_succI]) 1);
  2.1532 -by (stac comp_id 1); (* simp cannot unify/inst right, use brr below(?). *)
  2.1533 -by (REPEAT (ares_tac [e_gr_fun,add_type,refl,add_le_self,nat_succI] 1));
  2.1534 -qed "e_gr_split_add_lemma";
  2.1535 -
  2.1536 -Goal "[| m le k; emb_chain(DD,ee); m \\<in> nat; n \\<in> nat; k \\<in> nat|] ==>  \
  2.1537 -\     e_gr(DD,ee,n#+k,n) = e_gr(DD,ee,n#+m,n) O e_gr(DD,ee,n#+k,n#+m)";
  2.1538 -by (blast_tac (claset() addIs [e_gr_split_add_lemma RS mp]) 1);
  2.1539 -qed "e_gr_split_add";
  2.1540 -
  2.1541 -Goal "[|m le n; emb_chain(DD,ee); m \\<in> nat; n \\<in> nat|] ==>   \
  2.1542 -\     e_less(DD,ee,m,n):cont(DD`m,DD`n)";
  2.1543 -by (blast_tac (claset() addIs [emb_cont, emb_e_less]) 1);
  2.1544 -qed "e_less_cont";
  2.1545 -
  2.1546 -Goal  (* e_gr_cont *)
  2.1547 -    "[|n le m; emb_chain(DD,ee); m \\<in> nat; n \\<in> nat|] ==>   \
  2.1548 -\    e_gr(DD,ee,m,n):cont(DD`m,DD`n)";
  2.1549 -by (etac rev_mp 1);
  2.1550 -by (induct_tac "m" 1);
  2.1551 -by (asm_full_simp_tac(simpset() addsimps [le0_iff,e_gr_eq,nat_0I]) 1);
  2.1552 -brr[impI,id_cont,emb_chain_cpo,nat_0I] 1;
  2.1553 -by (asm_full_simp_tac(simpset() addsimps[le_succ_iff]) 1);
  2.1554 -by (etac disjE 1);
  2.1555 -by (etac impE 1);
  2.1556 -by (assume_tac 1);
  2.1557 -by (asm_simp_tac(simpset() addsimps[e_gr_le]) 1);
  2.1558 -brr[comp_pres_cont,Rp_cont,emb_chain_cpo,emb_chain_emb,nat_succI] 1;
  2.1559 -by (asm_simp_tac(simpset() addsimps[e_gr_eq,nat_succI]) 1);
  2.1560 -by (auto_tac (claset() addIs [id_cont,emb_chain_cpo], simpset()));
  2.1561 -qed "e_gr_cont";
  2.1562 -
  2.1563 -(* Considerably shorter.... 57 against 26 *)
  2.1564 -
  2.1565 -Goal  (* e_less_e_gr_split_add *)
  2.1566 -    "[|n le k; emb_chain(DD,ee); m \\<in> nat; n \\<in> nat; k \\<in> nat|] ==>   \
  2.1567 -\    e_less(DD,ee,m,m#+n) = e_gr(DD,ee,m#+k,m#+n) O e_less(DD,ee,m,m#+k)";
  2.1568 -(* Use mp to prepare for induction. *)
  2.1569 -by (etac rev_mp 1);
  2.1570 -by (induct_tac "k" 1);
  2.1571 -by (asm_full_simp_tac(simpset() addsimps
  2.1572 -		      [e_gr_eq, e_less_eq, id_type RS id_comp]) 1);
  2.1573 -by (simp_tac(ZF_ss addsimps[le_succ_iff]) 1);
  2.1574 -by (rtac impI 1);
  2.1575 -by (etac disjE 1);
  2.1576 -by (etac impE 1);
  2.1577 -by (assume_tac 1);
  2.1578 -by (asm_simp_tac(ZF_ss addsimps[add_succ_right, e_gr_le, e_less_le, add_le_self,nat_le_refl,add_le_mono,add_type]) 1);
  2.1579 -by (stac comp_assoc 1);
  2.1580 -by (res_inst_tac[("s1","ee`(m#+x)")](comp_assoc RS subst) 1);
  2.1581 -by (stac embRp_eq 1);
  2.1582 -brr[emb_chain_emb,add_type,emb_chain_cpo,nat_succI] 1;
  2.1583 -by (stac id_comp 1);
  2.1584 -brr[e_less_cont RS cont_fun, add_type,add_le_self,refl] 1;
  2.1585 -by (asm_full_simp_tac(ZF_ss addsimps[e_gr_eq,nat_succI,add_type]) 1);
  2.1586 -by (stac id_comp 1);
  2.1587 -by (REPEAT (ares_tac [e_less_cont RS cont_fun, add_type,
  2.1588 -		      nat_succI,add_le_self,refl] 1));
  2.1589 -qed "e_less_e_gr_split_add";
  2.1590 -
  2.1591 -(* Again considerably shorter, and easy to obtain from the previous thm. *)
  2.1592 -
  2.1593 -Goal  (* e_gr_e_less_split_add *)
  2.1594 -    "[|m le k; emb_chain(DD,ee); m \\<in> nat; n \\<in> nat; k \\<in> nat|] ==>   \
  2.1595 -\    e_gr(DD,ee,n#+m,n) = e_gr(DD,ee,n#+k,n) O e_less(DD,ee,n#+m,n#+k)";
  2.1596 -(* Use mp to prepare for induction. *)
  2.1597 -by (etac rev_mp 1);
  2.1598 -by (induct_tac "k" 1);
  2.1599 -by (asm_full_simp_tac(simpset() addsimps
  2.1600 -		      [e_gr_eq, e_less_eq, id_type RS id_comp]) 1);
  2.1601 -by (simp_tac(ZF_ss addsimps[le_succ_iff]) 1);
  2.1602 -by (rtac impI 1);
  2.1603 -by (etac disjE 1);
  2.1604 -by (etac impE 1);
  2.1605 -by (assume_tac 1);
  2.1606 -by (asm_simp_tac(ZF_ss addsimps[add_succ_right, e_gr_le, e_less_le, add_le_self,nat_le_refl,add_le_mono,add_type]) 1);
  2.1607 -by (stac comp_assoc 1);
  2.1608 -by (res_inst_tac[("s1","ee`(n#+x)")](comp_assoc RS subst) 1);
  2.1609 -by (stac embRp_eq 1);
  2.1610 -brr[emb_chain_emb,add_type,emb_chain_cpo,nat_succI] 1;
  2.1611 -by (stac id_comp 1);
  2.1612 -brr[e_less_cont RS cont_fun, add_type, add_le_mono, nat_le_refl, refl] 1;
  2.1613 -by (asm_full_simp_tac(ZF_ss addsimps[e_less_eq,nat_succI,add_type]) 1);
  2.1614 -by (stac comp_id 1);
  2.1615 -by (REPEAT (ares_tac [e_gr_cont RS cont_fun, add_type,nat_succI,add_le_self,
  2.1616 -		      refl] 1));
  2.1617 -qed "e_gr_e_less_split_add";
  2.1618 -
  2.1619 -
  2.1620 -Goalw [eps_def]  (* emb_eps *)
  2.1621 -    "[|m le n; emb_chain(DD,ee); m \\<in> nat; n \\<in> nat|] ==>   \
  2.1622 -\    emb(DD`m,DD`n,eps(DD,ee,m,n))";
  2.1623 -by (asm_simp_tac(simpset()) 1);
  2.1624 -brr[emb_e_less] 1;
  2.1625 -qed "emb_eps";
  2.1626 -
  2.1627 -Goalw [eps_def]  (* eps_fun *)
  2.1628 -    "[|emb_chain(DD,ee); m \\<in> nat; n \\<in> nat|] ==>   \
  2.1629 -\    eps(DD,ee,m,n): set(DD`m)->set(DD`n)";
  2.1630 -by (rtac (split_if RS iffD2) 1);
  2.1631 -by Safe_tac;
  2.1632 -brr[e_less_cont RS cont_fun] 1;
  2.1633 -by (auto_tac (claset() addIs [not_le_iff_lt RS iffD1 RS leI, e_gr_fun,nat_into_Ord], simpset()));
  2.1634 -qed "eps_fun";
  2.1635 -
  2.1636 -Goalw [eps_def] "n \\<in> nat ==> eps(DD,ee,n,n) = id(set(DD`n))";
  2.1637 -by (asm_simp_tac(simpset() addsimps [e_less_eq]) 1);
  2.1638 -qed "eps_id";
  2.1639 -
  2.1640 -Goalw [eps_def]
  2.1641 -    "[|m \\<in> nat; n \\<in> nat|] ==> eps(DD,ee,m,m#+n) = e_less(DD,ee,m,m#+n)";
  2.1642 -by (asm_simp_tac(simpset() addsimps [add_le_self]) 1);
  2.1643 -qed "eps_e_less_add";
  2.1644 -
  2.1645 -Goalw [eps_def]
  2.1646 -    "[|m le n; m \\<in> nat; n \\<in> nat|] ==> eps(DD,ee,m,n) = e_less(DD,ee,m,n)";
  2.1647 -by (Asm_simp_tac 1);
  2.1648 -qed "eps_e_less";
  2.1649 -
  2.1650 -Goalw [eps_def]  (* eps_e_gr_add *)
  2.1651 -    "[|n \\<in> nat; k \\<in> nat|] ==> eps(DD,ee,n#+k,n) = e_gr(DD,ee,n#+k,n)";
  2.1652 -by (rtac (split_if RS iffD2) 1);
  2.1653 -by Safe_tac;
  2.1654 -by (etac leE 1);
  2.1655 -by (asm_simp_tac(simpset() addsimps[e_less_eq,e_gr_eq]) 2);
  2.1656 -(* Must control rewriting by instantiating a variable. *)
  2.1657 -by (asm_full_simp_tac
  2.1658 -    (simpset() addsimps
  2.1659 -     [inst "i1" "n" (nat_into_Ord RS not_le_iff_lt RS iff_sym),
  2.1660 -      add_le_self]) 1);
  2.1661 -qed "eps_e_gr_add";
  2.1662 -
  2.1663 -Goal  (* eps_e_gr *)
  2.1664 -    "[|n le m; m \\<in> nat; n \\<in> nat|] ==> eps(DD,ee,m,n) = e_gr(DD,ee,m,n)";
  2.1665 -by (rtac le_exists 1);
  2.1666 -by (assume_tac 1);
  2.1667 -by (asm_simp_tac(simpset() addsimps[eps_e_gr_add]) 1);
  2.1668 -by (REPEAT (assume_tac 1));
  2.1669 -qed "eps_e_gr";
  2.1670 -
  2.1671 -val prems = Goal  (* eps_succ_ee *)
  2.1672 -    "[|!!n. n \\<in> nat ==> emb(DD`n,DD`succ(n),ee`n); m \\<in> nat|] ==>  \
  2.1673 -\    eps(DD,ee,m,succ(m)) = ee`m";
  2.1674 -by (asm_simp_tac(simpset() addsimps eps_e_less::le_succ_iff::e_less_succ_emb::
  2.1675 -   prems) 1);
  2.1676 -qed "eps_succ_ee";
  2.1677 -
  2.1678 -Goal  (* eps_succ_Rp *)
  2.1679 -    "[|emb_chain(DD,ee); m \\<in> nat|] ==>  \
  2.1680 -\    eps(DD,ee,succ(m),m) = Rp(DD`m,DD`succ(m),ee`m)";
  2.1681 -by (asm_simp_tac(simpset() addsimps eps_e_gr::le_succ_iff::e_gr_succ_emb::
  2.1682 -   prems) 1);
  2.1683 -qed "eps_succ_Rp";
  2.1684 -
  2.1685 -Goal  (* eps_cont *)
  2.1686 -    "[|emb_chain(DD,ee); m \\<in> nat; n \\<in> nat|] ==> eps(DD,ee,m,n): cont(DD`m,DD`n)";
  2.1687 -by (res_inst_tac [("i","m"),("j","n")] nat_linear_le 1);
  2.1688 -by (ALLGOALS (asm_simp_tac(simpset() addsimps [eps_e_less,e_less_cont,
  2.1689 -					       eps_e_gr,e_gr_cont])));     
  2.1690 -qed "eps_cont";
  2.1691 -
  2.1692 -(* Theorems about splitting. *)
  2.1693 -
  2.1694 -Goal  (* eps_split_add_left *)
  2.1695 -    "[|n le k; emb_chain(DD,ee); m \\<in> nat; n \\<in> nat; k \\<in> nat|] ==>  \
  2.1696 -\    eps(DD,ee,m,m#+k) = eps(DD,ee,m#+n,m#+k) O eps(DD,ee,m,m#+n)";
  2.1697 -by (asm_simp_tac(simpset() addsimps 
  2.1698 -    [eps_e_less,add_le_self,add_le_mono]) 1);
  2.1699 -by (auto_tac (claset() addIs [e_less_split_add], simpset()));
  2.1700 -qed "eps_split_add_left";
  2.1701 -
  2.1702 -Goal  (* eps_split_add_left_rev *)
  2.1703 -    "[|n le k; emb_chain(DD,ee); m \\<in> nat; n \\<in> nat; k \\<in> nat|] ==>  \
  2.1704 -\    eps(DD,ee,m,m#+n) = eps(DD,ee,m#+k,m#+n) O eps(DD,ee,m,m#+k)";
  2.1705 -by (asm_simp_tac(simpset() addsimps 
  2.1706 -    [eps_e_less_add,eps_e_gr,add_le_self,add_le_mono]) 1);
  2.1707 -by (auto_tac (claset() addIs [e_less_e_gr_split_add], simpset()));
  2.1708 -qed "eps_split_add_left_rev";
  2.1709 -
  2.1710 -Goal  (* eps_split_add_right *)
  2.1711 -    "[|m le k; emb_chain(DD,ee); m \\<in> nat; n \\<in> nat; k \\<in> nat|] ==>  \
  2.1712 -\    eps(DD,ee,n#+k,n) = eps(DD,ee,n#+m,n) O eps(DD,ee,n#+k,n#+m)";
  2.1713 -by (asm_simp_tac(simpset() addsimps 
  2.1714 -    [eps_e_gr,add_le_self,add_le_mono]) 1);
  2.1715 -by (auto_tac (claset() addIs [e_gr_split_add], simpset()));
  2.1716 -qed "eps_split_add_right";
  2.1717 -
  2.1718 -Goal  (* eps_split_add_right_rev *)
  2.1719 -    "[|m le k; emb_chain(DD,ee); m \\<in> nat; n \\<in> nat; k \\<in> nat|] ==>  \
  2.1720 -\    eps(DD,ee,n#+m,n) = eps(DD,ee,n#+k,n) O eps(DD,ee,n#+m,n#+k)";
  2.1721 -by (asm_simp_tac(simpset() addsimps 
  2.1722 -    [eps_e_gr_add,eps_e_less,add_le_self,add_le_mono]) 1);
  2.1723 -by (auto_tac (claset() addIs [e_gr_e_less_split_add], simpset()));
  2.1724 -qed "eps_split_add_right_rev";
  2.1725 -
  2.1726 -(* Arithmetic *)
  2.1727 -
  2.1728 -val [prem1,prem2,prem3,prem4] = Goal
  2.1729 -    "[| n le k; k le m;  \
  2.1730 -\       !!p q. [|p le q; k=n#+p; m=n#+q; p \\<in> nat; q \\<in> nat|] ==> R; \
  2.1731 -\       m \\<in> nat |]==>R";
  2.1732 -by (rtac (prem1 RS le_exists) 1);
  2.1733 -by (simp_tac (simpset() addsimps [prem2 RS lt_nat_in_nat, prem4]) 2);
  2.1734 -by (rtac ([prem1,prem2] MRS le_trans RS le_exists) 1);
  2.1735 -by (rtac prem4 2);
  2.1736 -by (rtac prem3 1);
  2.1737 -by (assume_tac 2);
  2.1738 -by (assume_tac 2);
  2.1739 -by (cut_facts_tac [prem1,prem2] 1);
  2.1740 -by Auto_tac;
  2.1741 -qed "le_exists_lemma";
  2.1742 -
  2.1743 -Goal  (* eps_split_left_le *)
  2.1744 -    "[|m le k; k le n; emb_chain(DD,ee); m \\<in> nat; n \\<in> nat; k \\<in> nat|] ==>  \
  2.1745 -\    eps(DD,ee,m,n) = eps(DD,ee,k,n) O eps(DD,ee,m,k)";
  2.1746 -by (rtac le_exists_lemma 1);
  2.1747 -by (REPEAT (assume_tac 1));
  2.1748 -by (Asm_simp_tac 1);
  2.1749 -by (auto_tac (claset() addIs [eps_split_add_left], simpset()));
  2.1750 -qed "eps_split_left_le";
  2.1751 -
  2.1752 -Goal  (* eps_split_left_le_rev *)
  2.1753 -    "[|m le n; n le k; emb_chain(DD,ee); m \\<in> nat; n \\<in> nat; k \\<in> nat|] ==>  \
  2.1754 -\    eps(DD,ee,m,n) = eps(DD,ee,k,n) O eps(DD,ee,m,k)";
  2.1755 -by (rtac le_exists_lemma 1);
  2.1756 -by (REPEAT (assume_tac 1));
  2.1757 -by (Asm_simp_tac 1);
  2.1758 -by (auto_tac (claset() addIs [eps_split_add_left_rev], simpset()));
  2.1759 -qed "eps_split_left_le_rev";
  2.1760 -
  2.1761 -Goal  (* eps_split_right_le *)
  2.1762 -    "[|n le k; k le m; emb_chain(DD,ee); m \\<in> nat; n \\<in> nat; k \\<in> nat|] ==>  \
  2.1763 -\    eps(DD,ee,m,n) = eps(DD,ee,k,n) O eps(DD,ee,m,k)";
  2.1764 -by (rtac le_exists_lemma 1);
  2.1765 -by (REPEAT (assume_tac 1));
  2.1766 -by (Asm_simp_tac 1);
  2.1767 -by (auto_tac (claset() addIs [eps_split_add_right], simpset()));
  2.1768 -qed "eps_split_right_le";
  2.1769 -
  2.1770 -Goal  (* eps_split_right_le_rev *)
  2.1771 -    "[|n le m; m le k; emb_chain(DD,ee); m \\<in> nat; n \\<in> nat; k \\<in> nat|] ==>  \
  2.1772 -\    eps(DD,ee,m,n) = eps(DD,ee,k,n) O eps(DD,ee,m,k)";
  2.1773 -by (rtac le_exists_lemma 1);
  2.1774 -by (REPEAT (assume_tac 1));
  2.1775 -by (Asm_simp_tac 1);
  2.1776 -by (auto_tac (claset() addIs [eps_split_add_right_rev], simpset()));
  2.1777 -qed "eps_split_right_le_rev";
  2.1778 -
  2.1779 -(* The desired two theorems about `splitting'. *)
  2.1780 -
  2.1781 -Goal  (* eps_split_left *)
  2.1782 -    "[|m le k; emb_chain(DD,ee); m \\<in> nat; n \\<in> nat; k \\<in> nat|] ==>  \
  2.1783 -\    eps(DD,ee,m,n) = eps(DD,ee,k,n) O eps(DD,ee,m,k)";
  2.1784 -by (rtac nat_linear_le 1);
  2.1785 -by (rtac eps_split_right_le_rev 4);
  2.1786 -by (assume_tac 4);
  2.1787 -by (rtac nat_linear_le 3);
  2.1788 -by (rtac eps_split_left_le 5);
  2.1789 -by (assume_tac 6);
  2.1790 -by (rtac eps_split_left_le_rev 10);
  2.1791 -by (REPEAT (assume_tac 1)); (* 20 trivial subgoals *)
  2.1792 -qed "eps_split_left";
  2.1793 -
  2.1794 -Goal  (* eps_split_right *)
  2.1795 -    "[|n le k; emb_chain(DD,ee); m \\<in> nat; n \\<in> nat; k \\<in> nat|] ==>  \
  2.1796 -\    eps(DD,ee,m,n) = eps(DD,ee,k,n) O eps(DD,ee,m,k)";
  2.1797 -by (rtac nat_linear_le 1);
  2.1798 -by (rtac eps_split_left_le_rev 3);
  2.1799 -by (assume_tac 3);
  2.1800 -by (rtac nat_linear_le 8);
  2.1801 -by (rtac eps_split_right_le 10);
  2.1802 -by (assume_tac 11);
  2.1803 -by (rtac eps_split_right_le_rev 15);
  2.1804 -by (REPEAT (assume_tac 1)); (* 20 trivial subgoals *)
  2.1805 -qed "eps_split_right";
  2.1806 -
  2.1807 -(*----------------------------------------------------------------------*)
  2.1808 -(* That was eps: D_m -> D_n, NEXT rho_emb: D_n -> Dinf.                 *)
  2.1809 -(*----------------------------------------------------------------------*)
  2.1810 -
  2.1811 -(* Considerably shorter. *)
  2.1812 -
  2.1813 -Goalw [rho_emb_def] (* rho_emb_fun *)
  2.1814 -    "[|emb_chain(DD,ee); n \\<in> nat|] ==>   \
  2.1815 -\    rho_emb(DD,ee,n): set(DD`n) -> set(Dinf(DD,ee))";
  2.1816 -brr[lam_type, DinfI, eps_cont RS cont_fun RS apply_type] 1;
  2.1817 -by (Asm_simp_tac 1);
  2.1818 -by (res_inst_tac [("i","succ(na)"),("j","n")] nat_linear_le 1);
  2.1819 -by (Blast_tac 1);
  2.1820 -by (assume_tac 1);
  2.1821 -(* The easiest would be to apply add1 everywhere also in the assumptions, 
  2.1822 -   but since x le y is x<succ(y) simplification does too much with this thm. *)
  2.1823 -by (stac eps_split_right_le 1);
  2.1824 -by (assume_tac 2);
  2.1825 -by (asm_simp_tac(FOL_ss addsimps [add1]) 1);
  2.1826 -brr[add_le_self,nat_0I,nat_succI] 1;
  2.1827 -by (asm_simp_tac(simpset() addsimps[eps_succ_Rp]) 1);
  2.1828 -by (stac comp_fun_apply 1);
  2.1829 -brr[eps_fun, nat_succI, Rp_cont RS cont_fun, emb_chain_emb, emb_chain_cpo,refl] 1;
  2.1830 -(* Now the second part of the proof. Slightly different than HOL. *)
  2.1831 -by (asm_simp_tac(simpset() addsimps[eps_e_less,nat_succI]) 1);
  2.1832 -by (etac (le_iff RS iffD1 RS disjE) 1);
  2.1833 -by (asm_simp_tac(simpset() addsimps[e_less_le]) 1);
  2.1834 -by (stac comp_fun_apply 1);
  2.1835 -brr[e_less_cont,cont_fun,emb_chain_emb,emb_cont] 1;
  2.1836 -by (stac embRp_eq_thm 1);
  2.1837 -brr[emb_chain_emb, e_less_cont RS cont_fun RS apply_type, emb_chain_cpo, nat_succI] 1;
  2.1838 -by (asm_simp_tac(simpset() addsimps[eps_e_less]) 1);
  2.1839 -by (dtac asm_rl 1);
  2.1840 -by (asm_full_simp_tac(simpset() addsimps[eps_succ_Rp, e_less_eq, id_conv, nat_succI]) 1);
  2.1841 -qed "rho_emb_fun";
  2.1842 -
  2.1843 -Goalw [rho_emb_def]
  2.1844 -    "x \\<in> set(DD`n) ==> rho_emb(DD,ee,n)`x = (\\<lambda>m \\<in> nat. eps(DD,ee,n,m)`x)";
  2.1845 -by (Asm_simp_tac 1);
  2.1846 -qed "rho_emb_apply1";
  2.1847 -
  2.1848 -Goalw [rho_emb_def]
  2.1849 -    "[|x \\<in> set(DD`n); m \\<in> nat|] ==> rho_emb(DD,ee,n)`x`m = eps(DD,ee,n,m)`x";
  2.1850 -by (Asm_simp_tac 1);
  2.1851 -qed "rho_emb_apply2";
  2.1852 -
  2.1853 -Goal "[| x \\<in> set(DD`n); n \\<in> nat|] ==> rho_emb(DD,ee,n)`x`n = x";
  2.1854 -by (asm_simp_tac(simpset() addsimps[rho_emb_apply2,eps_id]) 1);
  2.1855 -qed "rho_emb_id";
  2.1856 -
  2.1857 -(* Shorter proof, 23 against 62. *)
  2.1858 -
  2.1859 -Goal (* rho_emb_cont *)
  2.1860 -    "[|emb_chain(DD,ee); n \\<in> nat|] ==>   \
  2.1861 -\    rho_emb(DD,ee,n): cont(DD`n,Dinf(DD,ee))";
  2.1862 -by (rtac contI 1);
  2.1863 -brr[rho_emb_fun] 1;
  2.1864 -by (rtac rel_DinfI 1);
  2.1865 -by (SELECT_GOAL(rewtac rho_emb_def) 1);
  2.1866 -by (Asm_simp_tac 1);
  2.1867 -brr[eps_cont RS cont_mono, Dinf_prod,apply_type,rho_emb_fun] 1;
  2.1868 -(* Continuity, different order, slightly different proofs. *)
  2.1869 -by (stac lub_Dinf 1);
  2.1870 -by (rtac chainI 1);
  2.1871 -brr[lam_type, rho_emb_fun RS apply_type, chain_in] 1;
  2.1872 -by (Asm_simp_tac 1);
  2.1873 -by (rtac rel_DinfI 1);
  2.1874 -by (asm_simp_tac(simpset() addsimps [rho_emb_apply2,chain_in]) 1);
  2.1875 -brr[eps_cont RS cont_mono, chain_rel, Dinf_prod, rho_emb_fun RS apply_type, chain_in,nat_succI] 1;
  2.1876 -(* Now, back to the result of applying lub_Dinf *)
  2.1877 -by (asm_simp_tac(simpset() addsimps [rho_emb_apply2,chain_in]) 1);
  2.1878 -by (stac rho_emb_apply1 1);
  2.1879 -brr[cpo_lub RS islub_in, emb_chain_cpo] 1;
  2.1880 -by (rtac fun_extension 1);
  2.1881 -brr[lam_type, eps_cont RS cont_fun RS apply_type, cpo_lub RS islub_in, emb_chain_cpo] 1;
  2.1882 -brr[cont_chain,eps_cont,emb_chain_cpo] 1;
  2.1883 -by (Asm_simp_tac 1);
  2.1884 -by (asm_simp_tac(simpset() addsimps[eps_cont RS cont_lub]) 1);
  2.1885 -qed "rho_emb_cont";
  2.1886 -
  2.1887 -(* 32 vs 61, using safe_tac with imp in asm would be unfortunate (5steps) *)
  2.1888 -
  2.1889 -Goal (* lemma1 *)
  2.1890 -    "[|m le n; emb_chain(DD,ee); x \\<in> set(Dinf(DD,ee)); m \\<in> nat; n \\<in> nat|] ==>   \
  2.1891 -\    rel(DD`n,e_less(DD,ee,m,n)`(x`m),x`n)";
  2.1892 -by (etac rev_mp 1);  (* For induction proof *)
  2.1893 -by (induct_tac "n" 1);
  2.1894 -by (rtac impI 1);
  2.1895 -by (asm_full_simp_tac (simpset() addsimps [e_less_eq]) 1);
  2.1896 -by (stac id_conv 1);
  2.1897 -brr[apply_type,Dinf_prod,cpo_refl,emb_chain_cpo,nat_0I] 1;
  2.1898 -by (asm_full_simp_tac (simpset() addsimps [le_succ_iff]) 1);
  2.1899 -by (rtac impI 1);
  2.1900 -by (etac disjE 1);
  2.1901 -by (dtac mp 1 THEN atac 1);
  2.1902 -by (rtac cpo_trans 1);
  2.1903 -by (stac e_less_le 2);
  2.1904 -brr[emb_chain_cpo,nat_succI] 1;
  2.1905 -by (stac comp_fun_apply 1);
  2.1906 -brr[emb_chain_emb RS emb_cont, e_less_cont, cont_fun, apply_type, Dinf_prod] 1;
  2.1907 -by (res_inst_tac[("y","x`xa")](emb_chain_emb RS emb_cont RS cont_mono) 1);
  2.1908 -brr[e_less_cont RS cont_fun, apply_type,Dinf_prod] 1;
  2.1909 -by (res_inst_tac[("x1","x"),("n1","xa")](Dinf_eq RS subst) 1);
  2.1910 -by (rtac (comp_fun_apply RS subst) 3);
  2.1911 -by (res_inst_tac
  2.1912 -  [("P",
  2.1913 -    "%z. rel(DD ` succ(xa), \
  2.1914 -\    (ee ` xa O Rp(?DD46(xa) ` xa,?DD46(xa) ` succ(xa),?ee46(xa) ` xa)) ` \
  2.1915 -\            (x ` succ(xa)),z)")](id_conv RS subst) 6);
  2.1916 -by (rtac rel_cf 7); 
  2.1917 -(* Dinf and cont_fun doesn't go well together, both Pi(_,%x._). *)
  2.1918 -(* brr solves 11 of 12 subgoals *)
  2.1919 -brr[Dinf_prod RS apply_type, cont_fun, Rp_cont, e_less_cont, emb_cont, emb_chain_emb, emb_chain_cpo, apply_type, embRp_rel, disjI1 RS (le_succ_iff RS iffD2), nat_succI] 1;
  2.1920 -by (asm_full_simp_tac (simpset() addsimps [e_less_eq]) 1);
  2.1921 -by (stac id_conv 1);
  2.1922 -by (auto_tac (claset() addIs [apply_type,Dinf_prod,emb_chain_cpo], simpset()));
  2.1923 -val lemma1 = result();
  2.1924 -
  2.1925 -(* 18 vs 40 *)
  2.1926 -
  2.1927 -Goal (* lemma2 *)
  2.1928 -    "[|n le m; emb_chain(DD,ee); x \\<in> set(Dinf(DD,ee)); m \\<in> nat; n \\<in> nat|] ==>   \
  2.1929 -\    rel(DD`n,e_gr(DD,ee,m,n)`(x`m),x`n)";
  2.1930 -by (etac rev_mp 1);  (* For induction proof *)
  2.1931 -by (induct_tac "m" 1);
  2.1932 -by (rtac impI 1);
  2.1933 -by (asm_full_simp_tac (simpset() addsimps [e_gr_eq]) 1);
  2.1934 -by (stac id_conv 1);
  2.1935 -brr[apply_type,Dinf_prod,cpo_refl,emb_chain_cpo,nat_0I] 1;
  2.1936 -by (asm_full_simp_tac (simpset() addsimps [le_succ_iff]) 1);
  2.1937 -by (rtac impI 1);
  2.1938 -by (etac disjE 1);
  2.1939 -by (dtac mp 1 THEN atac 1);
  2.1940 -by (stac e_gr_le 1);
  2.1941 -by (stac comp_fun_apply 4);
  2.1942 -by (stac Dinf_eq 7);
  2.1943 -brr[emb_chain_emb, emb_chain_cpo, Rp_cont, e_gr_cont, cont_fun, emb_cont, apply_type,Dinf_prod,nat_succI] 1;
  2.1944 -by (asm_full_simp_tac (simpset() addsimps [e_gr_eq]) 1);
  2.1945 -by (stac id_conv 1);
  2.1946 -by (auto_tac (claset() addIs [apply_type,Dinf_prod,emb_chain_cpo], simpset()));
  2.1947 -val lemma2 = result();
  2.1948 -
  2.1949 -Goalw [eps_def] (* eps1 *)
  2.1950 -    "[|emb_chain(DD,ee); x \\<in> set(Dinf(DD,ee)); m \\<in> nat; n \\<in> nat|] ==>   \
  2.1951 -\    rel(DD`n,eps(DD,ee,m,n)`(x`m),x`n)";
  2.1952 -by (split_tac [split_if] 1);
  2.1953 -brr[conjI, impI, lemma1, not_le_iff_lt RS iffD1 RS leI RS lemma2, nat_into_Ord] 1;
  2.1954 -qed "eps1";
  2.1955 -
  2.1956 -(* The following theorem is needed/useful due to type check for rel_cfI, 
  2.1957 -   but also elsewhere. 
  2.1958 -   Look for occurences of rel_cfI, rel_DinfI, etc to evaluate the problem. *)
  2.1959 -
  2.1960 -Goal (* lam_Dinf_cont *)
  2.1961 -  "[| emb_chain(DD,ee); n \\<in> nat |] ==> \
  2.1962 -\  (\\<lambda>x \\<in> set(Dinf(DD,ee)). x`n) \\<in> cont(Dinf(DD,ee),DD`n)";
  2.1963 -by (rtac contI 1);
  2.1964 -brr[lam_type,apply_type,Dinf_prod] 1;
  2.1965 -by (Asm_simp_tac 1);
  2.1966 -brr[rel_Dinf] 1;
  2.1967 -by (stac beta 1);
  2.1968 -by (auto_tac (claset() addIs [cpo_Dinf,islub_in,cpo_lub], simpset()));
  2.1969 -by (asm_simp_tac(simpset() addsimps[chain_in,lub_Dinf]) 1);
  2.1970 -qed "lam_Dinf_cont";
  2.1971 -
  2.1972 -Goalw  [rho_proj_def] (* rho_projpair *)
  2.1973 -    "[| emb_chain(DD,ee); n \\<in> nat |] ==> \
  2.1974 -\    projpair(DD`n,Dinf(DD,ee),rho_emb(DD,ee,n),rho_proj(DD,ee,n))";
  2.1975 -by (rtac projpairI 1);
  2.1976 -brr[rho_emb_cont] 1;
  2.1977 -(* lemma used, introduced because same fact needed below due to rel_cfI. *)
  2.1978 -brr[lam_Dinf_cont] 1;
  2.1979 -(*-----------------------------------------------*)
  2.1980 -(* This part is 7 lines, but 30 in HOL (75% reduction!) *)
  2.1981 -by (rtac fun_extension 1);
  2.1982 -by (stac id_conv 3);
  2.1983 -by (stac comp_fun_apply 4);
  2.1984 -by (stac beta 7);
  2.1985 -by (stac rho_emb_id 8);
  2.1986 -brr[comp_fun, id_type, lam_type, rho_emb_fun, Dinf_prod RS apply_type, apply_type,refl] 1;
  2.1987 -(*^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^*)
  2.1988 -by (rtac rel_cfI 1); (* ------------------>>>Yields type cond, not in HOL *)
  2.1989 -by (stac id_conv 1);
  2.1990 -by (stac comp_fun_apply 2);
  2.1991 -by (stac beta 5);
  2.1992 -by (stac rho_emb_apply1 6);
  2.1993 -by (rtac rel_DinfI 7); (* ------------------>>>Yields type cond, not in HOL *)
  2.1994 -by (stac beta 7);
  2.1995 -brr(eps1::lam_type::rho_emb_fun::eps_fun:: (* Dinf_prod bad with lam_type *)
  2.1996 -    [Dinf_prod RS apply_type, refl]) 1;
  2.1997 -brr[apply_type, eps_fun, Dinf_prod, comp_pres_cont, rho_emb_cont, lam_Dinf_cont,id_cont,cpo_Dinf,emb_chain_cpo] 1;
  2.1998 -qed "rho_projpair";
  2.1999 -
  2.2000 -Goalw [emb_def]
  2.2001 -  "[| emb_chain(DD,ee); n \\<in> nat |] ==> emb(DD`n,Dinf(DD,ee),rho_emb(DD,ee,n))";
  2.2002 -by (auto_tac (claset() addIs [exI,rho_projpair], simpset()));
  2.2003 -qed "emb_rho_emb";
  2.2004 -
  2.2005 -Goal "[| emb_chain(DD,ee); n \\<in> nat |] ==>   \
  2.2006 -\  rho_proj(DD,ee,n) \\<in> cont(Dinf(DD,ee),DD`n)";
  2.2007 -by (auto_tac (claset() addIs [rho_projpair,projpair_p_cont], simpset()));
  2.2008 -qed "rho_proj_cont";
  2.2009 -
  2.2010 -(*----------------------------------------------------------------------*)
  2.2011 -(* Commutivity and universality.                                        *)
  2.2012 -(*----------------------------------------------------------------------*)
  2.2013 -
  2.2014 -val prems = Goalw [commute_def]  (* commuteI *)
  2.2015 -  "[| !!n. n \\<in> nat ==> emb(DD`n,E,r(n));   \
  2.2016 -\     !!m n. [|m le n; m \\<in> nat; n \\<in> nat|] ==> r(n) O eps(DD,ee,m,n) = r(m) |] ==>  \
  2.2017 -\  commute(DD,ee,E,r)";
  2.2018 -by Safe_tac;
  2.2019 -by (REPEAT (ares_tac prems 1));
  2.2020 -qed "commuteI";
  2.2021 -
  2.2022 -Goalw [commute_def]  (* commute_emb *)
  2.2023 -  "[| commute(DD,ee,E,r); n \\<in> nat |] ==> emb(DD`n,E,r(n))";
  2.2024 -by (Fast_tac 1);
  2.2025 -qed "commute_emb";
  2.2026 -
  2.2027 -AddTCs [commute_emb];
  2.2028 -
  2.2029 -Goalw [commute_def]  (* commute_eq *)
  2.2030 -  "[| commute(DD,ee,E,r); m le n; m \\<in> nat; n \\<in> nat |] ==>   \
  2.2031 -\  r(n) O eps(DD,ee,m,n) = r(m) ";
  2.2032 -by (Blast_tac 1);
  2.2033 -qed "commute_eq";
  2.2034 -
  2.2035 -(* Shorter proof: 11 vs 46 lines. *)
  2.2036 -
  2.2037 -Goal (* rho_emb_commute *)
  2.2038 -  "emb_chain(DD,ee) ==> commute(DD,ee,Dinf(DD,ee),rho_emb(DD,ee))";
  2.2039 -by (rtac commuteI 1);
  2.2040 -brr[emb_rho_emb] 1;
  2.2041 -by (rtac fun_extension 1);       (* Manual instantiation in HOL. *)
  2.2042 -by (stac comp_fun_apply 3);
  2.2043 -by (rtac fun_extension 6); (* Next, clean up and instantiate unknowns *)
  2.2044 -brr[comp_fun,rho_emb_fun,eps_fun,Dinf_prod,apply_type] 1; 
  2.2045 -by (asm_simp_tac
  2.2046 -    (simpset() addsimps[rho_emb_apply2, eps_fun RS apply_type]) 1);
  2.2047 -by (rtac (comp_fun_apply RS subst) 1);
  2.2048 -by (rtac (eps_split_left RS subst) 4);
  2.2049 -by (auto_tac (claset() addIs [eps_fun], simpset()));
  2.2050 -qed "rho_emb_commute";
  2.2051 -
  2.2052 -val prems = goal Arith.thy "n \\<in> nat ==> n le succ(n)";
  2.2053 -by (REPEAT (ares_tac ((disjI1 RS(le_succ_iff RS iffD2))::le_refl::nat_into_Ord::prems) 1));
  2.2054 -qed "le_succ";
  2.2055 -
  2.2056 -(* Shorter proof: 21 vs 83 (106 - 23, due to OAssoc complication) *)
  2.2057 -
  2.2058 -Goal (* commute_chain *)
  2.2059 -  "[| commute(DD,ee,E,r); emb_chain(DD,ee); cpo(E) |] ==>  \
  2.2060 -\  chain(cf(E,E),\\<lambda>n \\<in> nat. r(n) O Rp(DD`n,E,r(n)))";
  2.2061 -by (rtac chainI 1);
  2.2062 -by (blast_tac (claset() addIs [lam_type, cont_cf, comp_pres_cont, commute_emb, Rp_cont, emb_cont, emb_chain_cpo]) 1);
  2.2063 -by (Asm_simp_tac 1);
  2.2064 -by (res_inst_tac[("r1","r"),("m1","n")](commute_eq RS subst) 1);
  2.2065 -brr[le_succ,nat_succI] 1;
  2.2066 -by (stac Rp_comp 1);
  2.2067 -brr[emb_eps,commute_emb,emb_chain_cpo,le_succ,nat_succI] 1;
  2.2068 -by (rtac (comp_assoc RS subst) 1);   (* Remember that comp_assoc is simpler in Isa *)
  2.2069 -by (res_inst_tac[("r1","r(succ(n))")](comp_assoc RS ssubst) 1);
  2.2070 -by (rtac comp_mono 1);
  2.2071 -by (REPEAT 
  2.2072 -    (blast_tac (claset() addIs [comp_pres_cont, eps_cont, emb_eps, 
  2.2073 -				commute_emb, Rp_cont, emb_cont, 
  2.2074 -				emb_chain_cpo,le_succ]) 1));
  2.2075 -by (res_inst_tac[("b","r(succ(n))")](comp_id RS subst) 1); (* 1 subst too much *)
  2.2076 -by (rtac comp_mono 2);
  2.2077 -by (REPEAT
  2.2078 -    (blast_tac (claset() addIs [comp_pres_cont, eps_cont, emb_eps, emb_id, 
  2.2079 -				commute_emb, Rp_cont, emb_cont, cont_fun,
  2.2080 -				emb_chain_cpo,le_succ]) 1));
  2.2081 -by (stac comp_id 1); (* Undoes "1 subst too much", typing next anyway *)
  2.2082 -by (REPEAT
  2.2083 -    (blast_tac (claset() addIs [cont_fun, Rp_cont, emb_cont, commute_emb, 
  2.2084 -				cont_cf, cpo_cf, emb_chain_cpo,
  2.2085 -				embRp_rel,emb_eps,le_succ]) 1));
  2.2086 -qed "commute_chain";
  2.2087 -
  2.2088 -Goal (* rho_emb_chain *)
  2.2089 -  "emb_chain(DD,ee) ==>  \
  2.2090 -\  chain(cf(Dinf(DD,ee),Dinf(DD,ee)),   \
  2.2091 -\        \\<lambda>n \\<in> nat. rho_emb(DD,ee,n) O Rp(DD`n,Dinf(DD,ee),rho_emb(DD,ee,n)))";
  2.2092 -by (auto_tac (claset() addIs [commute_chain,rho_emb_commute,cpo_Dinf], simpset()));
  2.2093 -qed "rho_emb_chain";
  2.2094 -
  2.2095 -Goal "[| emb_chain(DD,ee); x \\<in> set(Dinf(DD,ee)) |] ==>  \
  2.2096 -\     chain(Dinf(DD,ee),   \
  2.2097 -\         \\<lambda>n \\<in> nat.   \
  2.2098 -\          (rho_emb(DD,ee,n) O Rp(DD`n,Dinf(DD,ee),rho_emb(DD,ee,n)))`x)";
  2.2099 -by (dtac (rho_emb_chain RS chain_cf) 1);
  2.2100 -by (assume_tac 1);
  2.2101 -by (Asm_full_simp_tac 1);
  2.2102 -qed "rho_emb_chain_apply1";
  2.2103 -
  2.2104 -Goal "[| chain(iprod(DD),X); emb_chain(DD,ee); n \\<in> nat |] ==>  \
  2.2105 -\     chain(DD`n,\\<lambda>m \\<in> nat. X `m `n)";
  2.2106 -by (auto_tac (claset() addIs [chain_iprod,emb_chain_cpo], simpset()));
  2.2107 -qed "chain_iprod_emb_chain";
  2.2108 -
  2.2109 -Goal (* rho_emb_chain_apply2 *)
  2.2110 -  "[| emb_chain(DD,ee); x \\<in> set(Dinf(DD,ee)); n \\<in> nat |] ==>  \
  2.2111 -\  chain  \
  2.2112 -\   (DD`n,   \
  2.2113 -\    \\<lambda>xa \\<in> nat.  \
  2.2114 -\     (rho_emb(DD, ee, xa) O Rp(DD ` xa, Dinf(DD, ee),rho_emb(DD, ee, xa))) ` \
  2.2115 -\      x ` n)";
  2.2116 -by (forward_tac [rho_emb_chain_apply1 RS chain_Dinf RS chain_iprod_emb_chain] 1);
  2.2117 -by Auto_tac;
  2.2118 -qed "rho_emb_chain_apply2";
  2.2119 -
  2.2120 -(* Shorter proof: 32 vs 72 (roughly), Isabelle proof has lemmas. *)
  2.2121 -
  2.2122 -Goal (* rho_emb_lub *)
  2.2123 -  "emb_chain(DD,ee) ==>  \
  2.2124 -\  lub(cf(Dinf(DD,ee),Dinf(DD,ee)),   \
  2.2125 -\      \\<lambda>n \\<in> nat. rho_emb(DD,ee,n) O Rp(DD`n,Dinf(DD,ee),rho_emb(DD,ee,n))) = \
  2.2126 -\  id(set(Dinf(DD,ee)))";
  2.2127 -by (rtac cpo_antisym 1);
  2.2128 -by (rtac cpo_cf 1); (* Instantiate variable, continued below (would loop otherwise) *)
  2.2129 -brr[cpo_Dinf] 1; 
  2.2130 -by (rtac islub_least 1);
  2.2131 -brr[cpo_lub,rho_emb_chain,cpo_cf,cpo_Dinf,isubI,cont_cf,id_cont] 1;
  2.2132 -by (Asm_simp_tac 1);
  2.2133 -brr[embRp_rel,emb_rho_emb,emb_chain_cpo,cpo_Dinf] 1;
  2.2134 -by (rtac rel_cfI 1);
  2.2135 -by (asm_simp_tac (simpset() addsimps[lub_cf,rho_emb_chain,cpo_Dinf]) 1);
  2.2136 -by (rtac rel_DinfI 1); (* Addtional assumptions *)
  2.2137 -by (stac lub_Dinf 1);
  2.2138 -brr[rho_emb_chain_apply1] 1;  
  2.2139 -brr[Dinf_prod, cpo_lub RS islub_in, id_cont, cpo_Dinf, cpo_cf, cf_cont, rho_emb_chain, rho_emb_chain_apply1, id_cont RS cont_cf] 2;
  2.2140 -by (Asm_simp_tac 1);
  2.2141 -by (rtac dominate_islub 1);
  2.2142 -by (rtac cpo_lub 3);
  2.2143 -brr[rho_emb_chain_apply2,emb_chain_cpo] 3;
  2.2144 -by (res_inst_tac[("x1","x`n")](chain_const RS chain_fun) 3);
  2.2145 -brr[islub_const, apply_type, Dinf_prod, emb_chain_cpo, chain_fun, rho_emb_chain_apply2] 2;
  2.2146 -by (rtac dominateI 1);
  2.2147 -by (assume_tac 1); 
  2.2148 -by (Asm_simp_tac 1);
  2.2149 -by (stac comp_fun_apply 1);
  2.2150 -brr[cont_fun,Rp_cont,emb_cont,emb_rho_emb,cpo_Dinf,emb_chain_cpo] 1;
  2.2151 -by (stac ((rho_projpair RS Rp_unique)) 1);
  2.2152 -by (SELECT_GOAL(rewtac rho_proj_def) 5);
  2.2153 -by (Asm_simp_tac 5);
  2.2154 -by (stac rho_emb_id 5);
  2.2155 -by (auto_tac (claset() addIs [cpo_Dinf,apply_type,Dinf_prod,emb_chain_cpo], 
  2.2156 -	      simpset()));
  2.2157 -qed "rho_emb_lub";
  2.2158 -
  2.2159 -Goal (* theta_chain, almost same prf as commute_chain *)
  2.2160 -  "[| commute(DD,ee,E,r); commute(DD,ee,G,f);   \
  2.2161 -\     emb_chain(DD,ee); cpo(E); cpo(G) |] ==>  \
  2.2162 -\  chain(cf(E,G),\\<lambda>n \\<in> nat. f(n) O Rp(DD`n,E,r(n)))";
  2.2163 -by (rtac chainI 1);
  2.2164 -by (blast_tac (claset() addIs [lam_type, cont_cf, comp_pres_cont, commute_emb, Rp_cont,emb_cont,emb_chain_cpo]) 1);
  2.2165 -by (Asm_simp_tac 1);
  2.2166 -by (res_inst_tac[("r1","r"),("m1","n")](commute_eq RS subst) 1);
  2.2167 -by (res_inst_tac[("r1","f"),("m1","n")](commute_eq RS subst) 5);
  2.2168 -brr[le_succ,nat_succI] 1;
  2.2169 -by (stac Rp_comp 1);
  2.2170 -brr[emb_eps,commute_emb,emb_chain_cpo,le_succ,nat_succI] 1;
  2.2171 -by (rtac (comp_assoc RS subst) 1);   (* Remember that comp_assoc is simpler in Isa *)
  2.2172 -by (res_inst_tac[("r1","f(succ(n))")](comp_assoc RS ssubst) 1);
  2.2173 -by (rtac comp_mono 1);
  2.2174 -by (REPEAT (blast_tac (claset() addIs [comp_pres_cont, eps_cont, emb_eps, commute_emb, Rp_cont, emb_cont,emb_chain_cpo,le_succ]) 1));
  2.2175 -by (res_inst_tac[("b","f(succ(n))")](comp_id RS subst) 1); (* 1 subst too much *)
  2.2176 -by (rtac comp_mono 2);
  2.2177 -by (REPEAT (blast_tac (claset() addIs[comp_pres_cont, eps_cont, emb_eps, emb_id, commute_emb, Rp_cont, emb_cont,cont_fun,emb_chain_cpo,le_succ]) 1));
  2.2178 -by (stac comp_id 1); (* Undoes "1 subst too much", typing next anyway *)
  2.2179 -by (REPEAT
  2.2180 -    (blast_tac (claset() addIs[cont_fun, Rp_cont, emb_cont, commute_emb,
  2.2181 -			       cont_cf, cpo_cf,emb_chain_cpo,
  2.2182 -			       embRp_rel,emb_eps,le_succ]) 1));
  2.2183 -qed "theta_chain";
  2.2184 -
  2.2185 -Goal (* theta_proj_chain, same prf as theta_chain *)
  2.2186 -  "[| commute(DD,ee,E,r); commute(DD,ee,G,f);   \
  2.2187 -\     emb_chain(DD,ee); cpo(E); cpo(G) |] ==>  \
  2.2188 -\  chain(cf(G,E),\\<lambda>n \\<in> nat. r(n) O Rp(DD`n,G,f(n)))";
  2.2189 -by (rtac chainI 1);
  2.2190 -by (blast_tac (claset() addIs [lam_type, cont_cf, comp_pres_cont, commute_emb, Rp_cont,emb_cont,emb_chain_cpo]) 1);
  2.2191 -by (Asm_simp_tac 1);
  2.2192 -by (res_inst_tac[("r1","r"),("m1","n")](commute_eq RS subst) 1);
  2.2193 -by (res_inst_tac[("r1","f"),("m1","n")](commute_eq RS subst) 5);
  2.2194 -brr[le_succ,nat_succI] 1;
  2.2195 -by (stac Rp_comp 1);
  2.2196 -brr[emb_eps,commute_emb,emb_chain_cpo,le_succ,nat_succI] 1;
  2.2197 -by (rtac (comp_assoc RS subst) 1);   (* Remember that comp_assoc is simpler in Isa *)
  2.2198 -by (res_inst_tac[("r1","r(succ(n))")](comp_assoc RS ssubst) 1);
  2.2199 -by (rtac comp_mono 1);
  2.2200 -by (REPEAT (blast_tac (claset() addIs [comp_pres_cont, eps_cont, emb_eps, commute_emb, Rp_cont, emb_cont,emb_chain_cpo,le_succ]) 1));
  2.2201 -by (res_inst_tac[("b","r(succ(n))")](comp_id RS subst) 1); (* 1 subst too much *)
  2.2202 -by (rtac comp_mono 2);
  2.2203 -by (REPEAT (blast_tac (claset() addIs[comp_pres_cont, eps_cont, emb_eps, emb_id, commute_emb, Rp_cont, emb_cont,cont_fun,emb_chain_cpo,le_succ]) 1));
  2.2204 -by (stac comp_id 1); (* Undoes "1 subst too much", typing next anyway *)
  2.2205 -by (REPEAT
  2.2206 -    (blast_tac (claset() addIs[cont_fun, Rp_cont, emb_cont, commute_emb, 
  2.2207 -			       cont_cf, cpo_cf,emb_chain_cpo,embRp_rel,
  2.2208 -			       emb_eps,le_succ]) 1));
  2.2209 -qed "theta_proj_chain";
  2.2210 -
  2.2211 -(* Simplification with comp_assoc is possible inside a \\<lambda>-abstraction,
  2.2212 -   because it does not have assumptions. If it had, as the HOL-ST theorem 
  2.2213 -   too strongly has, we would be in deep trouble due to the lack of proper
  2.2214 -   conditional rewriting (a HOL contrib provides something that works). *)
  2.2215 -
  2.2216 -(* Controlled simplification inside lambda: introduce lemmas *)
  2.2217 -
  2.2218 -Goal "[| commute(DD,ee,E,r); commute(DD,ee,G,f);   \
  2.2219 -\     emb_chain(DD,ee); cpo(E); cpo(G); x \\<in> nat |] ==>  \
  2.2220 -\  r(x) O Rp(DD ` x, G, f(x)) O f(x) O Rp(DD ` x, E, r(x)) =  \
  2.2221 -\  r(x) O Rp(DD ` x, E, r(x))";
  2.2222 -by (res_inst_tac[("s1","f(x)")](comp_assoc RS subst) 1);
  2.2223 -by (stac embRp_eq 1);
  2.2224 -by (stac id_comp 4);
  2.2225 -by (auto_tac (claset() addIs [cont_fun,Rp_cont,commute_emb,emb_chain_cpo], 
  2.2226 -	      simpset()));
  2.2227 -val lemma = result();
  2.2228 -
  2.2229 -
  2.2230 -(* Shorter proof (but lemmas): 19 vs 79 (103 - 24, due to OAssoc)  *)
  2.2231 -
  2.2232 -Goalw [projpair_def,rho_proj_def] (* theta_projpair *)
  2.2233 -  "[| lub(cf(E,E), \\<lambda>n \\<in> nat. r(n) O Rp(DD`n,E,r(n))) = id(set(E));  \
  2.2234 -\     commute(DD,ee,E,r); commute(DD,ee,G,f);   \
  2.2235 -\     emb_chain(DD,ee); cpo(E); cpo(G) |] ==>  \  
  2.2236 -\  projpair   \
  2.2237 -\   (E,G,   \
  2.2238 -\    lub(cf(E,G), \\<lambda>n \\<in> nat. f(n) O Rp(DD`n,E,r(n))),  \
  2.2239 -\    lub(cf(G,E), \\<lambda>n \\<in> nat. r(n) O Rp(DD`n,G,f(n))))";
  2.2240 -by Safe_tac;
  2.2241 -by (stac comp_lubs 3);
  2.2242 -(* The following one line is 15 lines in HOL, and includes existentials. *)
  2.2243 -brr[cf_cont,islub_in,cpo_lub,cpo_cf,theta_chain,theta_proj_chain] 1;
  2.2244 -by (simp_tac (simpset() addsimps[comp_assoc]) 1);
  2.2245 -by (asm_simp_tac (simpset() addsimps[lemma]) 1);
  2.2246 -by (stac comp_lubs 1);
  2.2247 -brr[cf_cont,islub_in,cpo_lub,cpo_cf,theta_chain,theta_proj_chain] 1;
  2.2248 -by (simp_tac (simpset() addsimps[comp_assoc]) 1);
  2.2249 -by (asm_simp_tac (simpset() addsimps[lemma]) 1);
  2.2250 -by (rtac dominate_islub 1);
  2.2251 -by (rtac cpo_lub 2);
  2.2252 -brr[commute_chain, commute_emb, islub_const, cont_cf, id_cont,
  2.2253 -    cpo_cf, chain_fun,chain_const] 2;
  2.2254 -by (rtac dominateI 1);
  2.2255 -by (assume_tac 1); 
  2.2256 -by (Asm_simp_tac 1);
  2.2257 -by (blast_tac (claset() addIs [embRp_rel,commute_emb,emb_chain_cpo]) 1);
  2.2258 -qed "theta_projpair";
  2.2259 -
  2.2260 -Goalw [emb_def]
  2.2261 -  "[| lub(cf(E,E), \\<lambda>n \\<in> nat. r(n) O Rp(DD`n,E,r(n))) = id(set(E));  \
  2.2262 -\     commute(DD,ee,E,r); commute(DD,ee,G,f);   \
  2.2263 -\     emb_chain(DD,ee); cpo(E); cpo(G) |] ==>  \  
  2.2264 -\  emb(E,G,lub(cf(E,G), \\<lambda>n \\<in> nat. f(n) O Rp(DD`n,E,r(n))))";
  2.2265 -by (blast_tac (claset() addIs [theta_projpair]) 1);
  2.2266 -qed "emb_theta";
  2.2267 -
  2.2268 -Goal (* mono_lemma *)
  2.2269 -  "[| g \\<in> cont(D,D'); cpo(D); cpo(D'); cpo(E) |] ==>  \
  2.2270 -\  (\\<lambda>f \\<in> cont(D',E). f O g) \\<in> mono(cf(D',E),cf(D,E))";
  2.2271 -by (rtac monoI 1);
  2.2272 -by (REPEAT(dtac cf_cont 2));
  2.2273 -by (Asm_simp_tac 2);
  2.2274 -by (rtac comp_mono 2);
  2.2275 -by (SELECT_GOAL(rewrite_goals_tac[set_def,cf_def]) 1);
  2.2276 -by (Asm_simp_tac 1);
  2.2277 -by (auto_tac (claset() addIs [lam_type,comp_pres_cont,cpo_cf,cont_cf], 
  2.2278 -	      simpset()));
  2.2279 -qed "mono_lemma";
  2.2280 -
  2.2281 -Goal "[| commute(DD,ee,E,r); commute(DD,ee,G,f);   \
  2.2282 -\        emb_chain(DD,ee); cpo(E); cpo(G); n \\<in> nat |] ==>  \  
  2.2283 -\     (\\<lambda>na \\<in> nat. (\\<lambda>f \\<in> cont(E, G). f O r(n)) `  \
  2.2284 -\      ((\\<lambda>n \\<in> nat. f(n) O Rp(DD ` n, E, r(n))) ` na))  = \
  2.2285 -\     (\\<lambda>na \\<in> nat. (f(na) O Rp(DD ` na, E, r(na))) O r(n))";
  2.2286 -by (rtac fun_extension 1);
  2.2287 -by (fast_tac (claset() addIs [lam_type]) 1);
  2.2288 -by (Asm_simp_tac 2);
  2.2289 -by (fast_tac (claset() addIs [lam_type]) 1);
  2.2290 -val lemma = result();
  2.2291 -
  2.2292 -Goal "[| commute(DD,ee,E,r); commute(DD,ee,G,f);   \
  2.2293 -\        emb_chain(DD,ee); cpo(E); cpo(G); n \\<in> nat |] ==>  \  
  2.2294 -\     chain(cf(DD`n,G),\\<lambda>x \\<in> nat. (f(x) O Rp(DD ` x, E, r(x))) O r(n))";
  2.2295 -by (rtac (lemma RS subst) 1);
  2.2296 -by (REPEAT
  2.2297 -    (blast_tac (claset() addIs[theta_chain,emb_chain_cpo,
  2.2298 -		 commute_emb RS emb_cont RS mono_lemma RS mono_chain]) 1));
  2.2299 -qed "chain_lemma";
  2.2300 -
  2.2301 -Goalw [suffix_def] (* suffix_lemma *)
  2.2302 -  "[| commute(DD,ee,E,r); commute(DD,ee,G,f);   \
  2.2303 -\     emb_chain(DD,ee); cpo(E); cpo(G); cpo(DD`x); x \\<in> nat |] ==>  \  
  2.2304 -\  suffix(\\<lambda>n \\<in> nat. (f(n) O Rp(DD`n,E,r(n))) O r(x),x) = (\\<lambda>n \\<in> nat. f(x))";
  2.2305 -by (Asm_simp_tac 1);
  2.2306 -by (rtac (lam_type RS fun_extension) 1); 
  2.2307 -by (REPEAT (blast_tac (claset() addIs [lam_type, comp_fun, cont_fun, Rp_cont, emb_cont, commute_emb, add_type,emb_chain_cpo]) 1));
  2.2308 -by (Asm_simp_tac 1);
  2.2309 -by (subgoal_tac "f(x #+ xa) O      \
  2.2310 -\                (Rp(DD ` (x #+ xa), E, r(x #+ xa)) O r(x #+ xa)) O  \
  2.2311 -\                eps(DD, ee, x, x #+ xa)   =   f(x)" 1);
  2.2312 -by (asm_simp_tac (simpset() addsimps [embRp_eq,eps_fun RS id_comp,commute_emb,
  2.2313 -				      emb_chain_cpo]) 2);
  2.2314 -by (blast_tac (claset() addIs [commute_eq,add_type,add_le_self]) 2);
  2.2315 -by (asm_full_simp_tac 
  2.2316 -    (simpset() addsimps [comp_assoc,commute_eq,add_le_self]) 1);
  2.2317 -qed "suffix_lemma";
  2.2318 -
  2.2319 -
  2.2320 -
  2.2321 -val prems = Goalw [mediating_def]
  2.2322 -  "[|emb(E,G,t);  !!n. n \\<in> nat ==> f(n) = t O r(n) |]==>mediating(E,G,r,f,t)";
  2.2323 -by Safe_tac;
  2.2324 -by (REPEAT (ares_tac prems 1));
  2.2325 -qed "mediatingI";
  2.2326 -
  2.2327 -Goalw [mediating_def] "mediating(E,G,r,f,t) ==> emb(E,G,t)";
  2.2328 -by (Fast_tac 1);
  2.2329 -qed "mediating_emb";
  2.2330 -
  2.2331 -Goalw [mediating_def] "[| mediating(E,G,r,f,t); n \\<in> nat |] ==> f(n) = t O r(n)";
  2.2332 -by (Blast_tac 1);
  2.2333 -qed "mediating_eq";
  2.2334 -
  2.2335 -Goal (* lub_universal_mediating *)
  2.2336 -  "[| lub(cf(E,E), \\<lambda>n \\<in> nat. r(n) O Rp(DD`n,E,r(n))) = id(set(E));  \
  2.2337 -\     commute(DD,ee,E,r); commute(DD,ee,G,f);   \
  2.2338 -\     emb_chain(DD,ee); cpo(E); cpo(G) |] ==>  \  
  2.2339 -\  mediating(E,G,r,f,lub(cf(E,G), \\<lambda>n \\<in> nat. f(n) O Rp(DD`n,E,r(n))))";
  2.2340 -brr[mediatingI,emb_theta] 1;
  2.2341 -by (res_inst_tac[("b","r(n)")](lub_const RS subst) 1);
  2.2342 -by (stac comp_lubs 3);
  2.2343 -by (REPEAT (blast_tac (claset() addIs [cont_cf, emb_cont, commute_emb, cpo_cf, theta_chain, chain_const, emb_chain_cpo]) 1));
  2.2344 -by (Simp_tac 1);
  2.2345 -by (res_inst_tac [("n1","n")] (lub_suffix RS subst) 1);
  2.2346 -brr[chain_lemma,cpo_cf,emb_chain_cpo] 1;
  2.2347 -by (asm_simp_tac 
  2.2348 -    (simpset() addsimps [suffix_lemma, lub_const, cont_cf, emb_cont, 
  2.2349 -			 commute_emb, cpo_cf, emb_chain_cpo]) 1);
  2.2350 -qed "lub_universal_mediating";
  2.2351 -
  2.2352 -Goal (* lub_universal_unique *)
  2.2353 -  "[| mediating(E,G,r,f,t);    \
  2.2354 -\     lub(cf(E,E), \\<lambda>n \\<in> nat. r(n) O Rp(DD`n,E,r(n))) = id(set(E));   \
  2.2355 -\     commute(DD,ee,E,r); commute(DD,ee,G,f);   \
  2.2356 -\     emb_chain(DD,ee); cpo(E); cpo(G) |] ==>   \
  2.2357 -\  t = lub(cf(E,G), \\<lambda>n \\<in> nat. f(n) O Rp(DD`n,E,r(n)))";
  2.2358 -by (res_inst_tac[("b","t")](comp_id RS subst) 1);
  2.2359 -by (etac subst 2);
  2.2360 -by (res_inst_tac[("b","t")](lub_const RS subst) 2);
  2.2361 -by (stac comp_lubs 4);
  2.2362 -by (asm_simp_tac (simpset() addsimps [comp_assoc, 
  2.2363 -				      inst "f" "f" mediating_eq]) 9);
  2.2364 -brr[cont_fun, emb_cont, mediating_emb, cont_cf, cpo_cf, chain_const, 
  2.2365 -    commute_chain,emb_chain_cpo] 1;
  2.2366 -qed "lub_universal_unique";
  2.2367 -
  2.2368 -(*---------------------------------------------------------------------*)
  2.2369 -(* Dinf yields the inverse_limit, stated as rho_emb_commute and        *)
  2.2370 -(* Dinf_universal.                                                     *)
  2.2371 -(*---------------------------------------------------------------------*)
  2.2372 -
  2.2373 -Goal (* Dinf_universal *)
  2.2374 -  "[| commute(DD,ee,G,f); emb_chain(DD,ee); cpo(G) |] ==>   \
  2.2375 -\  mediating   \
  2.2376 -\   (Dinf(DD,ee),G,rho_emb(DD,ee),f,   \
  2.2377 -\    lub(cf(Dinf(DD,ee),G),   \
  2.2378 -\        \\<lambda>n \\<in> nat. f(n) O Rp(DD`n,Dinf(DD,ee),rho_emb(DD,ee,n)))) &  \
  2.2379 -\  (\\<forall>t. mediating(Dinf(DD,ee),G,rho_emb(DD,ee),f,t) -->  \
  2.2380 -\    t = lub(cf(Dinf(DD,ee),G),   \
  2.2381 -\        \\<lambda>n \\<in> nat. f(n) O Rp(DD`n,Dinf(DD,ee),rho_emb(DD,ee,n))))";
  2.2382 -by Safe_tac;
  2.2383 -brr[lub_universal_mediating,rho_emb_commute,rho_emb_lub,cpo_Dinf] 1;
  2.2384 -by (auto_tac (claset() addIs [lub_universal_unique,rho_emb_commute,rho_emb_lub,cpo_Dinf], simpset()));
  2.2385 -qed "Dinf_universal";
  2.2386 -
     3.1 --- a/src/ZF/ex/Limit.thy	Mon Apr 15 10:05:11 2002 +0200
     3.2 +++ b/src/ZF/ex/Limit.thy	Mon Apr 15 10:18:01 2002 +0200
     3.3 @@ -15,185 +15,2210 @@
     3.4      "A Comparison of HOL-ST and Isabelle/ZF" by Sten Agerholm
     3.5      Technical Report No. 369, University of Cambridge Computer 
     3.6      Laboratory, 1995.
     3.7 +
     3.8 +(Proofs converted to Isar and tidied up considerably by lcp)
     3.9  *)
    3.10  
    3.11 -Limit  =  Main +
    3.12 -
    3.13 -consts
    3.14 +theory Limit  =  Main:
    3.15  
    3.16 -  "rel" :: [i,i,i]=>o                 (* rel(D,x,y) *)
    3.17 -  "set" :: i=>i                       (* set(D) *)
    3.18 -  "po"  :: i=>o                       (* po(D) *)
    3.19 -  "chain" :: [i,i]=>o                 (* chain(D,X) *)
    3.20 -  "isub" :: [i,i,i]=>o                (* isub(D,X,x) *)
    3.21 -  "islub" :: [i,i,i]=>o               (* islub(D,X,x) *)
    3.22 -  "lub" :: [i,i]=>i                   (* lub(D,X) *)
    3.23 -  "cpo" :: i=>o                       (* cpo(D) *)
    3.24 -  "pcpo" :: i=>o                      (* pcpo(D) *)
    3.25 -  "bot" :: i=>i                       (* bot(D) *)
    3.26 -  "mono" :: [i,i]=>i                  (* mono(D,E) *)
    3.27 -  "cont" :: [i,i]=>i                  (* cont(D,E) *)
    3.28 -  "cf" :: [i,i]=>i                    (* cf(D,E) *)
    3.29 -
    3.30 -  "suffix" :: [i,i]=>i                (* suffix(X,n) *)
    3.31 -  "subchain" :: [i,i]=>o              (* subchain(X,Y) *)
    3.32 -  "dominate" :: [i,i,i]=>o            (* dominate(D,X,Y) *)
    3.33 -  "matrix" :: [i,i]=>o                (* matrix(D,M) *)
    3.34 +constdefs
    3.35  
    3.36 -  "projpair"  :: [i,i,i,i]=>o         (* projpair(D,E,e,p) *)
    3.37 -  "emb"       :: [i,i,i]=>o           (* emb(D,E,e) *)
    3.38 -  "Rp"        :: [i,i,i]=>i           (* Rp(D,E,e) *)
    3.39 -  "iprod"     :: i=>i                 (* iprod(DD) *)
    3.40 -  "mkcpo"     :: [i,i=>o]=>i          (* mkcpo(D,P) *)
    3.41 -  "subcpo"    :: [i,i]=>o             (* subcpo(D,E) *)
    3.42 -  "subpcpo"   :: [i,i]=>o             (* subpcpo(D,E) *)
    3.43 -
    3.44 -  "emb_chain" :: [i,i]=>o             (* emb_chain(DD,ee) *)
    3.45 -  "Dinf"      :: [i,i]=>i             (* Dinf(DD,ee) *)
    3.46 +  rel :: "[i,i,i]=>o"
    3.47 +    "rel(D,x,y) == <x,y>:snd(D)"
    3.48  
    3.49 -  "e_less"    :: [i,i,i,i]=>i         (* e_less(DD,ee,m,n) *)
    3.50 -  "e_gr"      :: [i,i,i,i]=>i         (* e_gr(DD,ee,m,n) *)
    3.51 -  "eps"       :: [i,i,i,i]=>i         (* eps(DD,ee,m,n) *)
    3.52 -  "rho_emb"   :: [i,i,i]=>i           (* rho_emb(DD,ee,n) *)
    3.53 -  "rho_proj"  :: [i,i,i]=>i           (* rho_proj(DD,ee,n) *)
    3.54 -  "commute"   :: [i,i,i,i=>i]=>o      (* commute(DD,ee,E,r) *)
    3.55 -  "mediating" :: [i,i,i=>i,i=>i,i]=>o (* mediating(E,G,r,f,t) *)
    3.56 -
    3.57 -rules
    3.58 -
    3.59 -  set_def
    3.60 +  set :: "i=>i"
    3.61      "set(D) == fst(D)"
    3.62  
    3.63 -  rel_def
    3.64 -    "rel(D,x,y) == <x,y>:snd(D)" 
    3.65 -  
    3.66 -  po_def
    3.67 -    "po(D) ==   \
    3.68 -\    (\\<forall>x \\<in> set(D). rel(D,x,x)) &   \
    3.69 -\    (\\<forall>x \\<in> set(D). \\<forall>y \\<in> set(D). \\<forall>z \\<in> set(D).   \
    3.70 -\      rel(D,x,y) --> rel(D,y,z) --> rel(D,x,z)) &   \
    3.71 -\    (\\<forall>x \\<in> set(D). \\<forall>y \\<in> set(D). rel(D,x,y) --> rel(D,y,x) --> x = y)"
    3.72 +  po  :: "i=>o"
    3.73 +    "po(D) ==
    3.74 +     (\<forall>x \<in> set(D). rel(D,x,x)) &
    3.75 +     (\<forall>x \<in> set(D). \<forall>y \<in> set(D). \<forall>z \<in> set(D).
    3.76 +       rel(D,x,y) --> rel(D,y,z) --> rel(D,x,z)) &
    3.77 +     (\<forall>x \<in> set(D). \<forall>y \<in> set(D). rel(D,x,y) --> rel(D,y,x) --> x = y)"
    3.78  
    3.79 +  chain :: "[i,i]=>o"
    3.80      (* Chains are object level functions nat->set(D) *)
    3.81 +    "chain(D,X) == X \<in> nat->set(D) & (\<forall>n \<in> nat. rel(D,X`n,X`(succ(n))))"
    3.82  
    3.83 -  chain_def
    3.84 -    "chain(D,X) == X \\<in> nat->set(D) & (\\<forall>n \\<in> nat. rel(D,X`n,X`(succ(n))))"
    3.85 +  isub :: "[i,i,i]=>o"
    3.86 +    "isub(D,X,x) == x \<in> set(D) & (\<forall>n \<in> nat. rel(D,X`n,x))"
    3.87  
    3.88 -  isub_def
    3.89 -    "isub(D,X,x) == x \\<in> set(D) & (\\<forall>n \\<in> nat. rel(D,X`n,x))"
    3.90 +  islub :: "[i,i,i]=>o"
    3.91 +    "islub(D,X,x) == isub(D,X,x) & (\<forall>y. isub(D,X,y) --> rel(D,x,y))"
    3.92  
    3.93 -  islub_def
    3.94 -    "islub(D,X,x) == isub(D,X,x) & (\\<forall>y. isub(D,X,y) --> rel(D,x,y))"
    3.95 -
    3.96 -  lub_def
    3.97 +  lub :: "[i,i]=>i"
    3.98      "lub(D,X) == THE x. islub(D,X,x)"
    3.99  
   3.100 -  cpo_def
   3.101 -    "cpo(D) == po(D) & (\\<forall>X. chain(D,X) --> (\\<exists>x. islub(D,X,x)))"
   3.102 +  cpo :: "i=>o"
   3.103 +    "cpo(D) == po(D) & (\<forall>X. chain(D,X) --> (\<exists>x. islub(D,X,x)))"
   3.104  
   3.105 -  pcpo_def
   3.106 -    "pcpo(D) == cpo(D) & (\\<exists>x \\<in> set(D). \\<forall>y \\<in> set(D). rel(D,x,y))"
   3.107 -  
   3.108 -  bot_def
   3.109 -    "bot(D) == THE x. x \\<in> set(D) & (\\<forall>y \\<in> set(D). rel(D,x,y))"
   3.110 +  pcpo :: "i=>o"
   3.111 +    "pcpo(D) == cpo(D) & (\<exists>x \<in> set(D). \<forall>y \<in> set(D). rel(D,x,y))"
   3.112 +
   3.113 +  bot :: "i=>i"
   3.114 +    "bot(D) == THE x. x \<in> set(D) & (\<forall>y \<in> set(D). rel(D,x,y))"
   3.115  
   3.116 -  
   3.117 -  mono_def
   3.118 -    "mono(D,E) ==   \
   3.119 -\    {f \\<in> set(D)->set(E).   \
   3.120 -\     \\<forall>x \\<in> set(D). \\<forall>y \\<in> set(D). rel(D,x,y) --> rel(E,f`x,f`y)}"
   3.121 +  mono :: "[i,i]=>i"
   3.122 +    "mono(D,E) ==
   3.123 +     {f \<in> set(D)->set(E).
   3.124 +      \<forall>x \<in> set(D). \<forall>y \<in> set(D). rel(D,x,y) --> rel(E,f`x,f`y)}"
   3.125  
   3.126 -  cont_def
   3.127 -    "cont(D,E) ==   \
   3.128 -\    {f \\<in> mono(D,E).   \
   3.129 -\     \\<forall>X. chain(D,X) --> f`(lub(D,X)) = lub(E,\\<lambda>n \\<in> nat. f`(X`n))}" 
   3.130 -  
   3.131 -  cf_def
   3.132 -    "cf(D,E) ==   \
   3.133 -\    <cont(D,E),   \
   3.134 -\     {y \\<in> cont(D,E)*cont(D,E). \\<forall>x \\<in> set(D). rel(E,(fst(y))`x,(snd(y))`x)}>"
   3.135 +  cont :: "[i,i]=>i"
   3.136 +    "cont(D,E) ==
   3.137 +     {f \<in> mono(D,E).
   3.138 +      \<forall>X. chain(D,X) --> f`(lub(D,X)) = lub(E,\<lambda>n \<in> nat. f`(X`n))}"
   3.139 +
   3.140 +  cf :: "[i,i]=>i"
   3.141 +    "cf(D,E) ==
   3.142 +     <cont(D,E),
   3.143 +      {y \<in> cont(D,E)*cont(D,E). \<forall>x \<in> set(D). rel(E,(fst(y))`x,(snd(y))`x)}>"
   3.144  
   3.145 -  suffix_def
   3.146 -    "suffix(X,n) == \\<lambda>m \\<in> nat. X`(n #+ m)"
   3.147 +  suffix :: "[i,i]=>i"
   3.148 +    "suffix(X,n) == \<lambda>m \<in> nat. X`(n #+ m)"
   3.149  
   3.150 -  subchain_def
   3.151 -    "subchain(X,Y) == \\<forall>m \\<in> nat. \\<exists>n \\<in> nat. X`m = Y`(m #+ n)"
   3.152 +  subchain :: "[i,i]=>o"
   3.153 +    "subchain(X,Y) == \<forall>m \<in> nat. \<exists>n \<in> nat. X`m = Y`(m #+ n)"
   3.154  
   3.155 -  dominate_def
   3.156 -    "dominate(D,X,Y) == \\<forall>m \\<in> nat. \\<exists>n \\<in> nat. rel(D,X`m,Y`n)"
   3.157 +  dominate :: "[i,i,i]=>o"
   3.158 +    "dominate(D,X,Y) == \<forall>m \<in> nat. \<exists>n \<in> nat. rel(D,X`m,Y`n)"
   3.159  
   3.160 -  matrix_def
   3.161 -    "matrix(D,M) ==   \
   3.162 -\    M \\<in> nat -> (nat -> set(D)) &   \
   3.163 -\    (\\<forall>n \\<in> nat. \\<forall>m \\<in> nat. rel(D,M`n`m,M`succ(n)`m)) &   \
   3.164 -\    (\\<forall>n \\<in> nat. \\<forall>m \\<in> nat. rel(D,M`n`m,M`n`succ(m))) &   \
   3.165 -\    (\\<forall>n \\<in> nat. \\<forall>m \\<in> nat. rel(D,M`n`m,M`succ(n)`succ(m)))"
   3.166 +  matrix :: "[i,i]=>o"
   3.167 +    "matrix(D,M) ==
   3.168 +     M \<in> nat -> (nat -> set(D)) &
   3.169 +     (\<forall>n \<in> nat. \<forall>m \<in> nat. rel(D,M`n`m,M`succ(n)`m)) &
   3.170 +     (\<forall>n \<in> nat. \<forall>m \<in> nat. rel(D,M`n`m,M`n`succ(m))) &
   3.171 +     (\<forall>n \<in> nat. \<forall>m \<in> nat. rel(D,M`n`m,M`succ(n)`succ(m)))"
   3.172  
   3.173 -  projpair_def
   3.174 -    "projpair(D,E,e,p) ==   \
   3.175 -\    e \\<in> cont(D,E) & p \\<in> cont(E,D) &   \
   3.176 -\    p O e = id(set(D)) & rel(cf(E,E),e O p,id(set(E)))"
   3.177 +  projpair  :: "[i,i,i,i]=>o"
   3.178 +    "projpair(D,E,e,p) ==
   3.179 +     e \<in> cont(D,E) & p \<in> cont(E,D) &
   3.180 +     p O e = id(set(D)) & rel(cf(E,E),e O p,id(set(E)))"
   3.181  
   3.182 -  emb_def
   3.183 -    "emb(D,E,e) == \\<exists>p. projpair(D,E,e,p)"
   3.184 +  emb       :: "[i,i,i]=>o"
   3.185 +    "emb(D,E,e) == \<exists>p. projpair(D,E,e,p)"
   3.186  
   3.187 -  Rp_def
   3.188 +  Rp        :: "[i,i,i]=>i"
   3.189      "Rp(D,E,e) == THE p. projpair(D,E,e,p)"
   3.190  
   3.191 -(* Twice, constructions on cpos are more difficult. *)
   3.192 -
   3.193 -  iprod_def
   3.194 -    "iprod(DD) ==   \
   3.195 -\    <(\\<Pi>n \\<in> nat. set(DD`n)),  \
   3.196 -\     {x:(\\<Pi>n \\<in> nat. set(DD`n))*(\\<Pi>n \\<in> nat. set(DD`n)).   \
   3.197 -\      \\<forall>n \\<in> nat. rel(DD`n,fst(x)`n,snd(x)`n)}>"
   3.198 +  (* Twice, constructions on cpos are more difficult. *)
   3.199 +  iprod     :: "i=>i"
   3.200 +    "iprod(DD) ==
   3.201 +     <(\<Pi>n \<in> nat. set(DD`n)),
   3.202 +      {x:(\<Pi>n \<in> nat. set(DD`n))*(\<Pi>n \<in> nat. set(DD`n)).
   3.203 +       \<forall>n \<in> nat. rel(DD`n,fst(x)`n,snd(x)`n)}>"
   3.204  
   3.205 -  mkcpo_def   (* Cannot use rel(D), is meta fun, need two more args *)
   3.206 -    "mkcpo(D,P) ==   \
   3.207 -\    <{x \\<in> set(D). P(x)},{x \\<in> set(D)*set(D). rel(D,fst(x),snd(x))}>"
   3.208 -
   3.209 +  mkcpo     :: "[i,i=>o]=>i"
   3.210 +    (* Cannot use rel(D), is meta fun, need two more args *)
   3.211 +    "mkcpo(D,P) ==
   3.212 +     <{x \<in> set(D). P(x)},{x \<in> set(D)*set(D). rel(D,fst(x),snd(x))}>"
   3.213  
   3.214 -  subcpo_def
   3.215 -    "subcpo(D,E) ==   \
   3.216 -\    set(D) \\<subseteq> set(E) &   \
   3.217 -\    (\\<forall>x \\<in> set(D). \\<forall>y \\<in> set(D). rel(D,x,y) <-> rel(E,x,y)) &   \
   3.218 -\    (\\<forall>X. chain(D,X) --> lub(E,X):set(D))"
   3.219 +  subcpo    :: "[i,i]=>o"
   3.220 +    "subcpo(D,E) ==
   3.221 +     set(D) \<subseteq> set(E) &
   3.222 +     (\<forall>x \<in> set(D). \<forall>y \<in> set(D). rel(D,x,y) <-> rel(E,x,y)) &
   3.223 +     (\<forall>X. chain(D,X) --> lub(E,X):set(D))"
   3.224  
   3.225 -  subpcpo_def
   3.226 +  subpcpo   :: "[i,i]=>o"
   3.227      "subpcpo(D,E) == subcpo(D,E) & bot(E):set(D)"
   3.228  
   3.229 -  emb_chain_def
   3.230 -    "emb_chain(DD,ee) ==   \
   3.231 -\    (\\<forall>n \\<in> nat. cpo(DD`n)) & (\\<forall>n \\<in> nat. emb(DD`n,DD`succ(n),ee`n))"
   3.232 +  emb_chain :: "[i,i]=>o"
   3.233 +    "emb_chain(DD,ee) ==
   3.234 +     (\<forall>n \<in> nat. cpo(DD`n)) & (\<forall>n \<in> nat. emb(DD`n,DD`succ(n),ee`n))"
   3.235  
   3.236 -  Dinf_def
   3.237 -    "Dinf(DD,ee) ==   \
   3.238 -\    mkcpo(iprod(DD))   \
   3.239 -\    (%x. \\<forall>n \\<in> nat. Rp(DD`n,DD`succ(n),ee`n)`(x`succ(n)) = x`n)"
   3.240 +  Dinf      :: "[i,i]=>i"
   3.241 +    "Dinf(DD,ee) ==
   3.242 +     mkcpo(iprod(DD))
   3.243 +     (%x. \<forall>n \<in> nat. Rp(DD`n,DD`succ(n),ee`n)`(x`succ(n)) = x`n)"
   3.244  
   3.245 -  e_less_def (* Valid for m le n only. *)
   3.246 +consts
   3.247 +  e_less    :: "[i,i,i,i]=>i"
   3.248 +  e_gr      :: "[i,i,i,i]=>i"
   3.249 +
   3.250 +defs  (*???NEEDS PRIMREC*)
   3.251 +
   3.252 +  e_less_def: (* Valid for m le n only. *)
   3.253      "e_less(DD,ee,m,n) == rec(n#-m,id(set(DD`m)),%x y. ee`(m#+x) O y)"
   3.254  
   3.255 -  e_gr_def (* Valid for n le m only. *)
   3.256 -    "e_gr(DD,ee,m,n) ==   \
   3.257 -\    rec(m#-n,id(set(DD`n)),   \
   3.258 -\        %x y. y O Rp(DD`(n#+x),DD`(succ(n#+x)),ee`(n#+x)))"
   3.259 +  e_gr_def: (* Valid for n le m only. *)
   3.260 +    "e_gr(DD,ee,m,n) ==
   3.261 +     rec(m#-n,id(set(DD`n)),
   3.262 +         %x y. y O Rp(DD`(n#+x),DD`(succ(n#+x)),ee`(n#+x)))"
   3.263  
   3.264 -  eps_def
   3.265 +
   3.266 +constdefs
   3.267 +  eps       :: "[i,i,i,i]=>i"
   3.268      "eps(DD,ee,m,n) == if(m le n,e_less(DD,ee,m,n),e_gr(DD,ee,m,n))"
   3.269  
   3.270 -  rho_emb_def
   3.271 -    "rho_emb(DD,ee,n) == \\<lambda>x \\<in> set(DD`n). \\<lambda>m \\<in> nat. eps(DD,ee,n,m)`x"
   3.272 +  rho_emb   :: "[i,i,i]=>i"
   3.273 +    "rho_emb(DD,ee,n) == \<lambda>x \<in> set(DD`n). \<lambda>m \<in> nat. eps(DD,ee,n,m)`x"
   3.274 +
   3.275 +  rho_proj  :: "[i,i,i]=>i"
   3.276 +    "rho_proj(DD,ee,n) == \<lambda>x \<in> set(Dinf(DD,ee)). x`n"
   3.277 +
   3.278 +  commute   :: "[i,i,i,i=>i]=>o"
   3.279 +    "commute(DD,ee,E,r) ==
   3.280 +     (\<forall>n \<in> nat. emb(DD`n,E,r(n))) &
   3.281 +     (\<forall>m \<in> nat. \<forall>n \<in> nat. m le n --> r(n) O eps(DD,ee,m,n) = r(m))"
   3.282 +
   3.283 +  mediating :: "[i,i,i=>i,i=>i,i]=>o"
   3.284 +    "mediating(E,G,r,f,t) == emb(E,G,t) & (\<forall>n \<in> nat. f(n) = t O r(n))"
   3.285 +
   3.286 +
   3.287 +lemmas nat_linear_le = Ord_linear_le [OF nat_into_Ord nat_into_Ord]
   3.288 +
   3.289 +
   3.290 +(*----------------------------------------------------------------------*)
   3.291 +(* Basic results.                                                       *)
   3.292 +(*----------------------------------------------------------------------*)
   3.293 +
   3.294 +lemma set_I: "x \<in> fst(D) ==> x \<in> set(D)"
   3.295 +by (simp add: set_def)
   3.296 +
   3.297 +lemma rel_I: "<x,y>:snd(D) ==> rel(D,x,y)"
   3.298 +by (simp add: rel_def)
   3.299 +
   3.300 +lemma rel_E: "rel(D,x,y) ==> <x,y>:snd(D)"
   3.301 +by (simp add: rel_def)
   3.302 +
   3.303 +(*----------------------------------------------------------------------*)
   3.304 +(* I/E/D rules for po and cpo.                                          *)
   3.305 +(*----------------------------------------------------------------------*)
   3.306 +
   3.307 +lemma po_refl: "[|po(D); x \<in> set(D)|] ==> rel(D,x,x)"
   3.308 +by (unfold po_def, blast)
   3.309 +
   3.310 +lemma po_trans: "[|po(D); rel(D,x,y); rel(D,y,z); x \<in> set(D);
   3.311 +                  y \<in> set(D); z \<in> set(D)|] ==> rel(D,x,z)"
   3.312 +by (unfold po_def, blast)
   3.313 +
   3.314 +lemma po_antisym:
   3.315 +    "[|po(D); rel(D,x,y); rel(D,y,x); x \<in> set(D); y \<in> set(D)|] ==> x = y"
   3.316 +by (unfold po_def, blast)
   3.317 +
   3.318 +lemma poI:
   3.319 +  "[| !!x. x \<in> set(D) ==> rel(D,x,x);
   3.320 +      !!x y z. [| rel(D,x,y); rel(D,y,z); x \<in> set(D); y \<in> set(D); z \<in> set(D)|]
   3.321 +               ==> rel(D,x,z);
   3.322 +      !!x y. [| rel(D,x,y); rel(D,y,x); x \<in> set(D); y \<in> set(D)|] ==> x=y |] 
   3.323 +   ==> po(D)"
   3.324 +by (unfold po_def, blast)
   3.325 +
   3.326 +lemma cpoI: "[| po(D); !!X. chain(D,X) ==> islub(D,X,x(D,X))|] ==> cpo(D)"
   3.327 +by (simp add: cpo_def, blast)
   3.328 +
   3.329 +lemma cpo_po: "cpo(D) ==> po(D)"
   3.330 +by (simp add: cpo_def)
   3.331 +
   3.332 +lemma cpo_refl [simp,intro!,TC]: "[|cpo(D); x \<in> set(D)|] ==> rel(D,x,x)"
   3.333 +by (blast intro: po_refl cpo_po)
   3.334 +
   3.335 +lemma cpo_trans: "[|cpo(D); rel(D,x,y); rel(D,y,z); x \<in> set(D);
   3.336 +        y \<in> set(D); z \<in> set(D)|] ==> rel(D,x,z)"
   3.337 +by (blast intro: cpo_po po_trans)
   3.338 +
   3.339 +lemma cpo_antisym:
   3.340 +     "[|cpo(D); rel(D,x,y); rel(D,y,x); x \<in> set(D); y \<in> set(D)|] ==> x = y"
   3.341 +by (blast intro: cpo_po po_antisym)
   3.342 +
   3.343 +lemma cpo_islub: "[|cpo(D); chain(D,X);  !!x. islub(D,X,x) ==> R|] ==> R"
   3.344 +by (simp add: cpo_def, blast)
   3.345 +
   3.346 +(*----------------------------------------------------------------------*)
   3.347 +(* Theorems about isub and islub.                                       *)
   3.348 +(*----------------------------------------------------------------------*)
   3.349 +
   3.350 +lemma islub_isub: "islub(D,X,x) ==> isub(D,X,x)"
   3.351 +by (simp add: islub_def)
   3.352 +
   3.353 +lemma islub_in: "islub(D,X,x) ==> x \<in> set(D)"
   3.354 +by (simp add: islub_def isub_def)
   3.355 +
   3.356 +lemma islub_ub: "[|islub(D,X,x); n \<in> nat|] ==> rel(D,X`n,x)"
   3.357 +by (simp add: islub_def isub_def)
   3.358 +
   3.359 +lemma islub_least: "[|islub(D,X,x); isub(D,X,y)|] ==> rel(D,x,y)"
   3.360 +by (simp add: islub_def)
   3.361 +
   3.362 +lemma islubI:
   3.363 +    "[|isub(D,X,x); !!y. isub(D,X,y) ==> rel(D,x,y)|] ==> islub(D,X,x)"
   3.364 +by (simp add: islub_def)
   3.365 +
   3.366 +lemma isubI:
   3.367 +    "[|x \<in> set(D);  !!n. n \<in> nat ==> rel(D,X`n,x)|] ==> isub(D,X,x)"
   3.368 +by (simp add: isub_def)
   3.369 +
   3.370 +lemma isubE:
   3.371 +    "[|isub(D,X,x); [|x \<in> set(D);  !!n. n \<in> nat==>rel(D,X`n,x)|] ==> P
   3.372 +     |] ==> P"
   3.373 +by (simp add: isub_def)
   3.374 +
   3.375 +lemma isubD1: "isub(D,X,x) ==> x \<in> set(D)"
   3.376 +by (simp add: isub_def)
   3.377 +
   3.378 +lemma isubD2: "[|isub(D,X,x); n \<in> nat|]==>rel(D,X`n,x)"
   3.379 +by (simp add: isub_def)
   3.380 +
   3.381 +lemma islub_unique: "[|islub(D,X,x); islub(D,X,y); cpo(D)|] ==> x = y"
   3.382 +by (blast intro: cpo_antisym islub_least islub_isub islub_in)
   3.383 +
   3.384 +(*----------------------------------------------------------------------*)
   3.385 +(* lub gives the least upper bound of chains.                           *)
   3.386 +(*----------------------------------------------------------------------*)
   3.387 +
   3.388 +lemma cpo_lub: "[|chain(D,X); cpo(D)|] ==> islub(D,X,lub(D,X))"
   3.389 +apply (simp add: lub_def)
   3.390 +apply (best elim: cpo_islub intro: theI islub_unique)
   3.391 +done
   3.392 +
   3.393 +(*----------------------------------------------------------------------*)
   3.394 +(* Theorems about chains.                                               *)
   3.395 +(*----------------------------------------------------------------------*)
   3.396 +
   3.397 +lemma chainI:
   3.398 +  "[|X \<in> nat->set(D);  !!n. n \<in> nat ==> rel(D,X`n,X`succ(n))|] ==> chain(D,X)"
   3.399 +by (simp add: chain_def)
   3.400 +
   3.401 +lemma chain_fun: "chain(D,X) ==> X \<in> nat -> set(D)"
   3.402 +by (simp add: chain_def)
   3.403 +
   3.404 +lemma chain_in [simp,TC]: "[|chain(D,X); n \<in> nat|] ==> X`n \<in> set(D)"
   3.405 +apply (simp add: chain_def)
   3.406 +apply (blast dest: apply_type)
   3.407 +done
   3.408 +
   3.409 +lemma chain_rel [simp,TC]:
   3.410 +     "[|chain(D,X); n \<in> nat|] ==> rel(D, X ` n, X ` succ(n))"
   3.411 +by (simp add: chain_def)
   3.412 +
   3.413 +lemma chain_rel_gen_add:
   3.414 +     "[|chain(D,X); cpo(D); n \<in> nat; m \<in> nat|] ==> rel(D,X`n,(X`(m #+ n)))"
   3.415 +apply (induct_tac m)
   3.416 +apply (auto intro: cpo_trans)
   3.417 +done
   3.418 +
   3.419 +lemma chain_rel_gen:
   3.420 +    "[|n le m; chain(D,X); cpo(D); m \<in> nat|] ==> rel(D,X`n,X`m)"
   3.421 +apply (frule lt_nat_in_nat, erule nat_succI)
   3.422 +apply (erule rev_mp) (*prepare the induction*)
   3.423 +apply (induct_tac m)
   3.424 +apply (auto intro: cpo_trans simp add: le_iff)
   3.425 +done
   3.426 +
   3.427 +(*----------------------------------------------------------------------*)
   3.428 +(* Theorems about pcpos and bottom.                                     *)
   3.429 +(*----------------------------------------------------------------------*)
   3.430 +
   3.431 +lemma pcpoI:
   3.432 +    "[|!!y. y \<in> set(D)==>rel(D,x,y); x \<in> set(D); cpo(D)|]==>pcpo(D)"
   3.433 +by (simp add: pcpo_def, auto)
   3.434 +
   3.435 +lemma pcpo_cpo [TC]: "pcpo(D) ==> cpo(D)"
   3.436 +by (simp add: pcpo_def)
   3.437 +
   3.438 +lemma pcpo_bot_ex1:
   3.439 +    "pcpo(D) ==> \<exists>! x. x \<in> set(D) & (\<forall>y \<in> set(D). rel(D,x,y))"
   3.440 +apply (simp add: pcpo_def)
   3.441 +apply (blast intro: cpo_antisym)
   3.442 +done
   3.443 +
   3.444 +lemma bot_least [TC]:
   3.445 +    "[| pcpo(D); y \<in> set(D)|] ==> rel(D,bot(D),y)"
   3.446 +apply (simp add: bot_def)
   3.447 +apply (best intro: pcpo_bot_ex1 [THEN theI2])
   3.448 +done
   3.449 +
   3.450 +lemma bot_in [TC]:
   3.451 +    "pcpo(D) ==> bot(D):set(D)"
   3.452 +apply (simp add: bot_def)
   3.453 +apply (best intro: pcpo_bot_ex1 [THEN theI2])
   3.454 +done
   3.455 +
   3.456 +lemma bot_unique:
   3.457 +    "[| pcpo(D); x \<in> set(D); !!y. y \<in> set(D) ==> rel(D,x,y)|] ==> x = bot(D)"
   3.458 +by (blast intro: cpo_antisym pcpo_cpo bot_in bot_least)
   3.459 +
   3.460 +(*----------------------------------------------------------------------*)
   3.461 +(* Constant chains and lubs and cpos.                                   *)
   3.462 +(*----------------------------------------------------------------------*)
   3.463 +
   3.464 +lemma chain_const: "[|x \<in> set(D); cpo(D)|] ==> chain(D,(\<lambda>n \<in> nat. x))"
   3.465 +by (simp add: chain_def)
   3.466 +
   3.467 +lemma islub_const:
   3.468 +   "[|x \<in> set(D); cpo(D)|] ==> islub(D,(\<lambda>n \<in> nat. x),x)"
   3.469 +apply (simp add: islub_def isub_def, blast)
   3.470 +done
   3.471 +
   3.472 +lemma lub_const: "[|x \<in> set(D); cpo(D)|] ==> lub(D,\<lambda>n \<in> nat. x) = x"
   3.473 +by (blast intro: islub_unique cpo_lub chain_const islub_const)
   3.474 +
   3.475 +(*----------------------------------------------------------------------*)
   3.476 +(* Taking the suffix of chains has no effect on ub's.                   *)
   3.477 +(*----------------------------------------------------------------------*)
   3.478 +
   3.479 +lemma isub_suffix:
   3.480 +    "[| chain(D,X); cpo(D) |] ==> isub(D,suffix(X,n),x) <-> isub(D,X,x)"
   3.481 +apply (simp add: isub_def suffix_def, safe)
   3.482 +apply (drule_tac x = na in bspec)
   3.483 +apply (auto intro: cpo_trans chain_rel_gen_add)
   3.484 +done
   3.485 +
   3.486 +lemma islub_suffix:
   3.487 +  "[|chain(D,X); cpo(D)|] ==> islub(D,suffix(X,n),x) <-> islub(D,X,x)"
   3.488 +by (simp add: islub_def isub_suffix)
   3.489 +
   3.490 +lemma lub_suffix:
   3.491 +    "[|chain(D,X); cpo(D)|] ==> lub(D,suffix(X,n)) = lub(D,X)"
   3.492 +by (simp add: lub_def islub_suffix)
   3.493 +
   3.494 +(*----------------------------------------------------------------------*)
   3.495 +(* Dominate and subchain.                                               *)
   3.496 +(*----------------------------------------------------------------------*)
   3.497 +
   3.498 +lemma dominateI:
   3.499 +  "[| !!m. m \<in> nat ==> n(m):nat; !!m. m \<in> nat ==> rel(D,X`m,Y`n(m))|] ==>
   3.500 +   dominate(D,X,Y)"
   3.501 +by (simp add: dominate_def, blast)
   3.502 +
   3.503 +lemma dominate_isub:
   3.504 +  "[|dominate(D,X,Y); isub(D,Y,x); cpo(D);
   3.505 +     X \<in> nat->set(D); Y \<in> nat->set(D)|] ==> isub(D,X,x)"
   3.506 +apply (simp add: isub_def dominate_def)
   3.507 +apply (blast intro: cpo_trans intro!: apply_funtype)
   3.508 +done
   3.509 +
   3.510 +lemma dominate_islub:
   3.511 +  "[|dominate(D,X,Y); islub(D,X,x); islub(D,Y,y); cpo(D);
   3.512 +     X \<in> nat->set(D); Y \<in> nat->set(D)|] ==> rel(D,x,y)"
   3.513 +apply (simp add: islub_def)
   3.514 +apply (blast intro: dominate_isub)
   3.515 +done
   3.516 +
   3.517 +lemma subchain_isub:
   3.518 +     "[|subchain(Y,X); isub(D,X,x)|] ==> isub(D,Y,x)"
   3.519 +by (simp add: isub_def subchain_def, force)
   3.520 +
   3.521 +lemma dominate_islub_eq:
   3.522 +     "[|dominate(D,X,Y); subchain(Y,X); islub(D,X,x); islub(D,Y,y); cpo(D);
   3.523 +        X \<in> nat->set(D); Y \<in> nat->set(D)|] ==> x = y"
   3.524 +by (blast intro: cpo_antisym dominate_islub islub_least subchain_isub 
   3.525 +                 islub_isub islub_in)
   3.526 +
   3.527 +
   3.528 +(*----------------------------------------------------------------------*)
   3.529 +(* Matrix.                                                              *)
   3.530 +(*----------------------------------------------------------------------*)
   3.531 +
   3.532 +lemma matrix_fun: "matrix(D,M) ==> M \<in> nat -> (nat -> set(D))"
   3.533 +by (simp add: matrix_def)
   3.534 +
   3.535 +lemma matrix_in_fun: "[|matrix(D,M); n \<in> nat|] ==> M`n \<in> nat -> set(D)"
   3.536 +by (blast intro: apply_funtype matrix_fun)
   3.537 +
   3.538 +lemma matrix_in: "[|matrix(D,M); n \<in> nat; m \<in> nat|] ==> M`n`m \<in> set(D)"
   3.539 +by (blast intro: apply_funtype matrix_in_fun)
   3.540 +
   3.541 +lemma matrix_rel_1_0:
   3.542 +    "[|matrix(D,M); n \<in> nat; m \<in> nat|] ==> rel(D,M`n`m,M`succ(n)`m)"
   3.543 +by (simp add: matrix_def)
   3.544 +
   3.545 +lemma matrix_rel_0_1:
   3.546 +    "[|matrix(D,M); n \<in> nat; m \<in> nat|] ==> rel(D,M`n`m,M`n`succ(m))"
   3.547 +by (simp add: matrix_def)
   3.548 +
   3.549 +lemma matrix_rel_1_1:
   3.550 +    "[|matrix(D,M); n \<in> nat; m \<in> nat|] ==> rel(D,M`n`m,M`succ(n)`succ(m))"
   3.551 +by (simp add: matrix_def)
   3.552 +
   3.553 +lemma fun_swap: "f \<in> X->Y->Z ==> (\<lambda>y \<in> Y. \<lambda>x \<in> X. f`x`y):Y->X->Z"
   3.554 +by (blast intro: lam_type apply_funtype)
   3.555 +
   3.556 +lemma matrix_sym_axis:
   3.557 +    "matrix(D,M) ==> matrix(D,\<lambda>m \<in> nat. \<lambda>n \<in> nat. M`n`m)"
   3.558 +by (simp add: matrix_def fun_swap)
   3.559 +
   3.560 +lemma matrix_chain_diag:
   3.561 +    "matrix(D,M) ==> chain(D,\<lambda>n \<in> nat. M`n`n)"
   3.562 +apply (simp add: chain_def)
   3.563 +apply (auto intro: lam_type matrix_in matrix_rel_1_1)
   3.564 +done
   3.565 +
   3.566 +lemma matrix_chain_left:
   3.567 +    "[|matrix(D,M); n \<in> nat|] ==> chain(D,M`n)"
   3.568 +apply (unfold chain_def)
   3.569 +apply (auto intro: matrix_fun [THEN apply_type] matrix_in matrix_rel_0_1)
   3.570 +done
   3.571 +
   3.572 +lemma matrix_chain_right:
   3.573 +    "[|matrix(D,M); m \<in> nat|] ==> chain(D,\<lambda>n \<in> nat. M`n`m)"
   3.574 +apply (simp add: chain_def)
   3.575 +apply (auto intro: lam_type matrix_in matrix_rel_1_0)
   3.576 +done
   3.577 +
   3.578 +lemma matrix_chainI:
   3.579 +  assumes xprem: "!!x. x \<in> nat==>chain(D,M`x)"
   3.580 +      and yprem: "!!y. y \<in> nat==>chain(D,\<lambda>x \<in> nat. M`x`y)"
   3.581 +      and Mfun:  "M \<in> nat->nat->set(D)"
   3.582 +      and cpoD:  "cpo(D)"
   3.583 +  shows "matrix(D,M)"
   3.584 +apply (simp add: matrix_def, safe)
   3.585 +apply (rule Mfun)
   3.586 +apply (cut_tac y1 = m and n = n in yprem [THEN chain_rel], simp+)
   3.587 +apply (simp add: chain_rel xprem)
   3.588 +apply (rule cpo_trans [OF cpoD])
   3.589 +apply (cut_tac y1 = m and n = n in yprem [THEN chain_rel], simp+)
   3.590 +apply (simp_all add: chain_fun [THEN apply_type] xprem)
   3.591 +done
   3.592 +
   3.593 +lemma lemma_rel_rel:
   3.594 +     "[|m \<in> nat; rel(D, (\<lambda>n \<in> nat. M`n`n)`m, y)|] ==> rel(D,M`m`m, y)"
   3.595 +by simp
   3.596 +
   3.597 +lemma lemma2:
   3.598 +     "[|x \<in> nat; m \<in> nat; rel(D,(\<lambda>n \<in> nat. M`n`m1)`x,(\<lambda>n \<in> nat. M`n`m1)`m)|]
   3.599 +      ==> rel(D,M`x`m1,M`m`m1)"
   3.600 +by simp
   3.601 +
   3.602 +lemma isub_lemma:
   3.603 +    "[|isub(D, \<lambda>n \<in> nat. M`n`n, y); matrix(D,M); cpo(D)|] ==>
   3.604 +     isub(D, \<lambda>n \<in> nat. lub(D,\<lambda>m \<in> nat. M`n`m), y)"
   3.605 +apply (unfold isub_def, safe)
   3.606 +apply (simp (no_asm_simp))
   3.607 +apply (frule matrix_fun [THEN apply_type], assumption)
   3.608 +apply (simp (no_asm_simp))
   3.609 +apply (rule matrix_chain_left [THEN cpo_lub, THEN islub_least], assumption+)
   3.610 +apply (unfold isub_def, safe)
   3.611 +(*???VERY indirect proof: beta-redexes could be simplified now!*)
   3.612 +apply (rename_tac k n)
   3.613 +apply (case_tac "k le n")
   3.614 +apply (rule cpo_trans, assumption)
   3.615 +apply (rule lemma2)
   3.616 +apply (rule_tac [4] lemma_rel_rel)
   3.617 +prefer 5 apply blast
   3.618 +apply (assumption | rule chain_rel_gen matrix_chain_right matrix_in isubD1)+
   3.619 +txt{*opposite case*}
   3.620 +apply (rule cpo_trans, assumption)
   3.621 +apply (rule not_le_iff_lt [THEN iffD1, THEN leI, THEN chain_rel_gen])
   3.622 +prefer 3 apply assumption
   3.623 +apply (assumption | rule nat_into_Ord matrix_chain_left)+
   3.624 +apply (rule lemma_rel_rel)
   3.625 +apply (simp_all add: matrix_in)
   3.626 +done
   3.627 +
   3.628 +lemma matrix_chain_lub:
   3.629 +    "[|matrix(D,M); cpo(D)|] ==> chain(D,\<lambda>n \<in> nat. lub(D,\<lambda>m \<in> nat. M`n`m))"
   3.630 +apply (simp add: chain_def, safe)
   3.631 +apply (rule lam_type)
   3.632 +apply (rule islub_in)
   3.633 +apply (rule cpo_lub)
   3.634 +prefer 2 apply assumption
   3.635 +apply (rule chainI)
   3.636 +apply (rule lam_type)
   3.637 +apply (simp_all add: matrix_in)
   3.638 +apply (rule matrix_rel_0_1, assumption+)
   3.639 +apply (simp add: matrix_chain_left [THEN chain_fun, THEN eta])
   3.640 +apply (rule dominate_islub)
   3.641 +apply (rule_tac [3] cpo_lub)
   3.642 +apply (rule_tac [2] cpo_lub)
   3.643 +apply (simp add: dominate_def)
   3.644 +apply (blast intro: matrix_rel_1_0)
   3.645 +apply (simp_all add: matrix_chain_left nat_succI chain_fun)
   3.646 +done
   3.647 +
   3.648 +lemma isub_eq:
   3.649 +    "[|matrix(D,M); cpo(D)|] ==>
   3.650 +     isub(D,(\<lambda>n \<in> nat. lub(D,\<lambda>m \<in> nat. M`n`m)),y) <->
   3.651 +     isub(D,(\<lambda>n \<in> nat. M`n`n),y)"
   3.652 +apply (rule iffI)
   3.653 +apply (rule dominate_isub)
   3.654 +prefer 2 apply assumption
   3.655 +apply (simp add: dominate_def)
   3.656 +apply (rule ballI)
   3.657 +apply (rule bexI, auto)
   3.658 +apply (simp add: matrix_chain_left [THEN chain_fun, THEN eta])
   3.659 +apply (rule islub_ub)
   3.660 +apply (rule cpo_lub)
   3.661 +apply (simp_all add: matrix_chain_left matrix_chain_diag chain_fun 
   3.662 +                     matrix_chain_lub isub_lemma)
   3.663 +done
   3.664 +
   3.665 +lemma lemma1:
   3.666 +    "lub(D,(\<lambda>n \<in> nat. lub(D,\<lambda>m \<in> nat. M`n`m))) =
   3.667 +     (THE x. islub(D, (\<lambda>n \<in> nat. lub(D,\<lambda>m \<in> nat. M`n`m)), x))"
   3.668 +by (simp add: lub_def)
   3.669 +
   3.670 +lemma lemma2:
   3.671 +    "lub(D,(\<lambda>n \<in> nat. M`n`n)) =
   3.672 +     (THE x. islub(D, (\<lambda>n \<in> nat. M`n`n), x))"
   3.673 +by (simp add: lub_def)
   3.674 +
   3.675 +lemma lub_matrix_diag:
   3.676 +    "[|matrix(D,M); cpo(D)|] ==>
   3.677 +     lub(D,(\<lambda>n \<in> nat. lub(D,\<lambda>m \<in> nat. M`n`m))) =
   3.678 +     lub(D,(\<lambda>n \<in> nat. M`n`n))"
   3.679 +apply (simp (no_asm) add: lemma1 lemma2)
   3.680 +apply (simp add: islub_def isub_eq)
   3.681 +done
   3.682 +
   3.683 +lemma lub_matrix_diag_sym:
   3.684 +    "[|matrix(D,M); cpo(D)|] ==>
   3.685 +     lub(D,(\<lambda>m \<in> nat. lub(D,\<lambda>n \<in> nat. M`n`m))) =
   3.686 +     lub(D,(\<lambda>n \<in> nat. M`n`n))"
   3.687 +by (drule matrix_sym_axis [THEN lub_matrix_diag], auto)
   3.688 +
   3.689 +(*----------------------------------------------------------------------*)
   3.690 +(* I/E/D rules for mono and cont.                                       *)
   3.691 +(*----------------------------------------------------------------------*)
   3.692 +
   3.693 +lemma monoI:
   3.694 +    "[|f \<in> set(D)->set(E);
   3.695 +       !!x y. [|rel(D,x,y); x \<in> set(D); y \<in> set(D)|] ==> rel(E,f`x,f`y)|] ==>
   3.696 +      f \<in> mono(D,E)"
   3.697 +by (simp add: mono_def)
   3.698 +
   3.699 +lemma mono_fun: "f \<in> mono(D,E) ==> f \<in> set(D)->set(E)"
   3.700 +by (simp add: mono_def)
   3.701 +
   3.702 +lemma mono_map: "[|f \<in> mono(D,E); x \<in> set(D)|] ==> f`x \<in> set(E)"
   3.703 +by (blast intro!: mono_fun [THEN apply_type])
   3.704 +
   3.705 +lemma mono_mono:
   3.706 +    "[|f \<in> mono(D,E); rel(D,x,y); x \<in> set(D); y \<in> set(D)|] ==> rel(E,f`x,f`y)"
   3.707 +by (simp add: mono_def)
   3.708 +
   3.709 +lemma contI:
   3.710 +    "[|f \<in> set(D)->set(E);
   3.711 +       !!x y. [|rel(D,x,y); x \<in> set(D); y \<in> set(D)|] ==> rel(E,f`x,f`y);
   3.712 +       !!X. chain(D,X) ==> f`lub(D,X) = lub(E,\<lambda>n \<in> nat. f`(X`n))|] ==>
   3.713 +      f \<in> cont(D,E)"
   3.714 +by (simp add: cont_def mono_def)
   3.715 +
   3.716 +lemma cont2mono: "f \<in> cont(D,E) ==> f \<in> mono(D,E)"
   3.717 +by (simp add: cont_def)
   3.718 +
   3.719 +lemma cont_fun [TC] : "f \<in> cont(D,E) ==> f \<in> set(D)->set(E)"
   3.720 +apply (simp add: cont_def)
   3.721 +apply (rule mono_fun, blast)
   3.722 +done
   3.723 +
   3.724 +lemma cont_map [TC]: "[|f \<in> cont(D,E); x \<in> set(D)|] ==> f`x \<in> set(E)"
   3.725 +by (blast intro!: cont_fun [THEN apply_type])
   3.726 +
   3.727 +declare comp_fun [TC]
   3.728 +
   3.729 +lemma cont_mono:
   3.730 +    "[|f \<in> cont(D,E); rel(D,x,y); x \<in> set(D); y \<in> set(D)|] ==> rel(E,f`x,f`y)"
   3.731 +apply (simp add: cont_def)
   3.732 +apply (blast intro!: mono_mono)
   3.733 +done
   3.734 +
   3.735 +lemma cont_lub:
   3.736 +   "[|f \<in> cont(D,E); chain(D,X)|] ==> f`(lub(D,X)) = lub(E,\<lambda>n \<in> nat. f`(X`n))"
   3.737 +by (simp add: cont_def)
   3.738 +
   3.739 +(*----------------------------------------------------------------------*)
   3.740 +(* Continuity and chains.                                               *)
   3.741 +(*----------------------------------------------------------------------*)
   3.742 +
   3.743 +lemma mono_chain:
   3.744 +     "[|f \<in> mono(D,E); chain(D,X)|] ==> chain(E,\<lambda>n \<in> nat. f`(X`n))"
   3.745 +apply (simp (no_asm) add: chain_def)
   3.746 +apply (blast intro: lam_type mono_map chain_in mono_mono chain_rel)
   3.747 +done
   3.748 +
   3.749 +lemma cont_chain:
   3.750 +     "[|f \<in> cont(D,E); chain(D,X)|] ==> chain(E,\<lambda>n \<in> nat. f`(X`n))"
   3.751 +by (blast intro: mono_chain cont2mono)
   3.752 +
   3.753 +(*----------------------------------------------------------------------*)
   3.754 +(* I/E/D rules about (set+rel) cf, the continuous function space.       *)
   3.755 +(*----------------------------------------------------------------------*)
   3.756 +
   3.757 +(* The following development more difficult with cpo-as-relation approach. *)
   3.758 +
   3.759 +lemma cf_cont: "f \<in> set(cf(D,E)) ==> f \<in> cont(D,E)"
   3.760 +by (simp add: set_def cf_def)
   3.761 +
   3.762 +lemma cont_cf: (* Non-trivial with relation *)
   3.763 +    "f \<in> cont(D,E) ==> f \<in> set(cf(D,E))"
   3.764 +by (simp add: set_def cf_def)
   3.765 +
   3.766 +(* rel_cf originally an equality. Now stated as two rules. Seemed easiest. *)
   3.767 +
   3.768 +lemma rel_cfI:
   3.769 +    "[|!!x. x \<in> set(D) ==> rel(E,f`x,g`x); f \<in> cont(D,E); g \<in> cont(D,E)|] ==>
   3.770 +     rel(cf(D,E),f,g)"
   3.771 +by (simp add: rel_I cf_def)
   3.772 +
   3.773 +lemma rel_cf: "[|rel(cf(D,E),f,g); x \<in> set(D)|] ==> rel(E,f`x,g`x)"
   3.774 +by (simp add: rel_def cf_def)
   3.775 +
   3.776 +(*----------------------------------------------------------------------*)
   3.777 +(* Theorems about the continuous function space.                        *)
   3.778 +(*----------------------------------------------------------------------*)
   3.779 +
   3.780 +lemma chain_cf:
   3.781 +    "[| chain(cf(D,E),X); x \<in> set(D)|] ==> chain(E,\<lambda>n \<in> nat. X`n`x)"
   3.782 +apply (rule chainI)
   3.783 +apply (blast intro: lam_type apply_funtype cont_fun cf_cont chain_in)
   3.784 +apply (simp)
   3.785 +apply (blast intro: rel_cf chain_rel)
   3.786 +done
   3.787 +
   3.788 +lemma matrix_lemma:
   3.789 +    "[|chain(cf(D,E),X); chain(D,Xa); cpo(D); cpo(E) |] ==>
   3.790 +     matrix(E,\<lambda>x \<in> nat. \<lambda>xa \<in> nat. X`x`(Xa`xa))"
   3.791 +apply (rule matrix_chainI, auto)
   3.792 +apply (rule chainI)
   3.793 +apply (blast intro: lam_type apply_funtype cont_fun cf_cont chain_in)
   3.794 +apply (simp)
   3.795 +apply (blast intro: cont_mono nat_succI chain_rel cf_cont chain_in)
   3.796 +apply (rule chainI)
   3.797 +apply (blast intro: lam_type apply_funtype cont_fun cf_cont chain_in)
   3.798 +apply (simp)
   3.799 +apply (rule rel_cf)
   3.800 +apply (simp_all add: chain_in chain_rel)
   3.801 +apply (blast intro: lam_type apply_funtype cont_fun cf_cont chain_in)
   3.802 +done
   3.803 +
   3.804 +lemma chain_cf_lub_cont:
   3.805 +    "[|chain(cf(D,E),X); cpo(D); cpo(E) |] ==>
   3.806 +     (\<lambda>x \<in> set(D). lub(E, \<lambda>n \<in> nat. X ` n ` x)) \<in> cont(D, E)"
   3.807 +apply (rule contI)
   3.808 +apply (rule lam_type)
   3.809 +apply (assumption | rule chain_cf [THEN cpo_lub, THEN islub_in])+
   3.810 +apply (simp)
   3.811 +apply (rule dominate_islub)
   3.812 +apply (erule_tac [2] chain_cf [THEN cpo_lub], simp_all)+
   3.813 +apply (rule dominateI, assumption)
   3.814 +apply (simp)
   3.815 +apply (assumption | rule chain_in [THEN cf_cont, THEN cont_mono])+
   3.816 +apply (assumption | rule chain_cf [THEN chain_fun])+
   3.817 +apply (simp add: cpo_lub [THEN islub_in] chain_in [THEN cf_cont, THEN cont_lub])
   3.818 +apply (frule matrix_lemma [THEN lub_matrix_diag], assumption+)
   3.819 +apply (simp add: chain_in [THEN beta])
   3.820 +apply (drule matrix_lemma [THEN lub_matrix_diag_sym], auto)
   3.821 +done
   3.822 +
   3.823 +lemma islub_cf:
   3.824 +    "[| chain(cf(D,E),X); cpo(D); cpo(E)|] ==>
   3.825 +      islub(cf(D,E), X, \<lambda>x \<in> set(D). lub(E,\<lambda>n \<in> nat. X`n`x))"
   3.826 +apply (rule islubI)
   3.827 +apply (rule isubI)
   3.828 +apply (rule chain_cf_lub_cont [THEN cont_cf], assumption+)
   3.829 +apply (rule rel_cfI)
   3.830 +apply (force dest!: chain_cf [THEN cpo_lub, THEN islub_ub])
   3.831 +apply (blast intro: cf_cont chain_in)
   3.832 +apply (blast intro: cont_cf chain_cf_lub_cont)
   3.833 +apply (rule rel_cfI)
   3.834 +apply (simp)
   3.835 +apply (force intro: chain_cf [THEN cpo_lub, THEN islub_least]
   3.836 +                   cf_cont [THEN cont_fun, THEN apply_type] isubI
   3.837 +            elim: isubD2 [THEN rel_cf] isubD1)
   3.838 +apply (blast intro: chain_cf_lub_cont isubD1 cf_cont)+
   3.839 +done
   3.840 +
   3.841 +lemma cpo_cf [TC]:
   3.842 +    "[| cpo(D); cpo(E)|] ==> cpo(cf(D,E))"
   3.843 +apply (rule poI [THEN cpoI])
   3.844 +apply (rule rel_cfI)
   3.845 +apply (assumption | rule cpo_refl cf_cont [THEN cont_fun, THEN apply_type]
   3.846 +                         cf_cont)+
   3.847 +apply (rule rel_cfI)
   3.848 +apply (rule cpo_trans, assumption)
   3.849 +apply (erule rel_cf, assumption)
   3.850 +apply (rule rel_cf, assumption)
   3.851 +apply (assumption | rule cf_cont [THEN cont_fun, THEN apply_type] cf_cont)+
   3.852 +apply (rule fun_extension)
   3.853 +apply (assumption | rule cf_cont [THEN cont_fun])+
   3.854 +apply (blast intro: cpo_antisym rel_cf cf_cont [THEN cont_fun, THEN apply_type])
   3.855 +apply (fast intro: islub_cf)
   3.856 +done
   3.857 +
   3.858 +lemma lub_cf: "[| chain(cf(D,E),X); cpo(D); cpo(E)|] ==>
   3.859 +      lub(cf(D,E), X) = (\<lambda>x \<in> set(D). lub(E,\<lambda>n \<in> nat. X`n`x))"
   3.860 +by (blast intro: islub_unique cpo_lub islub_cf cpo_cf)
   3.861 +
   3.862 +
   3.863 +lemma const_cont [TC]:
   3.864 +     "[|y \<in> set(E); cpo(D); cpo(E)|] ==> (\<lambda>x \<in> set(D).y) \<in> cont(D,E)"
   3.865 +apply (rule contI)
   3.866 +prefer 2 apply simp
   3.867 +apply (blast intro: lam_type)
   3.868 +apply (simp add: chain_in cpo_lub [THEN islub_in] lub_const)
   3.869 +done
   3.870 +
   3.871 +lemma cf_least:
   3.872 +    "[|cpo(D); pcpo(E); y \<in> cont(D,E)|]==>rel(cf(D,E),(\<lambda>x \<in> set(D).bot(E)),y)"
   3.873 +apply (rule rel_cfI)
   3.874 +apply (simp)
   3.875 +apply typecheck
   3.876 +done
   3.877 +
   3.878 +lemma pcpo_cf:
   3.879 +    "[|cpo(D); pcpo(E)|] ==> pcpo(cf(D,E))"
   3.880 +apply (rule pcpoI)
   3.881 +apply (assumption | rule cf_least bot_in const_cont [THEN cont_cf] cf_cont cpo_cf pcpo_cpo)+
   3.882 +done
   3.883 +
   3.884 +lemma bot_cf:
   3.885 +    "[|cpo(D); pcpo(E)|] ==> bot(cf(D,E)) = (\<lambda>x \<in> set(D).bot(E))"
   3.886 +by (blast intro: bot_unique [symmetric] pcpo_cf cf_least 
   3.887 +                 bot_in [THEN const_cont, THEN cont_cf] cf_cont pcpo_cpo)
   3.888 +
   3.889 +(*----------------------------------------------------------------------*)
   3.890 +(* Identity and composition.                                            *)
   3.891 +(*----------------------------------------------------------------------*)
   3.892 +
   3.893 +lemma id_cont [TC,intro!]:
   3.894 +    "cpo(D) ==> id(set(D)) \<in> cont(D,D)"
   3.895 +by (simp add: id_type contI cpo_lub [THEN islub_in] chain_fun [THEN eta])
   3.896 +
   3.897 +
   3.898 +lemmas comp_cont_apply =  cont_fun [THEN comp_fun_apply, OF _ cont_fun];
   3.899 +
   3.900 +lemma comp_pres_cont [TC]:
   3.901 +    "[| f \<in> cont(D',E); g \<in> cont(D,D'); cpo(D)|] ==> f O g \<in> cont(D,E)"
   3.902 +apply (rule contI)
   3.903 +apply (rule_tac [2] comp_cont_apply [THEN ssubst])
   3.904 +apply (rule_tac [5] comp_cont_apply [THEN ssubst])
   3.905 +apply (rule_tac [8] cont_mono)
   3.906 +apply (rule_tac [9] cont_mono) (* 15 subgoals *)
   3.907 +apply typecheck (* proves all but the lub case *)
   3.908 +apply (subst comp_cont_apply)
   3.909 +apply (rule_tac [4] cont_lub [THEN ssubst])
   3.910 +apply (rule_tac [6] cont_lub [THEN ssubst])
   3.911 +prefer 8 apply (simp add: comp_cont_apply chain_in)
   3.912 +apply (auto intro: cpo_lub [THEN islub_in] cont_chain)
   3.913 +done
   3.914 +
   3.915 +
   3.916 +lemma comp_mono:
   3.917 +    "[| f \<in> cont(D',E); g \<in> cont(D,D'); f':cont(D',E); g':cont(D,D');
   3.918 +        rel(cf(D',E),f,f'); rel(cf(D,D'),g,g'); cpo(D); cpo(E) |] ==>
   3.919 +     rel(cf(D,E),f O g,f' O g')"
   3.920 +apply (rule rel_cfI) 
   3.921 +apply (subst comp_cont_apply)
   3.922 +apply (rule_tac [4] comp_cont_apply [THEN ssubst])
   3.923 +apply (rule_tac [7] cpo_trans)
   3.924 +apply (assumption | rule rel_cf cont_mono cont_map comp_pres_cont)+
   3.925 +done
   3.926 +
   3.927 +lemma chain_cf_comp:
   3.928 +    "[| chain(cf(D',E),X); chain(cf(D,D'),Y); cpo(D); cpo(E)|] ==>
   3.929 +     chain(cf(D,E),\<lambda>n \<in> nat. X`n O Y`n)"
   3.930 +apply (rule chainI)
   3.931 +defer 1
   3.932 +apply simp
   3.933 +apply (rule rel_cfI)
   3.934 +apply (rule comp_cont_apply [THEN ssubst])
   3.935 +apply (rule_tac [4] comp_cont_apply [THEN ssubst])
   3.936 +apply (rule_tac [7] cpo_trans)
   3.937 +apply (rule_tac [8] rel_cf)
   3.938 +apply (rule_tac [10] cont_mono) 
   3.939 +apply (blast intro: lam_type comp_pres_cont cont_cf chain_in [THEN cf_cont] 
   3.940 +                    cont_map chain_rel rel_cf)+
   3.941 +done
   3.942 +
   3.943 +lemma comp_lubs:
   3.944 +    "[| chain(cf(D',E),X); chain(cf(D,D'),Y); cpo(D); cpo(D'); cpo(E)|] ==>
   3.945 +     lub(cf(D',E),X) O lub(cf(D,D'),Y) = lub(cf(D,E),\<lambda>n \<in> nat. X`n O Y`n)"
   3.946 +apply (rule fun_extension)
   3.947 +apply (rule_tac [3] lub_cf [THEN ssubst])
   3.948 +apply (assumption | rule comp_fun cf_cont [THEN cont_fun]  cpo_lub [THEN islub_in]  cpo_cf chain_cf_comp)+
   3.949 +apply (simp add: chain_in [THEN cf_cont, THEN comp_cont_apply,
   3.950 +                         OF _ _ chain_in [THEN cf_cont]])
   3.951 +apply (subst comp_cont_apply)
   3.952 +apply (assumption | rule cpo_lub [THEN islub_in, THEN cf_cont]  cpo_cf)+
   3.953 +apply (simp add: lub_cf chain_cf chain_in [THEN cf_cont, THEN cont_lub] chain_cf [THEN cpo_lub, THEN islub_in])
   3.954 +apply (cut_tac M = "\<lambda>xa \<in> nat. \<lambda>xb \<in> nat. X`xa` (Y`xb`x)" in lub_matrix_diag)
   3.955 +prefer 3 apply simp
   3.956 +apply (rule matrix_chainI, simp_all)
   3.957 +apply (drule chain_in [THEN cf_cont], assumption)
   3.958 +apply (force dest: cont_chain [OF _ chain_cf])
   3.959 +apply (rule chain_cf)
   3.960 +apply (assumption |
   3.961 +       rule cont_fun [THEN apply_type] chain_in [THEN cf_cont] lam_type)+
   3.962 +done
   3.963 +
   3.964 +(*----------------------------------------------------------------------*)
   3.965 +(* Theorems about projpair.                                             *)
   3.966 +(*----------------------------------------------------------------------*)
   3.967 +
   3.968 +lemma projpairI:
   3.969 +    "[| e \<in> cont(D,E); p \<in> cont(E,D); p O e = id(set(D));
   3.970 +        rel(cf(E,E))(e O p)(id(set(E)))|] ==> projpair(D,E,e,p)"
   3.971 +by (simp add: projpair_def)
   3.972 +
   3.973 +lemma projpair_e_cont: "projpair(D,E,e,p) ==> e \<in> cont(D,E)"
   3.974 +by (simp add: projpair_def)
   3.975 +
   3.976 +lemma projpair_p_cont: "projpair(D,E,e,p) ==> p \<in> cont(E,D)"
   3.977 +by (simp add: projpair_def)
   3.978 +
   3.979 +lemma projpair_ep_cont: "projpair(D,E,e,p) ==> e \<in> cont(D,E) & p \<in> cont(E,D)"
   3.980 +by (simp add: projpair_def)
   3.981 +
   3.982 +lemma projpair_eq: "projpair(D,E,e,p) ==> p O e = id(set(D))"
   3.983 +by (simp add: projpair_def)
   3.984 +
   3.985 +lemma projpair_rel: "projpair(D,E,e,p) ==> rel(cf(E,E))(e O p)(id(set(E)))"
   3.986 +by (simp add: projpair_def)
   3.987 +
   3.988 +
   3.989 +(*----------------------------------------------------------------------*)
   3.990 +(* NB! projpair_e_cont and projpair_p_cont cannot be used repeatedly    *)
   3.991 +(*     at the same time since both match a goal of the form f \<in> cont(X,Y).*)
   3.992 +(*----------------------------------------------------------------------*)
   3.993 +
   3.994 +(*----------------------------------------------------------------------*)
   3.995 +(* Uniqueness of embedding projection pairs.                            *)
   3.996 +(*----------------------------------------------------------------------*)
   3.997 +
   3.998 +lemmas id_comp = fun_is_rel [THEN left_comp_id]
   3.999 +and    comp_id = fun_is_rel [THEN right_comp_id]
  3.1000 +
  3.1001 +lemma lemma1:
  3.1002 +    "[|cpo(D); cpo(E); projpair(D,E,e,p); projpair(D,E,e',p');
  3.1003 +       rel(cf(D,E),e,e')|] ==> rel(cf(E,D),p',p)"
  3.1004 +apply (rule_tac b=p' in
  3.1005 +       projpair_p_cont [THEN cont_fun, THEN id_comp, THEN subst], assumption)
  3.1006 +apply (rule projpair_eq [THEN subst], assumption)
  3.1007 +apply (rule cpo_trans)
  3.1008 +apply (assumption | rule cpo_cf)+
  3.1009 +(* The following corresponds to EXISTS_TAC, non-trivial instantiation. *)
  3.1010 +apply (rule_tac [4] f = "p O (e' O p')" in cont_cf)
  3.1011 +apply (subst comp_assoc)
  3.1012 +apply (blast intro:  cpo_cf cont_cf comp_mono comp_pres_cont
  3.1013 +             dest: projpair_ep_cont)
  3.1014 +apply (rule_tac P = "%x. rel (cf (E,D),p O e' O p',x)"
  3.1015 +         in projpair_p_cont [THEN cont_fun, THEN comp_id, THEN subst],
  3.1016 +       assumption)
  3.1017 +apply (rule comp_mono)
  3.1018 +apply (blast intro: cpo_cf cont_cf comp_pres_cont projpair_rel
  3.1019 +             dest: projpair_ep_cont)+
  3.1020 +done
  3.1021 +
  3.1022 +text{*Proof's very like the previous one.  Is there a pattern that
  3.1023 +      could be exploited?*}
  3.1024 +lemma lemma2:
  3.1025 +    "[|cpo(D); cpo(E); projpair(D,E,e,p); projpair(D,E,e',p');
  3.1026 +       rel(cf(E,D),p',p)|] ==> rel(cf(D,E),e,e')"
  3.1027 +apply (rule_tac b=e
  3.1028 +	 in projpair_e_cont [THEN cont_fun, THEN comp_id, THEN subst],
  3.1029 +       assumption)
  3.1030 +apply (rule_tac e1=e' in projpair_eq [THEN subst], assumption)
  3.1031 +apply (rule cpo_trans)
  3.1032 +apply (assumption | rule cpo_cf)+
  3.1033 +apply (rule_tac [4] f = "(e O p) O e'" in cont_cf)
  3.1034 +apply (subst comp_assoc)
  3.1035 +apply (blast intro:  cpo_cf cont_cf comp_mono comp_pres_cont
  3.1036 +             dest: projpair_ep_cont)
  3.1037 +apply (rule_tac P = "%x. rel (cf (D,E), (e O p) O e',x)"
  3.1038 +         in projpair_e_cont [THEN cont_fun, THEN id_comp, THEN subst],
  3.1039 +       assumption)
  3.1040 +apply (blast intro: cpo_cf cont_cf comp_pres_cont projpair_rel comp_mono
  3.1041 +             dest: projpair_ep_cont)+
  3.1042 +done
  3.1043 +
  3.1044 +
  3.1045 +lemma projpair_unique:
  3.1046 +    "[|cpo(D); cpo(E); projpair(D,E,e,p); projpair(D,E,e',p')|] ==>
  3.1047 +     (e=e')<->(p=p')"
  3.1048 +by (blast intro: cpo_antisym lemma1 lemma2 cpo_cf cont_cf
  3.1049 +          dest: projpair_ep_cont)
  3.1050 +
  3.1051 +(* Slightly different, more asms, since THE chooses the unique element. *)
  3.1052 +
  3.1053 +lemma embRp:
  3.1054 +    "[|emb(D,E,e); cpo(D); cpo(E)|] ==> projpair(D,E,e,Rp(D,E,e))"
  3.1055 +apply (simp add: emb_def Rp_def)
  3.1056 +apply (blast intro: theI2 projpair_unique [THEN iffD1])
  3.1057 +done
  3.1058 +
  3.1059 +lemma embI: "projpair(D,E,e,p) ==> emb(D,E,e)"
  3.1060 +by (simp add: emb_def, auto)
  3.1061 +
  3.1062 +lemma Rp_unique: "[|projpair(D,E,e,p); cpo(D); cpo(E)|] ==> Rp(D,E,e) = p"
  3.1063 +by (blast intro: embRp embI projpair_unique [THEN iffD1])
  3.1064 +
  3.1065 +lemma emb_cont [TC]: "emb(D,E,e) ==> e \<in> cont(D,E)"
  3.1066 +apply (simp add: emb_def)
  3.1067 +apply (blast intro: projpair_e_cont)
  3.1068 +done
  3.1069 +
  3.1070 +(* The following three theorems have cpo asms due to THE (uniqueness). *)
  3.1071 +
  3.1072 +lemmas Rp_cont [TC] = embRp [THEN projpair_p_cont, standard]
  3.1073 +lemmas embRp_eq = embRp [THEN projpair_eq, standard]
  3.1074 +lemmas embRp_rel = embRp [THEN projpair_rel, standard]
  3.1075 +
  3.1076 +
  3.1077 +lemma embRp_eq_thm:
  3.1078 +    "[|emb(D,E,e); x \<in> set(D); cpo(D); cpo(E)|] ==> Rp(D,E,e)`(e`x) = x"
  3.1079 +apply (rule comp_fun_apply [THEN subst])
  3.1080 +apply (assumption | rule Rp_cont emb_cont cont_fun)+
  3.1081 +apply (subst embRp_eq)
  3.1082 +apply (auto intro: id_conv)
  3.1083 +done
  3.1084 +
  3.1085 +
  3.1086 +(*----------------------------------------------------------------------*)
  3.1087 +(* The identity embedding.                                              *)
  3.1088 +(*----------------------------------------------------------------------*)
  3.1089 +
  3.1090 +lemma projpair_id:
  3.1091 +    "cpo(D) ==> projpair(D,D,id(set(D)),id(set(D)))"
  3.1092 +apply (simp add: projpair_def)
  3.1093 +apply (blast intro: cpo_cf cont_cf)
  3.1094 +done
  3.1095 +
  3.1096 +lemma emb_id:
  3.1097 +    "cpo(D) ==> emb(D,D,id(set(D)))"
  3.1098 +by (auto intro: embI projpair_id)
  3.1099 +
  3.1100 +lemma Rp_id:
  3.1101 +    "cpo(D) ==> Rp(D,D,id(set(D))) = id(set(D))"
  3.1102 +by (auto intro: Rp_unique projpair_id)
  3.1103 +
  3.1104 +
  3.1105 +(*----------------------------------------------------------------------*)
  3.1106 +(* Composition preserves embeddings.                                    *)
  3.1107 +(*----------------------------------------------------------------------*)
  3.1108 +
  3.1109 +(* Considerably shorter, only partly due to a simpler comp_assoc. *)
  3.1110 +(* Proof in HOL-ST: 70 lines (minus 14 due to comp_assoc complication). *)
  3.1111 +(* Proof in Isa/ZF: 23 lines (compared to 56: 60% reduction). *)
  3.1112 +
  3.1113 +lemma comp_lemma:
  3.1114 +    "[|emb(D,D',e); emb(D',E,e'); cpo(D); cpo(D'); cpo(E)|] ==>
  3.1115 +     projpair(D,E,e' O e,(Rp(D,D',e)) O (Rp(D',E,e')))"
  3.1116 +apply (simp add: projpair_def, safe)
  3.1117 +apply (assumption | rule comp_pres_cont Rp_cont emb_cont)+
  3.1118 +apply (rule comp_assoc [THEN subst])
  3.1119 +apply (rule_tac t1 = e' in comp_assoc [THEN ssubst])
  3.1120 +apply (subst embRp_eq) (* Matches everything due to subst/ssubst. *)
  3.1121 +apply assumption+
  3.1122 +apply (subst comp_id)
  3.1123 +apply (assumption | rule cont_fun Rp_cont embRp_eq)+
  3.1124 +apply (rule comp_assoc [THEN subst])
  3.1125 +apply (rule_tac t1 = "Rp (D,D',e)" in comp_assoc [THEN ssubst])
  3.1126 +apply (rule cpo_trans)
  3.1127 +apply (assumption | rule cpo_cf)+
  3.1128 +apply (rule comp_mono)
  3.1129 +apply (rule_tac [6] cpo_refl)
  3.1130 +apply (erule_tac [7] asm_rl | rule_tac [7] cont_cf Rp_cont)+
  3.1131 +prefer 6 apply (blast intro: cpo_cf)
  3.1132 +apply (rule_tac [5] comp_mono)
  3.1133 +apply (rule_tac [10] embRp_rel)
  3.1134 +apply (rule_tac [9] cpo_cf [THEN cpo_refl])
  3.1135 +apply (simp_all add: comp_id embRp_rel comp_pres_cont Rp_cont
  3.1136 +                     id_cont emb_cont cont_fun cont_cf)
  3.1137 +done
  3.1138 +
  3.1139 +(* The use of THEN is great in places like the following, both ugly in HOL. *)
  3.1140 +
  3.1141 +lemmas emb_comp = comp_lemma [THEN embI]
  3.1142 +lemmas Rp_comp = comp_lemma [THEN Rp_unique]
  3.1143 +
  3.1144 +(*----------------------------------------------------------------------*)
  3.1145 +(* Infinite cartesian product.                                          *)
  3.1146 +(*----------------------------------------------------------------------*)
  3.1147 +
  3.1148 +lemma iprodI:
  3.1149 +    "x:(\<Pi>n \<in> nat. set(DD`n)) ==> x \<in> set(iprod(DD))"
  3.1150 +by (simp add: set_def iprod_def)
  3.1151 +
  3.1152 +lemma iprodE:
  3.1153 +    "x \<in> set(iprod(DD)) ==> x:(\<Pi>n \<in> nat. set(DD`n))"
  3.1154 +by (simp add: set_def iprod_def)
  3.1155 +
  3.1156 +(* Contains typing conditions in contrast to HOL-ST *)
  3.1157 +
  3.1158 +lemma rel_iprodI:
  3.1159 +    "[|!!n. n \<in> nat ==> rel(DD`n,f`n,g`n); f:(\<Pi>n \<in> nat. set(DD`n));
  3.1160 +       g:(\<Pi>n \<in> nat. set(DD`n))|] ==> rel(iprod(DD),f,g)"
  3.1161 +by (simp add: iprod_def rel_I)
  3.1162 +
  3.1163 +lemma rel_iprodE:
  3.1164 +    "[|rel(iprod(DD),f,g); n \<in> nat|] ==> rel(DD`n,f`n,g`n)"
  3.1165 +by (simp add: iprod_def rel_def)
  3.1166 +
  3.1167 +lemma chain_iprod:
  3.1168 +    "[|chain(iprod(DD),X);  !!n. n \<in> nat ==> cpo(DD`n); n \<in> nat|] ==>
  3.1169 +     chain(DD`n,\<lambda>m \<in> nat. X`m`n)"
  3.1170 +apply (unfold chain_def, safe)
  3.1171 +apply (rule lam_type)
  3.1172 +apply (rule apply_type)
  3.1173 +apply (rule iprodE)
  3.1174 +apply (blast intro: apply_funtype, assumption)
  3.1175 +apply (simp add: rel_iprodE)
  3.1176 +done
  3.1177 +
  3.1178 +lemma islub_iprod:
  3.1179 +    "[|chain(iprod(DD),X);  !!n. n \<in> nat ==> cpo(DD`n)|] ==>
  3.1180 +     islub(iprod(DD),X,\<lambda>n \<in> nat. lub(DD`n,\<lambda>m \<in> nat. X`m`n))"
  3.1181 +apply (simp add: islub_def isub_def, safe)
  3.1182 +apply (rule iprodI)
  3.1183 +apply (blast intro: lam_type chain_iprod [THEN cpo_lub, THEN islub_in])
  3.1184 +apply (rule rel_iprodI)
  3.1185 +apply (simp)
  3.1186 +(*looks like something should be inserted into the assumptions!*)
  3.1187 +apply (rule_tac P = "%t. rel (DD`na,t,lub (DD`na,\<lambda>x \<in> nat. X`x`na))"
  3.1188 +            and b1 = "%n. X`n`na" in beta [THEN subst])
  3.1189 +apply (simp del: beta
  3.1190 +	    add: chain_iprod [THEN cpo_lub, THEN islub_ub] iprodE
  3.1191 +                chain_in)+
  3.1192 +apply (blast intro: iprodI lam_type chain_iprod [THEN cpo_lub, THEN islub_in])
  3.1193 +apply (rule rel_iprodI)
  3.1194 +apply (simp | rule islub_least chain_iprod [THEN cpo_lub])+
  3.1195 +apply (simp add: isub_def, safe)
  3.1196 +apply (erule iprodE [THEN apply_type])
  3.1197 +apply (simp add: rel_iprodE | rule lam_type chain_iprod [THEN cpo_lub, THEN islub_in] iprodE)+
  3.1198 +done
  3.1199 +
  3.1200 +lemma cpo_iprod [TC]:
  3.1201 +    "(!!n. n \<in> nat ==> cpo(DD`n)) ==> cpo(iprod(DD))"
  3.1202 +apply (assumption | rule cpoI poI)+
  3.1203 +apply (rule rel_iprodI) (*not repeated: want to solve 1, leave 2 unchanged *)
  3.1204 +apply (simp | rule cpo_refl iprodE [THEN apply_type] iprodE)+
  3.1205 +apply (rule rel_iprodI)
  3.1206 +apply (drule rel_iprodE)
  3.1207 +apply (drule_tac [2] rel_iprodE)
  3.1208 +apply (simp | rule cpo_trans iprodE [THEN apply_type] iprodE)+
  3.1209 +apply (rule fun_extension)
  3.1210 +apply (blast intro: iprodE)
  3.1211 +apply (blast intro: iprodE)
  3.1212 +apply (blast intro: cpo_antisym rel_iprodE iprodE [THEN apply_type])+
  3.1213 +apply (auto intro: islub_iprod)
  3.1214 +done
  3.1215 +
  3.1216 +
  3.1217 +lemma lub_iprod:
  3.1218 +    "[|chain(iprod(DD),X);  !!n. n \<in> nat ==> cpo(DD`n)|]
  3.1219 +     ==> lub(iprod(DD),X) = (\<lambda>n \<in> nat. lub(DD`n,\<lambda>m \<in> nat. X`m`n))"
  3.1220 +by (blast intro: cpo_lub [THEN islub_unique] islub_iprod cpo_iprod)
  3.1221 +
  3.1222 +
  3.1223 +(*----------------------------------------------------------------------*)
  3.1224 +(* The notion of subcpo.                                                *)
  3.1225 +(*----------------------------------------------------------------------*)
  3.1226 +
  3.1227 +lemma subcpoI:
  3.1228 +    "[|set(D)<=set(E);
  3.1229 +       !!x y. [|x \<in> set(D); y \<in> set(D)|] ==> rel(D,x,y)<->rel(E,x,y);
  3.1230 +       !!X. chain(D,X) ==> lub(E,X) \<in> set(D)|] ==> subcpo(D,E)"
  3.1231 +by (simp add: subcpo_def)
  3.1232 +
  3.1233 +lemma subcpo_subset: "subcpo(D,E) ==> set(D)<=set(E)"
  3.1234 +by (simp add: subcpo_def)
  3.1235 +
  3.1236 +lemma subcpo_rel_eq:
  3.1237 +    "[|subcpo(D,E); x \<in> set(D); y \<in> set(D)|] ==> rel(D,x,y)<->rel(E,x,y)"
  3.1238 +by (simp add: subcpo_def)
  3.1239 +
  3.1240 +lemmas subcpo_relD1 = subcpo_rel_eq [THEN iffD1]
  3.1241 +lemmas subcpo_relD2 = subcpo_rel_eq [THEN iffD2]
  3.1242 +
  3.1243 +lemma subcpo_lub: "[|subcpo(D,E); chain(D,X)|] ==> lub(E,X) \<in> set(D)"
  3.1244 +by (simp add: subcpo_def)
  3.1245 +
  3.1246 +lemma chain_subcpo: "[|subcpo(D,E); chain(D,X)|] ==> chain(E,X)"
  3.1247 +by (blast intro: Pi_type [THEN chainI] chain_fun subcpo_relD1
  3.1248 +                    subcpo_subset [THEN subsetD]
  3.1249 +                    chain_in chain_rel)
  3.1250 +
  3.1251 +lemma ub_subcpo: "[|subcpo(D,E); chain(D,X); isub(D,X,x)|] ==> isub(E,X,x)"
  3.1252 +by (blast intro: isubI subcpo_relD1 subcpo_relD1 chain_in isubD1 isubD2
  3.1253 +                    subcpo_subset [THEN subsetD] chain_in chain_rel)
  3.1254 +
  3.1255 +lemma islub_subcpo:
  3.1256 +     "[|subcpo(D,E); cpo(E); chain(D,X)|] ==> islub(D,X,lub(E,X))"
  3.1257 +by (blast intro: islubI isubI subcpo_lub subcpo_relD2 chain_in islub_ub
  3.1258 +                 islub_least cpo_lub chain_subcpo isubD1 ub_subcpo)
  3.1259 +
  3.1260 +lemma subcpo_cpo: "[|subcpo(D,E); cpo(E)|] ==> cpo(D)"
  3.1261 +apply (assumption | rule cpoI poI)+
  3.1262 +apply (simp add: subcpo_rel_eq)
  3.1263 +apply (assumption | rule cpo_refl subcpo_subset [THEN subsetD])+
  3.1264 +apply (rotate_tac -3)
  3.1265 +apply (simp add: subcpo_rel_eq)
  3.1266 +apply (blast intro: subcpo_subset [THEN subsetD] cpo_trans)
  3.1267 +(* Changing the order of the assumptions, otherwise simp doesn't work. *)
  3.1268 +apply (rotate_tac -2)
  3.1269 +apply (simp add: subcpo_rel_eq)
  3.1270 +apply (blast intro: cpo_antisym subcpo_subset [THEN subsetD])
  3.1271 +apply (fast intro: islub_subcpo)
  3.1272 +done
  3.1273 +
  3.1274 +lemma lub_subcpo: "[|subcpo(D,E); cpo(E); chain(D,X)|] ==> lub(D,X) = lub(E,X)"
  3.1275 +by (blast intro: cpo_lub [THEN islub_unique] islub_subcpo subcpo_cpo)
  3.1276 +
  3.1277 +(*----------------------------------------------------------------------*)
  3.1278 +(* Making subcpos using mkcpo.                                          *)
  3.1279 +(*----------------------------------------------------------------------*)
  3.1280 +
  3.1281 +lemma mkcpoI: "[|x \<in> set(D); P(x)|] ==> x \<in> set(mkcpo(D,P))"
  3.1282 +by (simp add: set_def mkcpo_def)
  3.1283 +
  3.1284 +lemma mkcpoD1: "x \<in> set(mkcpo(D,P))==> x \<in> set(D)"
  3.1285 +by (simp add: set_def mkcpo_def)
  3.1286 +
  3.1287 +lemma mkcpoD2: "x \<in> set(mkcpo(D,P))==> P(x)"
  3.1288 +by (simp add: set_def mkcpo_def)
  3.1289 +
  3.1290 +lemma rel_mkcpoE: "rel(mkcpo(D,P),x,y) ==> rel(D,x,y)"
  3.1291 +by (simp add: rel_def mkcpo_def)
  3.1292 +
  3.1293 +lemma rel_mkcpo:
  3.1294 +    "[|x \<in> set(D); y \<in> set(D)|] ==> rel(mkcpo(D,P),x,y) <-> rel(D,x,y)"
  3.1295 +by (simp add: mkcpo_def rel_def set_def)
  3.1296 +
  3.1297 +lemma chain_mkcpo:
  3.1298 +    "chain(mkcpo(D,P),X) ==> chain(D,X)"
  3.1299 +apply (rule chainI)
  3.1300 +apply (blast intro: Pi_type chain_fun chain_in [THEN mkcpoD1])
  3.1301 +apply (blast intro: rel_mkcpo [THEN iffD1] chain_rel mkcpoD1 chain_in)
  3.1302 +done
  3.1303  
  3.1304 -  rho_proj_def
  3.1305 -    "rho_proj(DD,ee,n) == \\<lambda>x \\<in> set(Dinf(DD,ee)). x`n"
  3.1306 -  
  3.1307 -  commute_def
  3.1308 -    "commute(DD,ee,E,r) ==   \
  3.1309 -\    (\\<forall>n \\<in> nat. emb(DD`n,E,r(n))) &   \
  3.1310 -\    (\\<forall>m \\<in> nat. \\<forall>n \\<in> nat. m le n --> r(n) O eps(DD,ee,m,n) = r(m))"
  3.1311 +lemma subcpo_mkcpo:
  3.1312 +    "[|!!X. chain(mkcpo(D,P),X) ==> P(lub(D,X)); cpo(D)|]
  3.1313 +      ==> subcpo(mkcpo(D,P),D)"
  3.1314 +apply (intro subcpoI subsetI rel_mkcpo)
  3.1315 +apply (erule mkcpoD1)+
  3.1316 +apply (blast intro: mkcpoI cpo_lub [THEN islub_in] chain_mkcpo)
  3.1317 +done
  3.1318 +
  3.1319 +(*----------------------------------------------------------------------*)
  3.1320 +(* Embedding projection chains of cpos.                                 *)
  3.1321 +(*----------------------------------------------------------------------*)
  3.1322 +
  3.1323 +lemma emb_chainI:
  3.1324 +    "[|!!n. n \<in> nat ==> cpo(DD`n);
  3.1325 +       !!n. n \<in> nat ==> emb(DD`n,DD`succ(n),ee`n)|] ==> emb_chain(DD,ee)"
  3.1326 +by (simp add: emb_chain_def)
  3.1327 +
  3.1328 +lemma emb_chain_cpo [TC]: "[|emb_chain(DD,ee); n \<in> nat|] ==> cpo(DD`n)"
  3.1329 +by (simp add: emb_chain_def)
  3.1330 +
  3.1331 +lemma emb_chain_emb:
  3.1332 +    "[|emb_chain(DD,ee); n \<in> nat|] ==> emb(DD`n,DD`succ(n),ee`n)"
  3.1333 +by (simp add: emb_chain_def)
  3.1334 +
  3.1335 +(*----------------------------------------------------------------------*)
  3.1336 +(* Dinf, the inverse Limit.                                             *)
  3.1337 +(*----------------------------------------------------------------------*)
  3.1338 +
  3.1339 +lemma DinfI:
  3.1340 +    "[|x:(\<Pi>n \<in> nat. set(DD`n));
  3.1341 +       !!n. n \<in> nat ==> Rp(DD`n,DD`succ(n),ee`n)`(x`succ(n)) = x`n|]
  3.1342 +     ==> x \<in> set(Dinf(DD,ee))"
  3.1343 +apply (simp add: Dinf_def)
  3.1344 +apply (blast intro: mkcpoI iprodI)
  3.1345 +done
  3.1346 +
  3.1347 +lemma Dinf_prod: "x \<in> set(Dinf(DD,ee)) ==> x:(\<Pi>n \<in> nat. set(DD`n))"
  3.1348 +apply (simp add: Dinf_def)
  3.1349 +apply (erule mkcpoD1 [THEN iprodE])
  3.1350 +done
  3.1351 +
  3.1352 +lemma Dinf_eq:
  3.1353 +    "[|x \<in> set(Dinf(DD,ee)); n \<in> nat|]
  3.1354 +     ==> Rp(DD`n,DD`succ(n),ee`n)`(x`succ(n)) = x`n"
  3.1355 +apply (simp add: Dinf_def)
  3.1356 +apply (blast dest: mkcpoD2)
  3.1357 +done
  3.1358 +
  3.1359 +lemma rel_DinfI:
  3.1360 +    "[|!!n. n \<in> nat ==> rel(DD`n,x`n,y`n);
  3.1361 +       x:(\<Pi>n \<in> nat. set(DD`n)); y:(\<Pi>n \<in> nat. set(DD`n))|] ==>
  3.1362 +     rel(Dinf(DD,ee),x,y)"
  3.1363 +apply (simp add: Dinf_def)
  3.1364 +apply (blast intro: rel_mkcpo [THEN iffD2] rel_iprodI iprodI)
  3.1365 +done
  3.1366 +
  3.1367 +lemma rel_Dinf: "[|rel(Dinf(DD,ee),x,y); n \<in> nat|] ==> rel(DD`n,x`n,y`n)"
  3.1368 +apply (simp add: Dinf_def)
  3.1369 +apply (erule rel_mkcpoE [THEN rel_iprodE], assumption)
  3.1370 +done
  3.1371 +
  3.1372 +lemma chain_Dinf: "chain(Dinf(DD,ee),X) ==> chain(iprod(DD),X)"
  3.1373 +apply (simp add: Dinf_def)
  3.1374 +apply (erule chain_mkcpo)
  3.1375 +done
  3.1376 +
  3.1377 +lemma subcpo_Dinf:
  3.1378 +    "emb_chain(DD,ee) ==> subcpo(Dinf(DD,ee),iprod(DD))"
  3.1379 +apply (simp add: Dinf_def)
  3.1380 +apply (rule subcpo_mkcpo)
  3.1381 +apply (simp add: Dinf_def [symmetric])
  3.1382 +apply (rule ballI)
  3.1383 +apply (subst lub_iprod)
  3.1384 +apply (assumption | rule chain_Dinf emb_chain_cpo)+
  3.1385 +apply (simp)
  3.1386 +apply (subst Rp_cont [THEN cont_lub])
  3.1387 +apply (assumption | rule emb_chain_cpo emb_chain_emb nat_succI chain_iprod chain_Dinf)+
  3.1388 +(* Useful simplification, ugly in HOL. *)
  3.1389 +apply (simp add: Dinf_eq chain_in)
  3.1390 +apply (auto intro: cpo_iprod emb_chain_cpo)
  3.1391 +done
  3.1392 +
  3.1393 +(* Simple example of existential reasoning in Isabelle versus HOL. *)
  3.1394 +
  3.1395 +lemma cpo_Dinf: "emb_chain(DD,ee) ==> cpo(Dinf(DD,ee))"
  3.1396 +apply (rule subcpo_cpo)
  3.1397 +apply (erule subcpo_Dinf)
  3.1398 +apply (auto intro: cpo_iprod emb_chain_cpo)
  3.1399 +done
  3.1400 +
  3.1401 +(* Again and again the proofs are much easier to WRITE in Isabelle, but
  3.1402 +  the proof steps are essentially the same (I think). *)
  3.1403 +
  3.1404 +lemma lub_Dinf:
  3.1405 +    "[|chain(Dinf(DD,ee),X); emb_chain(DD,ee)|]
  3.1406 +     ==> lub(Dinf(DD,ee),X) = (\<lambda>n \<in> nat. lub(DD`n,\<lambda>m \<in> nat. X`m`n))"
  3.1407 +apply (subst subcpo_Dinf [THEN lub_subcpo])
  3.1408 +apply (auto intro: cpo_iprod emb_chain_cpo lub_iprod chain_Dinf)
  3.1409 +done
  3.1410 +
  3.1411 +(*----------------------------------------------------------------------*)
  3.1412 +(* Generalising embedddings D_m -> D_{m+1} to embeddings D_m -> D_n,    *)
  3.1413 +(* defined as eps(DD,ee,m,n), via e_less and e_gr.                      *)
  3.1414 +(*----------------------------------------------------------------------*)
  3.1415 +
  3.1416 +lemma e_less_eq:
  3.1417 +    "m \<in> nat ==> e_less(DD,ee,m,m) = id(set(DD`m))"
  3.1418 +by (simp add: e_less_def diff_self_eq_0)
  3.1419 +
  3.1420 +lemma lemma_succ_sub: "succ(m#+n)#-m = succ(natify(n))"
  3.1421 +by (simp)
  3.1422 +
  3.1423 +lemma e_less_add:
  3.1424 +     "e_less(DD,ee,m,succ(m#+k)) = (ee`(m#+k))O(e_less(DD,ee,m,m#+k))"
  3.1425 +by (simp add: e_less_def)
  3.1426 +
  3.1427 +lemma le_exists:
  3.1428 +    "[| m le n;  !!x. [|n=m#+x; x \<in> nat|] ==> Q;  n \<in> nat |] ==> Q"
  3.1429 +apply (drule less_imp_succ_add, auto)
  3.1430 +done
  3.1431 +
  3.1432 +lemma e_less_le: "[| m le n;  n \<in> nat |] ==>
  3.1433 +      e_less(DD,ee,m,succ(n)) = ee`n O e_less(DD,ee,m,n)"
  3.1434 +apply (rule le_exists, assumption)
  3.1435 +apply (simp add: e_less_add)
  3.1436 +apply assumption
  3.1437 +done
  3.1438 +
  3.1439 +(* All theorems assume variables m and n are natural numbers. *)
  3.1440 +
  3.1441 +lemma e_less_succ:
  3.1442 +     "m \<in> nat ==> e_less(DD,ee,m,succ(m)) = ee`m O id(set(DD`m))"
  3.1443 +by (simp add: e_less_le e_less_eq)
  3.1444 +
  3.1445 +lemma e_less_succ_emb:
  3.1446 +    "[|!!n. n \<in> nat ==> emb(DD`n,DD`succ(n),ee`n); m \<in> nat|] ==>
  3.1447 +     e_less(DD,ee,m,succ(m)) = ee`m"
  3.1448 +apply (simp add: e_less_succ)
  3.1449 +apply (blast intro: emb_cont cont_fun comp_id)
  3.1450 +done
  3.1451 +
  3.1452 +(* Compare this proof with the HOL one, here we do type checking. *)
  3.1453 +(* In any case the one below was very easy to write. *)
  3.1454 +
  3.1455 +lemma emb_e_less_add:
  3.1456 +     "[| emb_chain(DD,ee); m \<in> nat |]
  3.1457 +      ==> emb(DD`m, DD`(m#+k), e_less(DD,ee,m,m#+k))"
  3.1458 +apply (subgoal_tac "emb (DD`m, DD` (m#+natify (k)), e_less (DD,ee,m,m#+natify (k))) ")
  3.1459 +apply (rule_tac [2] n = "natify (k) " in nat_induct)
  3.1460 +apply (simp_all add: e_less_eq)
  3.1461 +apply (assumption | rule emb_id emb_chain_cpo)+
  3.1462 +apply (simp add: e_less_add)
  3.1463 +apply (auto intro: emb_comp emb_chain_emb emb_chain_cpo add_type)
  3.1464 +done
  3.1465 +
  3.1466 +lemma emb_e_less: "[| m le n;  emb_chain(DD,ee);  n \<in> nat |] ==>
  3.1467 +     emb(DD`m, DD`n, e_less(DD,ee,m,n))"
  3.1468 +apply (frule lt_nat_in_nat)
  3.1469 +apply (erule nat_succI)
  3.1470 +(* same proof as e_less_le *)
  3.1471 +apply (rule le_exists, assumption)
  3.1472 +apply (simp add: emb_e_less_add)
  3.1473 +apply assumption
  3.1474 +done
  3.1475 +
  3.1476 +lemma comp_mono_eq: "[|f=f'; g=g'|] ==> f O g = f' O g'"
  3.1477 +apply (simp)
  3.1478 +done
  3.1479 +
  3.1480 +(* Note the object-level implication for induction on k. This
  3.1481 +   must be removed later to allow the theorems to be used for simp.
  3.1482 +   Therefore this theorem is only a lemma. *)
  3.1483 +
  3.1484 +lemma e_less_split_add_lemma [rule_format]:
  3.1485 +    "[| emb_chain(DD,ee); m \<in> nat; n \<in> nat; k \<in> nat|] ==>
  3.1486 +     n le k -->
  3.1487 +     e_less(DD,ee,m,m#+k) = e_less(DD,ee,m#+n,m#+k) O e_less(DD,ee,m,m#+n)"
  3.1488 +apply (induct_tac k)
  3.1489 +apply (simp add: e_less_eq id_type [THEN id_comp])
  3.1490 +apply (simp add: le_succ_iff)
  3.1491 +apply (rule impI)
  3.1492 +apply (erule disjE)
  3.1493 +apply (erule impE, assumption)
  3.1494 +apply (simp add: add_succ_right e_less_add add_type nat_succI)
  3.1495 +apply (subst e_less_le)
  3.1496 +apply (assumption | rule add_le_mono nat_le_refl add_type nat_succI)+
  3.1497 +apply (subst comp_assoc)
  3.1498 +apply (assumption | rule comp_mono_eq refl)+
  3.1499 +apply (simp del: add_succ_right add: add_succ_right [symmetric]
  3.1500 +	    add: e_less_eq add_type nat_succI)
  3.1501 +apply (subst id_comp) (* simp cannot unify/inst right, use brr below (?) . *)
  3.1502 +apply (assumption |
  3.1503 +       rule emb_e_less_add [THEN emb_cont, THEN cont_fun] refl nat_succI)+
  3.1504 +done
  3.1505 +
  3.1506 +lemma e_less_split_add:
  3.1507 +     "[| n le k; emb_chain(DD,ee); m \<in> nat; n \<in> nat; k \<in> nat|] ==>
  3.1508 +      e_less(DD,ee,m,m#+k) = e_less(DD,ee,m#+n,m#+k) O e_less(DD,ee,m,m#+n)"
  3.1509 +by (blast intro: e_less_split_add_lemma)
  3.1510 +
  3.1511 +lemma e_gr_eq:
  3.1512 +    "m \<in> nat ==> e_gr(DD,ee,m,m) = id(set(DD`m))"
  3.1513 +apply (simp add: e_gr_def)
  3.1514 +apply (simp add: diff_self_eq_0)
  3.1515 +done
  3.1516 +
  3.1517 +lemma e_gr_add:
  3.1518 +    "[|n \<in> nat; k \<in> nat|] ==>
  3.1519 +          e_gr(DD,ee,succ(n#+k),n) =
  3.1520 +          e_gr(DD,ee,n#+k,n) O Rp(DD`(n#+k),DD`succ(n#+k),ee`(n#+k))"
  3.1521 +by (simp add: e_gr_def)
  3.1522 +
  3.1523 +lemma e_gr_le:
  3.1524 +     "[|n le m; m \<in> nat; n \<in> nat|]
  3.1525 +      ==> e_gr(DD,ee,succ(m),n) = e_gr(DD,ee,m,n) O Rp(DD`m,DD`succ(m),ee`m)"
  3.1526 +apply (erule le_exists)
  3.1527 +apply (simp add: e_gr_add)
  3.1528 +apply assumption+
  3.1529 +done
  3.1530 +
  3.1531 +lemma e_gr_succ:
  3.1532 + "m \<in> nat ==> e_gr(DD,ee,succ(m),m) = id(set(DD`m)) O Rp(DD`m,DD`succ(m),ee`m)"
  3.1533 +by (simp add: e_gr_le e_gr_eq)
  3.1534 +
  3.1535 +(* Cpo asm's due to THE uniqueness. *)
  3.1536 +lemma e_gr_succ_emb: "[|emb_chain(DD,ee); m \<in> nat|] ==>
  3.1537 +     e_gr(DD,ee,succ(m),m) = Rp(DD`m,DD`succ(m),ee`m)"
  3.1538 +apply (simp add: e_gr_succ)
  3.1539 +apply (blast intro: id_comp Rp_cont cont_fun emb_chain_cpo emb_chain_emb)
  3.1540 +done
  3.1541 +
  3.1542 +lemma e_gr_fun_add:
  3.1543 +    "[|emb_chain(DD,ee); n \<in> nat; k \<in> nat|] ==>
  3.1544 +     e_gr(DD,ee,n#+k,n): set(DD`(n#+k))->set(DD`n)"
  3.1545 +apply (induct_tac k)
  3.1546 +apply (simp add: e_gr_eq id_type)
  3.1547 +apply (simp add: e_gr_add)
  3.1548 +apply (blast intro: comp_fun Rp_cont cont_fun emb_chain_emb emb_chain_cpo)
  3.1549 +done
  3.1550 +
  3.1551 +lemma e_gr_fun:
  3.1552 +    "[|n le m; emb_chain(DD,ee); m \<in> nat; n \<in> nat|] ==>
  3.1553 +     e_gr(DD,ee,m,n): set(DD`m)->set(DD`n)"
  3.1554 +apply (rule le_exists, assumption)
  3.1555 +apply (simp add: e_gr_fun_add)
  3.1556 +apply assumption+
  3.1557 +done
  3.1558 +
  3.1559 +lemma e_gr_split_add_lemma:
  3.1560 +    "[| emb_chain(DD,ee); m \<in> nat; n \<in> nat; k \<in> nat|] ==>
  3.1561 +     m le k -->
  3.1562 +     e_gr(DD,ee,n#+k,n) = e_gr(DD,ee,n#+m,n) O e_gr(DD,ee,n#+k,n#+m)"
  3.1563 +apply (induct_tac k)
  3.1564 +apply (rule impI)
  3.1565 +apply (simp add: le0_iff e_gr_eq id_type [THEN comp_id])
  3.1566 +apply (simp add: le_succ_iff)
  3.1567 +apply (rule impI)
  3.1568 +apply (erule disjE)
  3.1569 +apply (erule impE, assumption)
  3.1570 +apply (simp add: add_succ_right e_gr_add add_type nat_succI)
  3.1571 +apply (subst e_gr_le)
  3.1572 +apply (assumption | rule add_le_mono nat_le_refl add_type nat_succI)+
  3.1573 +apply (subst comp_assoc)
  3.1574 +apply (assumption | rule comp_mono_eq refl)+
  3.1575 +(* New direct subgoal *)
  3.1576 +apply (simp del: add_succ_right add: add_succ_right [symmetric]
  3.1577 +	    add: e_gr_eq add_type nat_succI)
  3.1578 +apply (subst comp_id) (* simp cannot unify/inst right, use brr below (?) . *)
  3.1579 +apply (assumption | rule e_gr_fun add_type refl add_le_self nat_succI)+
  3.1580 +done
  3.1581 +
  3.1582 +lemma e_gr_split_add: "[| m le k; emb_chain(DD,ee); m \<in> nat; n \<in> nat; k \<in> nat|] ==>
  3.1583 +      e_gr(DD,ee,n#+k,n) = e_gr(DD,ee,n#+m,n) O e_gr(DD,ee,n#+k,n#+m)"
  3.1584 +apply (blast intro: e_gr_split_add_lemma [THEN mp])
  3.1585 +done
  3.1586 +
  3.1587 +lemma e_less_cont: "[|m le n; emb_chain(DD,ee); m \<in> nat; n \<in> nat|] ==>
  3.1588 +      e_less(DD,ee,m,n):cont(DD`m,DD`n)"
  3.1589 +apply (blast intro: emb_cont emb_e_less)
  3.1590 +done
  3.1591 +
  3.1592 +lemma e_gr_cont:
  3.1593 +    "[|n le m; emb_chain(DD,ee); m \<in> nat; n \<in> nat|] ==>
  3.1594 +     e_gr(DD,ee,m,n):cont(DD`m,DD`n)"
  3.1595 +apply (erule rev_mp)
  3.1596 +apply (induct_tac m)
  3.1597 +apply (simp add: le0_iff e_gr_eq nat_0I)
  3.1598 +apply (assumption | rule impI id_cont emb_chain_cpo nat_0I)+
  3.1599 +apply (simp add: le_succ_iff)
  3.1600 +apply (erule disjE)
  3.1601 +apply (erule impE, assumption)
  3.1602 +apply (simp add: e_gr_le)
  3.1603 +apply (blast intro: comp_pres_cont Rp_cont emb_chain_cpo emb_chain_emb)
  3.1604 +apply (simp add: e_gr_eq)
  3.1605 +done
  3.1606 +
  3.1607 +(* Considerably shorter.... 57 against 26 *)
  3.1608 +
  3.1609 +lemma e_less_e_gr_split_add:
  3.1610 +    "[|n le k; emb_chain(DD,ee); m \<in> nat; n \<in> nat; k \<in> nat|] ==>
  3.1611 +     e_less(DD,ee,m,m#+n) = e_gr(DD,ee,m#+k,m#+n) O e_less(DD,ee,m,m#+k)"
  3.1612 +(* Use mp to prepare for induction. *)
  3.1613 +apply (erule rev_mp)
  3.1614 +apply (induct_tac k)
  3.1615 +apply (simp add: e_gr_eq e_less_eq id_type [THEN id_comp])
  3.1616 +apply (simp add: le_succ_iff)
  3.1617 +apply (rule impI)
  3.1618 +apply (erule disjE)
  3.1619 +apply (erule impE, assumption)
  3.1620 +apply (simp add: add_succ_right e_gr_le e_less_le add_le_self nat_le_refl add_le_mono add_type)
  3.1621 +apply (subst comp_assoc)
  3.1622 +apply (rule_tac s1 = "ee` (m#+x)" in comp_assoc [THEN subst])
  3.1623 +apply (subst embRp_eq)
  3.1624 +apply (assumption | rule emb_chain_emb add_type emb_chain_cpo nat_succI)+
  3.1625 +apply (subst id_comp)
  3.1626 +apply (blast intro: e_less_cont [THEN cont_fun] add_le_self)
  3.1627 +apply (rule refl)
  3.1628 +apply (simp del: add_succ_right add: add_succ_right [symmetric]
  3.1629 +	    add: e_gr_eq add_type nat_succI)
  3.1630 +apply (blast intro: id_comp [symmetric] e_less_cont [THEN cont_fun]
  3.1631 +                    add_le_self)
  3.1632 +done
  3.1633 +
  3.1634 +(* Again considerably shorter, and easy to obtain from the previous thm. *)
  3.1635 +
  3.1636 +lemma e_gr_e_less_split_add:
  3.1637 +    "[|m le k; emb_chain(DD,ee); m \<in> nat; n \<in> nat; k \<in> nat|] ==>
  3.1638 +     e_gr(DD,ee,n#+m,n) = e_gr(DD,ee,n#+k,n) O e_less(DD,ee,n#+m,n#+k)"
  3.1639 +(* Use mp to prepare for induction. *)
  3.1640 +apply (erule rev_mp)
  3.1641 +apply (induct_tac k)
  3.1642 +apply (simp add: e_gr_eq e_less_eq id_type [THEN id_comp])
  3.1643 +apply (simp add: le_succ_iff)
  3.1644 +apply (rule impI)
  3.1645 +apply (erule disjE)
  3.1646 +apply (erule impE, assumption)
  3.1647 +apply (simp add: e_gr_le e_less_le add_le_self nat_le_refl add_le_mono)
  3.1648 +apply (subst comp_assoc)
  3.1649 +apply (rule_tac s1 = "ee` (n#+x)" in comp_assoc [THEN subst])
  3.1650 +apply (subst embRp_eq)
  3.1651 +apply (assumption | rule emb_chain_emb add_type emb_chain_cpo nat_succI)+
  3.1652 +apply (subst id_comp)
  3.1653 +apply (blast intro!: e_less_cont [THEN cont_fun] add_le_mono nat_le_refl)
  3.1654 +apply (rule refl)
  3.1655 +apply (simp del: add_succ_right add: add_succ_right [symmetric]
  3.1656 +	    add: e_less_eq add_type nat_succI)
  3.1657 +apply (blast intro: comp_id [symmetric] e_gr_cont [THEN cont_fun] add_le_self)
  3.1658 +done
  3.1659 +
  3.1660 +
  3.1661 +lemma emb_eps:
  3.1662 +    "[|m le n; emb_chain(DD,ee); m \<in> nat; n \<in> nat|]
  3.1663 +     ==> emb(DD`m,DD`n,eps(DD,ee,m,n))"
  3.1664 +apply (simp add: eps_def)
  3.1665 +apply (blast intro: emb_e_less)
  3.1666 +done
  3.1667 +
  3.1668 +lemma eps_fun:
  3.1669 +    "[|emb_chain(DD,ee); m \<in> nat; n \<in> nat|]
  3.1670 +     ==> eps(DD,ee,m,n): set(DD`m)->set(DD`n)"
  3.1671 +apply (simp add: eps_def)
  3.1672 +apply (auto intro: e_less_cont [THEN cont_fun]
  3.1673 +                   not_le_iff_lt [THEN iffD1, THEN leI]
  3.1674 +                   e_gr_fun nat_into_Ord)
  3.1675 +done
  3.1676 +
  3.1677 +lemma eps_id: "n \<in> nat ==> eps(DD,ee,n,n) = id(set(DD`n))"
  3.1678 +by (simp add: eps_def e_less_eq)
  3.1679 +
  3.1680 +lemma eps_e_less_add:
  3.1681 +    "[|m \<in> nat; n \<in> nat|] ==> eps(DD,ee,m,m#+n) = e_less(DD,ee,m,m#+n)"
  3.1682 +by (simp add: eps_def add_le_self)
  3.1683 +
  3.1684 +lemma eps_e_less:
  3.1685 +    "[|m le n; m \<in> nat; n \<in> nat|] ==> eps(DD,ee,m,n) = e_less(DD,ee,m,n)"
  3.1686 +by (simp add: eps_def)
  3.1687 +
  3.1688 +lemma eps_e_gr_add:
  3.1689 +    "[|n \<in> nat; k \<in> nat|] ==> eps(DD,ee,n#+k,n) = e_gr(DD,ee,n#+k,n)"
  3.1690 +by (simp add: eps_def e_less_eq e_gr_eq)
  3.1691 +
  3.1692 +lemma eps_e_gr:
  3.1693 +    "[|n le m; m \<in> nat; n \<in> nat|] ==> eps(DD,ee,m,n) = e_gr(DD,ee,m,n)"
  3.1694 +apply (erule le_exists)
  3.1695 +apply (simp_all add: eps_e_gr_add)
  3.1696 +done
  3.1697 +
  3.1698 +lemma eps_succ_ee:
  3.1699 +    "[|!!n. n \<in> nat ==> emb(DD`n,DD`succ(n),ee`n); m \<in> nat|]
  3.1700 +     ==> eps(DD,ee,m,succ(m)) = ee`m"
  3.1701 +by (simp add: eps_e_less le_succ_iff e_less_succ_emb)
  3.1702 +
  3.1703 +lemma eps_succ_Rp:
  3.1704 +    "[|emb_chain(DD,ee); m \<in> nat|]
  3.1705 +     ==> eps(DD,ee,succ(m),m) = Rp(DD`m,DD`succ(m),ee`m)"
  3.1706 +by (simp add: eps_e_gr le_succ_iff e_gr_succ_emb)
  3.1707 +
  3.1708 +lemma eps_cont:
  3.1709 +  "[|emb_chain(DD,ee); m \<in> nat; n \<in> nat|] ==> eps(DD,ee,m,n): cont(DD`m,DD`n)"
  3.1710 +apply (rule_tac i = m and j = n in nat_linear_le)
  3.1711 +apply (simp_all add: eps_e_less e_less_cont eps_e_gr e_gr_cont)
  3.1712 +done
  3.1713 +
  3.1714 +(* Theorems about splitting. *)
  3.1715 +
  3.1716 +lemma eps_split_add_left:
  3.1717 +    "[|n le k; emb_chain(DD,ee); m \<in> nat; n \<in> nat; k \<in> nat|] ==>
  3.1718 +     eps(DD,ee,m,m#+k) = eps(DD,ee,m#+n,m#+k) O eps(DD,ee,m,m#+n)"
  3.1719 +apply (simp add: eps_e_less add_le_self add_le_mono)
  3.1720 +apply (auto intro: e_less_split_add)
  3.1721 +done
  3.1722 +
  3.1723 +lemma eps_split_add_left_rev:
  3.1724 +    "[|n le k; emb_chain(DD,ee); m \<in> nat; n \<in> nat; k \<in> nat|] ==>
  3.1725 +     eps(DD,ee,m,m#+n) = eps(DD,ee,m#+k,m#+n) O eps(DD,ee,m,m#+k)"
  3.1726 +apply (simp add: eps_e_less_add eps_e_gr add_le_self add_le_mono)
  3.1727 +apply (auto intro: e_less_e_gr_split_add)
  3.1728 +done
  3.1729 +
  3.1730 +lemma eps_split_add_right:
  3.1731 +    "[|m le k; emb_chain(DD,ee); m \<in> nat; n \<in> nat; k \<in> nat|] ==>
  3.1732 +     eps(DD,ee,n#+k,n) = eps(DD,ee,n#+m,n) O eps(DD,ee,n#+k,n#+m)"
  3.1733 +apply (simp add: eps_e_gr add_le_self add_le_mono)
  3.1734 +apply (auto intro: e_gr_split_add)
  3.1735 +done
  3.1736 +
  3.1737 +lemma eps_split_add_right_rev:
  3.1738 +    "[|m le k; emb_chain(DD,ee); m \<in> nat; n \<in> nat; k \<in> nat|] ==>
  3.1739 +     eps(DD,ee,n#+m,n) = eps(DD,ee,n#+k,n) O eps(DD,ee,n#+m,n#+k)"
  3.1740 +apply (simp add: eps_e_gr_add eps_e_less add_le_self add_le_mono)
  3.1741 +apply (auto intro: e_gr_e_less_split_add)
  3.1742 +done
  3.1743 +
  3.1744 +(* Arithmetic *)
  3.1745 +
  3.1746 +lemma le_exists_lemma:
  3.1747 +    "[| n le k; k le m;
  3.1748 +        !!p q. [|p le q; k=n#+p; m=n#+q; p \<in> nat; q \<in> nat|] ==> R;
  3.1749 +        m \<in> nat |]==>R"
  3.1750 +apply (rule le_exists, assumption)
  3.1751 +prefer 2 apply (simp add: lt_nat_in_nat)
  3.1752 +apply (rule le_trans [THEN le_exists], assumption+, auto)
  3.1753 +done
  3.1754 +
  3.1755 +lemma eps_split_left_le:
  3.1756 +    "[|m le k; k le n; emb_chain(DD,ee); m \<in> nat; n \<in> nat; k \<in> nat|] ==>
  3.1757 +     eps(DD,ee,m,n) = eps(DD,ee,k,n) O eps(DD,ee,m,k)"
  3.1758 +apply (rule le_exists_lemma, assumption+)
  3.1759 +apply (auto intro: eps_split_add_left)
  3.1760 +done
  3.1761 +
  3.1762 +lemma eps_split_left_le_rev:
  3.1763 +    "[|m le n; n le k; emb_chain(DD,ee); m \<in> nat; n \<in> nat; k \<in> nat|] ==>
  3.1764 +     eps(DD,ee,m,n) = eps(DD,ee,k,n) O eps(DD,ee,m,k)"
  3.1765 +apply (rule le_exists_lemma, assumption+)
  3.1766 +apply (auto intro: eps_split_add_left_rev)
  3.1767 +done
  3.1768 +
  3.1769 +lemma eps_split_right_le:
  3.1770 +    "[|n le k; k le m; emb_chain(DD,ee); m \<in> nat; n \<in> nat; k \<in> nat|] ==>
  3.1771 +     eps(DD,ee,m,n) = eps(DD,ee,k,n) O eps(DD,ee,m,k)"
  3.1772 +apply (rule le_exists_lemma, assumption+)
  3.1773 +apply (auto intro: eps_split_add_right)
  3.1774 +done
  3.1775 +
  3.1776 +lemma eps_split_right_le_rev:
  3.1777 +    "[|n le m; m le k; emb_chain(DD,ee); m \<in> nat; n \<in> nat; k \<in> nat|] ==>
  3.1778 +     eps(DD,ee,m,n) = eps(DD,ee,k,n) O eps(DD,ee,m,k)"
  3.1779 +apply (rule le_exists_lemma, assumption+)
  3.1780 +apply (auto intro: eps_split_add_right_rev)
  3.1781 +done
  3.1782 +
  3.1783 +(* The desired two theorems about `splitting'. *)
  3.1784 +
  3.1785 +lemma eps_split_left:
  3.1786 +    "[|m le k; emb_chain(DD,ee); m \<in> nat; n \<in> nat; k \<in> nat|] ==>
  3.1787 +     eps(DD,ee,m,n) = eps(DD,ee,k,n) O eps(DD,ee,m,k)"
  3.1788 +apply (rule nat_linear_le)
  3.1789 +apply (rule_tac [4] eps_split_right_le_rev)
  3.1790 +prefer 4 apply assumption
  3.1791 +apply (rule_tac [3] nat_linear_le)
  3.1792 +apply (rule_tac [5] eps_split_left_le)
  3.1793 +prefer 6 apply assumption
  3.1794 +apply (simp_all add: eps_split_left_le_rev)
  3.1795 +done
  3.1796 +
  3.1797 +lemma eps_split_right:
  3.1798 +    "[|n le k; emb_chain(DD,ee); m \<in> nat; n \<in> nat; k \<in> nat|] ==>
  3.1799 +     eps(DD,ee,m,n) = eps(DD,ee,k,n) O eps(DD,ee,m,k)"
  3.1800 +apply (rule nat_linear_le)
  3.1801 +apply (rule_tac [3] eps_split_left_le_rev)
  3.1802 +prefer 3 apply assumption
  3.1803 +apply (rule_tac [8] nat_linear_le)
  3.1804 +apply (rule_tac [10] eps_split_right_le)
  3.1805 +prefer 11 apply assumption
  3.1806 +apply (simp_all add: eps_split_right_le_rev)
  3.1807 +done
  3.1808 +
  3.1809 +(*----------------------------------------------------------------------*)
  3.1810 +(* That was eps: D_m -> D_n, NEXT rho_emb: D_n -> Dinf.                 *)
  3.1811 +(*----------------------------------------------------------------------*)
  3.1812 +
  3.1813 +(* Considerably shorter. *)
  3.1814  
  3.1815 -  mediating_def
  3.1816 -    "mediating(E,G,r,f,t) == emb(E,G,t) & (\\<forall>n \\<in> nat. f(n) = t O r(n))"
  3.1817 +lemma rho_emb_fun:
  3.1818 +    "[|emb_chain(DD,ee); n \<in> nat|] ==>
  3.1819 +     rho_emb(DD,ee,n): set(DD`n) -> set(Dinf(DD,ee))"
  3.1820 +apply (simp add: rho_emb_def)
  3.1821 +apply (assumption | rule lam_type DinfI eps_cont [THEN cont_fun, THEN apply_type])+
  3.1822 +apply (simp)
  3.1823 +apply (rule_tac i = "succ (na) " and j = n in nat_linear_le)
  3.1824 +apply blast
  3.1825 +apply assumption
  3.1826 +apply (subst eps_split_right_le)
  3.1827 +prefer 2 apply assumption
  3.1828 +apply simp (*????SIMPROC FAILURE???*)
  3.1829 +apply (rule lt_trans)
  3.1830 +apply (rule le_refl)
  3.1831 +apply (blast intro: nat_into_Ord, simp)
  3.1832 +  (*???END OF SIMPROC FAILURE*)
  3.1833 +apply (assumption | rule add_le_self nat_0I nat_succI)+
  3.1834 +apply (simp add: eps_succ_Rp)
  3.1835 +apply (subst comp_fun_apply)
  3.1836 +apply (assumption | rule eps_fun nat_succI Rp_cont [THEN cont_fun] emb_chain_emb emb_chain_cpo refl)+
  3.1837 +(* Now the second part of the proof. Slightly different than HOL. *)
  3.1838 +apply (simp add: eps_e_less nat_succI)
  3.1839 +apply (erule le_iff [THEN iffD1, THEN disjE])
  3.1840 +apply (simp add: e_less_le)
  3.1841 +apply (subst comp_fun_apply)
  3.1842 +apply (assumption | rule e_less_cont cont_fun emb_chain_emb emb_cont)+
  3.1843 +apply (subst embRp_eq_thm)
  3.1844 +apply (assumption | rule emb_chain_emb e_less_cont [THEN cont_fun, THEN apply_type] emb_chain_cpo nat_succI)+
  3.1845 +apply (simp add: eps_e_less)
  3.1846 +apply (drule asm_rl)
  3.1847 +apply (simp add: eps_succ_Rp e_less_eq id_conv nat_succI)
  3.1848 +done
  3.1849 +
  3.1850 +lemma rho_emb_apply1:
  3.1851 +    "x \<in> set(DD`n) ==> rho_emb(DD,ee,n)`x = (\<lambda>m \<in> nat. eps(DD,ee,n,m)`x)"
  3.1852 +by (simp add: rho_emb_def)
  3.1853 +
  3.1854 +lemma rho_emb_apply2:
  3.1855 +    "[|x \<in> set(DD`n); m \<in> nat|] ==> rho_emb(DD,ee,n)`x`m = eps(DD,ee,n,m)`x"
  3.1856 +by (simp add: rho_emb_def)
  3.1857 +
  3.1858 +lemma rho_emb_id: "[| x \<in> set(DD`n); n \<in> nat|] ==> rho_emb(DD,ee,n)`x`n = x"
  3.1859 +apply (simp add: rho_emb_apply2 eps_id)
  3.1860 +done
  3.1861 +
  3.1862 +(* Shorter proof, 23 against 62. *)
  3.1863 +
  3.1864 +lemma rho_emb_cont:
  3.1865 +    "[|emb_chain(DD,ee); n \<in> nat|] ==>
  3.1866 +     rho_emb(DD,ee,n): cont(DD`n,Dinf(DD,ee))"
  3.1867 +apply (rule contI)
  3.1868 +apply (assumption | rule rho_emb_fun)+
  3.1869 +apply (rule rel_DinfI)
  3.1870 +apply (simp add: rho_emb_def)
  3.1871 +apply (assumption | rule eps_cont [THEN cont_mono]  Dinf_prod apply_type rho_emb_fun)+
  3.1872 +(* Continuity, different order, slightly different proofs. *)
  3.1873 +apply (subst lub_Dinf)
  3.1874 +apply (rule chainI)
  3.1875 +apply (assumption | rule lam_type rho_emb_fun [THEN apply_type]  chain_in)+
  3.1876 +apply (simp)
  3.1877 +apply (rule rel_DinfI)
  3.1878 +apply (simp add: rho_emb_apply2 chain_in)
  3.1879 +apply (assumption | rule eps_cont [THEN cont_mono]  chain_rel Dinf_prod rho_emb_fun [THEN apply_type]  chain_in nat_succI)+
  3.1880 +(* Now, back to the result of applying lub_Dinf *)
  3.1881 +apply (simp add: rho_emb_apply2 chain_in)
  3.1882 +apply (subst rho_emb_apply1)
  3.1883 +apply (assumption | rule cpo_lub [THEN islub_in]  emb_chain_cpo)+
  3.1884 +apply (rule fun_extension)
  3.1885 +apply (assumption | rule lam_type eps_cont [THEN cont_fun, THEN apply_type]  cpo_lub [THEN islub_in]  emb_chain_cpo)+
  3.1886 +apply (assumption | rule cont_chain eps_cont emb_chain_cpo)+
  3.1887 +apply (simp)
  3.1888 +apply (simp add: eps_cont [THEN cont_lub])
  3.1889 +done
  3.1890 +
  3.1891 +(* 32 vs 61, using safe_tac with imp in asm would be unfortunate (5steps) *)
  3.1892 +
  3.1893 +lemma lemma1:
  3.1894 +    "[|m le n; emb_chain(DD,ee); x \<in> set(Dinf(DD,ee)); m \<in> nat; n \<in> nat|] ==>
  3.1895 +     rel(DD`n,e_less(DD,ee,m,n)`(x`m),x`n)"
  3.1896 +apply (erule rev_mp) (* For induction proof *)
  3.1897 +apply (induct_tac n)
  3.1898 +apply (rule impI)
  3.1899 +apply (simp add: e_less_eq)
  3.1900 +apply (subst id_conv)
  3.1901 +apply (assumption | rule apply_type Dinf_prod cpo_refl emb_chain_cpo nat_0I)+
  3.1902 +apply (simp add: le_succ_iff)
  3.1903 +apply (rule impI)
  3.1904 +apply (erule disjE)
  3.1905 +apply (drule mp, assumption)
  3.1906 +apply (rule cpo_trans)
  3.1907 +apply (rule_tac [2] e_less_le [THEN ssubst])
  3.1908 +apply (assumption | rule emb_chain_cpo nat_succI)+
  3.1909 +apply (subst comp_fun_apply)
  3.1910 +apply (assumption | rule emb_chain_emb [THEN emb_cont]  e_less_cont cont_fun apply_type Dinf_prod)+
  3.1911 +apply (rule_tac y = "x`xa" in emb_chain_emb [THEN emb_cont, THEN cont_mono])
  3.1912 +apply (assumption | rule e_less_cont [THEN cont_fun]  apply_type Dinf_prod)+
  3.1913 +apply (rule_tac x1 = x and n1 = xa in Dinf_eq [THEN subst])
  3.1914 +apply (rule_tac [3] comp_fun_apply [THEN subst])
  3.1915 +apply (rule_tac [6] P = "%z. rel (DD ` succ (xa), (ee ` xa O Rp (?DD46 (xa) ` xa,?DD46 (xa) ` succ (xa),?ee46 (xa) ` xa)) ` (x ` succ (xa)),z) " in id_conv [THEN subst])
  3.1916 +apply (rule_tac [7] rel_cf)
  3.1917 +(* Dinf and cont_fun doesn't go well together, both Pi(_,%x._). *)
  3.1918 +(* solves 11 of 12 subgoals *)
  3.1919 +apply (assumption |
  3.1920 +       rule Dinf_prod [THEN apply_type] cont_fun Rp_cont e_less_cont
  3.1921 +            emb_cont emb_chain_emb emb_chain_cpo apply_type embRp_rel
  3.1922 +            disjI1 [THEN le_succ_iff [THEN iffD2]]  nat_succI)+
  3.1923 +apply (simp add: e_less_eq)
  3.1924 +apply (subst id_conv)
  3.1925 +apply (auto intro: apply_type Dinf_prod emb_chain_cpo)
  3.1926 +done
  3.1927 +
  3.1928 +(* 18 vs 40 *)
  3.1929 +
  3.1930 +lemma lemma2:
  3.1931 +    "[|n le m; emb_chain(DD,ee); x \<in> set(Dinf(DD,ee)); m \<in> nat; n \<in> nat|] ==>
  3.1932 +     rel(DD`n,e_gr(DD,ee,m,n)`(x`m),x`n)"
  3.1933 +apply (erule rev_mp) (* For induction proof *)
  3.1934 +apply (induct_tac m)
  3.1935 +apply (rule impI)
  3.1936 +apply (simp add: e_gr_eq)
  3.1937 +apply (subst id_conv)
  3.1938 +apply (assumption | rule apply_type Dinf_prod cpo_refl emb_chain_cpo nat_0I)+
  3.1939 +apply (simp add: le_succ_iff)
  3.1940 +apply (rule impI)
  3.1941 +apply (erule disjE)
  3.1942 +apply (drule mp, assumption)
  3.1943 +apply (subst e_gr_le)
  3.1944 +apply (rule_tac [4] comp_fun_apply [THEN ssubst])
  3.1945 +apply (rule_tac [7] Dinf_eq [THEN ssubst])
  3.1946 +apply (assumption | rule emb_chain_emb emb_chain_cpo Rp_cont e_gr_cont cont_fun emb_cont apply_type Dinf_prod nat_succI)+
  3.1947 +apply (simp add: e_gr_eq)
  3.1948 +apply (subst id_conv)
  3.1949 +apply (auto intro: apply_type Dinf_prod emb_chain_cpo)
  3.1950 +done
  3.1951 +
  3.1952 +lemma eps1:
  3.1953 +    "[|emb_chain(DD,ee); x \<in> set(Dinf(DD,ee)); m \<in> nat; n \<in> nat|] ==>
  3.1954 +     rel(DD`n,eps(DD,ee,m,n)`(x`m),x`n)"
  3.1955 +apply (simp add: eps_def)
  3.1956 +apply (blast intro: lemma1 not_le_iff_lt [THEN iffD1, THEN leI, THEN lemma2]  
  3.1957 +                    nat_into_Ord)
  3.1958 +done
  3.1959 +
  3.1960 +(* The following theorem is needed/useful due to type check for rel_cfI,
  3.1961 +   but also elsewhere.
  3.1962 +   Look for occurences of rel_cfI, rel_DinfI, etc to evaluate the problem. *)
  3.1963 +
  3.1964 +lemma lam_Dinf_cont:
  3.1965 +  "[| emb_chain(DD,ee); n \<in> nat |] ==>
  3.1966 +   (\<lambda>x \<in> set(Dinf(DD,ee)). x`n) \<in> cont(Dinf(DD,ee),DD`n)"
  3.1967 +apply (rule contI)
  3.1968 +apply (assumption | rule lam_type apply_type Dinf_prod)+
  3.1969 +apply (simp)
  3.1970 +apply (assumption | rule rel_Dinf)+
  3.1971 +apply (subst beta)
  3.1972 +apply (auto intro: cpo_Dinf islub_in cpo_lub)
  3.1973 +apply (simp add: chain_in lub_Dinf)
  3.1974 +done
  3.1975 +
  3.1976 +lemma rho_projpair:
  3.1977 +    "[| emb_chain(DD,ee); n \<in> nat |] ==>
  3.1978 +     projpair(DD`n,Dinf(DD,ee),rho_emb(DD,ee,n),rho_proj(DD,ee,n))"
  3.1979 +apply (simp add: rho_proj_def)
  3.1980 +apply (rule projpairI)
  3.1981 +apply (assumption | rule rho_emb_cont)+
  3.1982 +(* lemma used, introduced because same fact needed below due to rel_cfI. *)
  3.1983 +apply (assumption | rule lam_Dinf_cont)+
  3.1984 +(*-----------------------------------------------*)
  3.1985 +(* This part is 7 lines, but 30 in HOL (75% reduction!) *)
  3.1986 +apply (rule fun_extension)
  3.1987 +apply (rule_tac [3] id_conv [THEN ssubst])
  3.1988 +apply (rule_tac [4] comp_fun_apply [THEN ssubst])
  3.1989 +apply (rule_tac [7] beta [THEN ssubst])
  3.1990 +apply (rule_tac [8] rho_emb_id [THEN ssubst])
  3.1991 +apply (assumption | rule comp_fun id_type lam_type rho_emb_fun Dinf_prod [THEN apply_type]  apply_type refl)+
  3.1992 +(*^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^*)
  3.1993 +apply (rule rel_cfI) (* ------------------>>>Yields type cond, not in HOL *)
  3.1994 +apply (subst id_conv)
  3.1995 +apply (rule_tac [2] comp_fun_apply [THEN ssubst])
  3.1996 +apply (rule_tac [5] beta [THEN ssubst])
  3.1997 +apply (rule_tac [6] rho_emb_apply1 [THEN ssubst])
  3.1998 +apply (rule_tac [7] rel_DinfI) (* ------------------>>>Yields type cond, not in HOL *)
  3.1999 +apply (rule_tac [7] beta [THEN ssubst])
  3.2000 +(* Dinf_prod bad with lam_type *)
  3.2001 +apply (assumption |
  3.2002 +       rule eps1 lam_type rho_emb_fun eps_fun
  3.2003 +            Dinf_prod [THEN apply_type] refl)+
  3.2004 +apply (assumption | rule apply_type eps_fun Dinf_prod comp_pres_cont rho_emb_cont lam_Dinf_cont id_cont cpo_Dinf emb_chain_cpo)+
  3.2005 +done
  3.2006 +
  3.2007 +lemma emb_rho_emb:
  3.2008 +  "[| emb_chain(DD,ee); n \<in> nat |] ==> emb(DD`n,Dinf(DD,ee),rho_emb(DD,ee,n))"
  3.2009 +by (auto simp add: emb_def intro: exI rho_projpair)
  3.2010 +
  3.2011 +lemma commuteI: "[| emb_chain(DD,ee); n \<in> nat |] ==>
  3.2012 +   rho_proj(DD,ee,n) \<in> cont(Dinf(DD,ee),DD`n)"
  3.2013 +by (auto intro: rho_projpair projpair_p_cont)
  3.2014 +
  3.2015 +(*----------------------------------------------------------------------*)
  3.2016 +(* Commutivity and universality.                                        *)
  3.2017 +(*----------------------------------------------------------------------*)
  3.2018 +
  3.2019 +lemma commuteI:
  3.2020 +  "[| !!n. n \<in> nat ==> emb(DD`n,E,r(n));
  3.2021 +      !!m n. [|m le n; m \<in> nat; n \<in> nat|] ==> r(n) O eps(DD,ee,m,n) = r(m) |] ==>
  3.2022 +   commute(DD,ee,E,r)"
  3.2023 +by (simp add: commute_def)
  3.2024 +
  3.2025 +lemma commute_emb [TC]:
  3.2026 +  "[| commute(DD,ee,E,r); n \<in> nat |] ==> emb(DD`n,E,r(n))"
  3.2027 +by (simp add: commute_def)
  3.2028 +
  3.2029 +lemma commute_eq:
  3.2030 +  "[| commute(DD,ee,E,r); m le n; m \<in> nat; n \<in> nat |] ==>
  3.2031 +   r(n) O eps(DD,ee,m,n) = r(m) "
  3.2032 +by (simp add: commute_def)
  3.2033 +
  3.2034 +(* Shorter proof: 11 vs 46 lines. *)
  3.2035 +
  3.2036 +lemma rho_emb_commute:
  3.2037 +  "emb_chain(DD,ee) ==> commute(DD,ee,Dinf(DD,ee),rho_emb(DD,ee))"
  3.2038 +apply (rule commuteI)
  3.2039 +apply (assumption | rule emb_rho_emb)+
  3.2040 +apply (rule fun_extension) (* Manual instantiation in HOL. *)
  3.2041 +apply (rule_tac [3] comp_fun_apply [THEN ssubst])
  3.2042 +apply (rule_tac [6] fun_extension) (* Next, clean up and instantiate unknowns *)
  3.2043 +apply (assumption | rule comp_fun rho_emb_fun eps_fun Dinf_prod apply_type)+
  3.2044 +apply (simp add: rho_emb_apply2 eps_fun [THEN apply_type])
  3.2045 +apply (rule comp_fun_apply [THEN subst])
  3.2046 +apply (rule_tac [4] eps_split_left [THEN subst])
  3.2047 +apply (auto intro: eps_fun)
  3.2048 +done
  3.2049 +
  3.2050 +lemma le_succ: "n \<in> nat ==> n le succ(n)"
  3.2051 +by (simp add: le_succ_iff)
  3.2052 +
  3.2053 +(* Shorter proof: 21 vs 83 (106 - 23, due to OAssoc complication) *)
  3.2054 +
  3.2055 +lemma commute_chain:
  3.2056 +  "[| commute(DD,ee,E,r); emb_chain(DD,ee); cpo(E) |] ==>
  3.2057 +   chain(cf(E,E),\<lambda>n \<in> nat. r(n) O Rp(DD`n,E,r(n)))"
  3.2058 +apply (rule chainI)
  3.2059 +apply (blast intro: lam_type cont_cf comp_pres_cont commute_emb Rp_cont emb_cont emb_chain_cpo)
  3.2060 +apply (simp)
  3.2061 +apply (rule_tac r1 = r and m1 = n in commute_eq [THEN subst])
  3.2062 +apply (assumption | rule le_succ nat_succI)+
  3.2063 +apply (subst Rp_comp)
  3.2064 +apply (assumption | rule emb_eps commute_emb emb_chain_cpo le_succ nat_succI)+
  3.2065 +apply (rule comp_assoc [THEN subst]) (* Remember that comp_assoc is simpler in Isa *)
  3.2066 +apply (rule_tac r1 = "r (succ (n))" in comp_assoc [THEN ssubst])
  3.2067 +apply (rule comp_mono)
  3.2068 +apply (blast intro: comp_pres_cont eps_cont emb_eps commute_emb Rp_cont emb_cont emb_chain_cpo le_succ)+
  3.2069 +apply (rule_tac b = "r (succ (n))" in comp_id [THEN subst]) (* 1 subst too much *)
  3.2070 +apply (rule_tac [2] comp_mono)
  3.2071 +apply (blast intro: comp_pres_cont eps_cont emb_eps emb_id commute_emb Rp_cont emb_cont cont_fun emb_chain_cpo le_succ)+
  3.2072 +apply (subst comp_id) (* Undoes "1 subst too much", typing next anyway *)
  3.2073 +apply (blast intro: cont_fun Rp_cont emb_cont commute_emb cont_cf cpo_cf emb_chain_cpo embRp_rel emb_eps le_succ)+
  3.2074 +done
  3.2075 +
  3.2076 +lemma rho_emb_chain:
  3.2077 +  "emb_chain(DD,ee) ==>
  3.2078 +   chain(cf(Dinf(DD,ee),Dinf(DD,ee)),
  3.2079 +         \<lambda>n \<in> nat. rho_emb(DD,ee,n) O Rp(DD`n,Dinf(DD,ee),rho_emb(DD,ee,n)))"
  3.2080 +by (auto intro: commute_chain rho_emb_commute cpo_Dinf)
  3.2081 +
  3.2082 +lemma rho_emb_chain_apply1: "[| emb_chain(DD,ee); x \<in> set(Dinf(DD,ee)) |] ==>
  3.2083 +      chain(Dinf(DD,ee),
  3.2084 +          \<lambda>n \<in> nat.
  3.2085 +           (rho_emb(DD,ee,n) O Rp(DD`n,Dinf(DD,ee),rho_emb(DD,ee,n)))`x)"
  3.2086 +apply (drule rho_emb_chain [THEN chain_cf], assumption, simp)
  3.2087 +done
  3.2088 +
  3.2089 +lemma chain_iprod_emb_chain:
  3.2090 +     "[| chain(iprod(DD),X); emb_chain(DD,ee); n \<in> nat |] ==>
  3.2091 +      chain(DD`n,\<lambda>m \<in> nat. X `m `n)"
  3.2092 +by (auto intro: chain_iprod emb_chain_cpo)
  3.2093 +
  3.2094 +lemma rho_emb_chain_apply2:
  3.2095 +  "[| emb_chain(DD,ee); x \<in> set(Dinf(DD,ee)); n \<in> nat |] ==>
  3.2096 +   chain
  3.2097 +    (DD`n,
  3.2098 +     \<lambda>xa \<in> nat.
  3.2099 +      (rho_emb(DD, ee, xa) O Rp(DD ` xa, Dinf(DD, ee),rho_emb(DD, ee, xa))) `
  3.2100 +       x ` n)"
  3.2101 +by (frule rho_emb_chain_apply1 [THEN chain_Dinf, THEN chain_iprod_emb_chain], 
  3.2102 +    auto)
  3.2103 +
  3.2104 +(* Shorter proof: 32 vs 72 (roughly), Isabelle proof has lemmas. *)
  3.2105 +
  3.2106 +lemma rho_emb_lub:
  3.2107 +  "emb_chain(DD,ee) ==>
  3.2108 +   lub(cf(Dinf(DD,ee),Dinf(DD,ee)),
  3.2109 +       \<lambda>n \<in> nat. rho_emb(DD,ee,n) O Rp(DD`n,Dinf(DD,ee),rho_emb(DD,ee,n))) =
  3.2110 +   id(set(Dinf(DD,ee)))"
  3.2111 +apply (rule cpo_antisym)
  3.2112 +apply (rule cpo_cf) (* Instantiate variable, continued below (would loop otherwise) *)
  3.2113 +apply (assumption | rule cpo_Dinf)+
  3.2114 +apply (rule islub_least)
  3.2115 +apply (assumption | rule cpo_lub rho_emb_chain cpo_cf cpo_Dinf isubI cont_cf id_cont)+
  3.2116 +apply (simp)
  3.2117 +apply (assumption | rule embRp_rel emb_rho_emb emb_chain_cpo cpo_Dinf)+
  3.2118 +apply (rule rel_cfI)
  3.2119 +apply (simp add: lub_cf rho_emb_chain cpo_Dinf)
  3.2120 +apply (rule rel_DinfI) (* Additional assumptions *)
  3.2121 +apply (subst lub_Dinf)
  3.2122 +apply (assumption | rule rho_emb_chain_apply1)+
  3.2123 +defer 1
  3.2124 +apply (assumption | rule Dinf_prod cpo_lub [THEN islub_in]  id_cont
  3.2125 +                     cpo_Dinf cpo_cf cf_cont rho_emb_chain rho_emb_chain_apply1 id_cont [THEN cont_cf])+
  3.2126 +apply (simp)
  3.2127 +apply (rule dominate_islub)
  3.2128 +apply (rule_tac [3] cpo_lub)
  3.2129 +apply (rule_tac [6] x1 = "x`n" in chain_const [THEN chain_fun])
  3.2130 +defer 1
  3.2131 +apply (assumption |
  3.2132 +       rule rho_emb_chain_apply2 emb_chain_cpo islub_const apply_type Dinf_prod emb_chain_cpo chain_fun rho_emb_chain_apply2)+
  3.2133 +apply (rule dominateI, assumption)
  3.2134 +apply (simp)
  3.2135 +apply (subst comp_fun_apply)
  3.2136 +apply (assumption | rule cont_fun Rp_cont emb_cont emb_rho_emb cpo_Dinf emb_chain_cpo)+
  3.2137 +apply (subst rho_projpair [THEN Rp_unique])
  3.2138 +prefer 5
  3.2139 +apply (simp add: rho_proj_def)
  3.2140 +apply (rule rho_emb_id [THEN ssubst])
  3.2141 +apply (auto intro: cpo_Dinf apply_type Dinf_prod emb_chain_cpo)
  3.2142 +done
  3.2143 +
  3.2144 +lemma theta_chain: (* almost same proof as commute_chain *)
  3.2145 +  "[| commute(DD,ee,E,r); commute(DD,ee,G,f);
  3.2146 +      emb_chain(DD,ee); cpo(E); cpo(G) |] ==>
  3.2147 +   chain(cf(E,G),\<lambda>n \<in> nat. f(n) O Rp(DD`n,E,r(n)))"
  3.2148 +apply (rule chainI)
  3.2149 +apply (blast intro: lam_type cont_cf comp_pres_cont commute_emb Rp_cont emb_cont emb_chain_cpo)
  3.2150 +apply (simp)
  3.2151 +apply (rule_tac r1 = r and m1 = n in commute_eq [THEN subst])
  3.2152 +apply (rule_tac [5] r1 = f and m1 = n in commute_eq [THEN subst])
  3.2153 +apply (assumption | rule le_succ nat_succI)+
  3.2154 +apply (subst Rp_comp)
  3.2155 +apply (assumption | rule emb_eps commute_emb emb_chain_cpo le_succ nat_succI)+
  3.2156 +apply (rule comp_assoc [THEN subst]) (* Remember that comp_assoc is simpler in Isa *)
  3.2157 +apply (rule_tac r1 = "f (succ (n))" in comp_assoc [THEN ssubst])
  3.2158 +apply (rule comp_mono)
  3.2159 +apply (blast intro: comp_pres_cont eps_cont emb_eps commute_emb Rp_cont emb_cont emb_chain_cpo le_succ)+
  3.2160 +apply (rule_tac b = "f (succ (n))" in comp_id [THEN subst]) (* 1 subst too much *)
  3.2161 +apply (rule_tac [2] comp_mono)
  3.2162 +apply (blast intro: comp_pres_cont eps_cont emb_eps emb_id commute_emb Rp_cont emb_cont cont_fun emb_chain_cpo le_succ)+
  3.2163 +apply (subst comp_id) (* Undoes "1 subst too much", typing next anyway *)
  3.2164 +apply (blast intro: cont_fun Rp_cont emb_cont commute_emb cont_cf cpo_cf emb_chain_cpo embRp_rel emb_eps le_succ)+
  3.2165 +done
  3.2166 +
  3.2167 +lemma theta_proj_chain: (* similar proof to theta_chain *)
  3.2168 +  "[| commute(DD,ee,E,r); commute(DD,ee,G,f);
  3.2169 +      emb_chain(DD,ee); cpo(E); cpo(G) |]
  3.2170 +   ==> chain(cf(G,E),\<lambda>n \<in> nat. r(n) O Rp(DD`n,G,f(n)))"
  3.2171 +apply (rule chainI)
  3.2172 +apply (blast intro: lam_type cont_cf comp_pres_cont commute_emb Rp_cont emb_cont emb_chain_cpo)
  3.2173 +apply (simp)
  3.2174 +apply (rule_tac r1 = r and m1 = n in commute_eq [THEN subst])
  3.2175 +apply (rule_tac [5] r1 = f and m1 = n in commute_eq [THEN subst])
  3.2176 +apply (assumption | rule le_succ nat_succI)+
  3.2177 +apply (subst Rp_comp)
  3.2178 +apply (assumption | rule emb_eps commute_emb emb_chain_cpo le_succ nat_succI)+
  3.2179 +apply (rule comp_assoc [THEN subst]) (* Remember that comp_assoc is simpler in Isa *)
  3.2180 +apply (rule_tac r1 = "r (succ (n))" in comp_assoc [THEN ssubst])
  3.2181 +apply (rule comp_mono)
  3.2182 +apply (blast intro: comp_pres_cont eps_cont emb_eps commute_emb Rp_cont emb_cont emb_chain_cpo le_succ)+
  3.2183 +apply (rule_tac b = "r (succ (n))" in comp_id [THEN subst]) (* 1 subst too much *)
  3.2184 +apply (rule_tac [2] comp_mono)
  3.2185 +apply (blast intro: comp_pres_cont eps_cont emb_eps emb_id commute_emb Rp_cont emb_cont cont_fun emb_chain_cpo le_succ)+
  3.2186 +apply (subst comp_id) (* Undoes "1 subst too much", typing next anyway *)
  3.2187 +apply (blast intro: cont_fun Rp_cont emb_cont commute_emb cont_cf cpo_cf emb_chain_cpo embRp_rel emb_eps le_succ)+
  3.2188 +done
  3.2189 +
  3.2190 +(* Simplification with comp_assoc is possible inside a \<lambda>-abstraction,
  3.2191 +   because it does not have assumptions. If it had, as the HOL-ST theorem
  3.2192 +   too strongly has, we would be in deep trouble due to HOL's lack of proper
  3.2193 +   conditional rewriting (a HOL contrib provides something that works). *)
  3.2194 +
  3.2195 +(* Controlled simplification inside lambda: introduce lemmas *)
  3.2196 +
  3.2197 +lemma commute_O_lemma:
  3.2198 +     "[| commute(DD,ee,E,r); commute(DD,ee,G,f);
  3.2199 +      emb_chain(DD,ee); cpo(E); cpo(G); x \<in> nat |] ==>
  3.2200 +   r(x) O Rp(DD ` x, G, f(x)) O f(x) O Rp(DD ` x, E, r(x)) =
  3.2201 +   r(x) O Rp(DD ` x, E, r(x))"
  3.2202 +apply (rule_tac s1 = "f (x) " in comp_assoc [THEN subst])
  3.2203 +apply (subst embRp_eq)
  3.2204 +apply (rule_tac [4] id_comp [THEN ssubst])
  3.2205 +apply (auto intro: cont_fun Rp_cont commute_emb emb_chain_cpo)
  3.2206 +done
  3.2207 +
  3.2208 +
  3.2209 +(* Shorter proof (but lemmas): 19 vs 79 (103 - 24, due to OAssoc)  *)
  3.2210 +
  3.2211 +lemma theta_projpair:
  3.2212 +  "[| lub(cf(E,E), \<lambda>n \<in> nat. r(n) O Rp(DD`n,E,r(n))) = id(set(E));
  3.2213 +      commute(DD,ee,E,r); commute(DD,ee,G,f);
  3.2214 +      emb_chain(DD,ee); cpo(E); cpo(G) |] ==>
  3.2215 +   projpair
  3.2216 +    (E,G,
  3.2217 +     lub(cf(E,G), \<lambda>n \<in> nat. f(n) O Rp(DD`n,E,r(n))),
  3.2218 +     lub(cf(G,E), \<lambda>n \<in> nat. r(n) O Rp(DD`n,G,f(n))))"
  3.2219 +
  3.2220 +apply (simp add: projpair_def rho_proj_def, safe)
  3.2221 +apply (rule_tac [3] comp_lubs [THEN ssubst])
  3.2222 +(* The following one line is 15 lines in HOL, and includes existentials. *)
  3.2223 +apply (assumption | rule cf_cont islub_in cpo_lub cpo_cf theta_chain theta_proj_chain)+
  3.2224 +apply (simp (no_asm) add: comp_assoc)
  3.2225 +apply (simp add: commute_O_lemma)
  3.2226 +apply (subst comp_lubs)
  3.2227 +apply (assumption | rule cf_cont islub_in cpo_lub cpo_cf theta_chain theta_proj_chain)+
  3.2228 +apply (simp (no_asm) add: comp_assoc)
  3.2229 +apply (simp add: commute_O_lemma)
  3.2230 +apply (rule dominate_islub)
  3.2231 +defer 1
  3.2232 +apply (rule cpo_lub)
  3.2233 +apply (assumption |
  3.2234 +       rule commute_chain commute_emb islub_const cont_cf id_cont
  3.2235 +    cpo_cf chain_fun chain_const)+
  3.2236 +apply (rule dominateI, assumption)
  3.2237 +apply (simp)
  3.2238 +apply (blast intro: embRp_rel commute_emb emb_chain_cpo)
  3.2239 +done
  3.2240 +
  3.2241 +lemma emb_theta:
  3.2242 +  "[| lub(cf(E,E), \<lambda>n \<in> nat. r(n) O Rp(DD`n,E,r(n))) = id(set(E));
  3.2243 +      commute(DD,ee,E,r); commute(DD,ee,G,f);
  3.2244 +      emb_chain(DD,ee); cpo(E); cpo(G) |] ==>
  3.2245 +   emb(E,G,lub(cf(E,G), \<lambda>n \<in> nat. f(n) O Rp(DD`n,E,r(n))))"
  3.2246 +apply (simp add: emb_def)
  3.2247 +apply (blast intro: theta_projpair)
  3.2248 +done
  3.2249 +
  3.2250 +lemma mono_lemma:
  3.2251 +  "[| g \<in> cont(D,D'); cpo(D); cpo(D'); cpo(E) |] ==>
  3.2252 +   (\<lambda>f \<in> cont(D',E). f O g) \<in> mono(cf(D',E),cf(D,E))"
  3.2253 +apply (rule monoI)
  3.2254 +apply (simp add: set_def cf_def)
  3.2255 +apply (drule cf_cont)+
  3.2256 +apply simp
  3.2257 +apply (blast intro: comp_mono lam_type comp_pres_cont cpo_cf cont_cf)
  3.2258 +done
  3.2259 +
  3.2260 +lemma commute_lam_lemma:
  3.2261 +     "[| commute(DD,ee,E,r); commute(DD,ee,G,f);
  3.2262 +         emb_chain(DD,ee); cpo(E); cpo(G); n \<in> nat |]
  3.2263 +      ==> (\<lambda>na \<in> nat. (\<lambda>f \<in> cont(E, G). f O r(n)) `
  3.2264 +           ((\<lambda>n \<in> nat. f(n) O Rp(DD ` n, E, r(n))) ` na))  =
  3.2265 +          (\<lambda>na \<in> nat. (f(na) O Rp(DD ` na, E, r(na))) O r(n))"
  3.2266 +apply (rule fun_extension)
  3.2267 +apply (auto intro: lam_type)
  3.2268 +done
  3.2269 +
  3.2270 +lemma chain_lemma: "[| commute(DD,ee,E,r); commute(DD,ee,G,f);
  3.2271 +         emb_chain(DD,ee); cpo(E); cpo(G); n \<in> nat |] ==>
  3.2272 +      chain(cf(DD`n,G),\<lambda>x \<in> nat. (f(x) O Rp(DD ` x, E, r(x))) O r(n))"
  3.2273 +apply (rule commute_lam_lemma [THEN subst])
  3.2274 +apply (blast intro: theta_chain emb_chain_cpo commute_emb [THEN emb_cont, THEN mono_lemma, THEN mono_chain])+
  3.2275 +done
  3.2276 +
  3.2277 +lemma suffix_lemma:
  3.2278 +  "[| commute(DD,ee,E,r); commute(DD,ee,G,f);
  3.2279 +      emb_chain(DD,ee); cpo(E); cpo(G); cpo(DD`x); x \<in> nat |] ==>
  3.2280 +   suffix(\<lambda>n \<in> nat. (f(n) O Rp(DD`n,E,r(n))) O r(x),x) = (\<lambda>n \<in> nat. f(x))"
  3.2281 +apply (simp add: suffix_def)
  3.2282 +apply (rule lam_type [THEN fun_extension])
  3.2283 +apply (blast intro: lam_type comp_fun cont_fun Rp_cont emb_cont commute_emb add_type emb_chain_cpo)+
  3.2284 +apply (simp)
  3.2285 +apply (subgoal_tac "f (x #+ xa) O (Rp (DD ` (x #+ xa), E, r (x #+ xa)) O r (x #+ xa)) O eps (DD, ee, x, x #+ xa) = f (x) ")
  3.2286 +apply (simp add: comp_assoc commute_eq add_le_self)
  3.2287 +apply (simp add: embRp_eq eps_fun [THEN id_comp] commute_emb emb_chain_cpo)
  3.2288 +apply (blast intro: commute_eq add_type add_le_self)
  3.2289 +done
  3.2290 +
  3.2291 +
  3.2292 +lemma mediatingI:
  3.2293 +  "[|emb(E,G,t);  !!n. n \<in> nat ==> f(n) = t O r(n) |]==>mediating(E,G,r,f,t)"
  3.2294 +by (simp add: mediating_def)
  3.2295 +
  3.2296 +lemma mediating_emb: "mediating(E,G,r,f,t) ==> emb(E,G,t)"
  3.2297 +by (simp add: mediating_def)
  3.2298 +
  3.2299 +lemma mediating_eq: "[| mediating(E,G,r,f,t); n \<in> nat |] ==> f(n) = t O r(n)"
  3.2300 +by (simp add: mediating_def)
  3.2301 +
  3.2302 +lemma lub_universal_mediating:
  3.2303 +  "[| lub(cf(E,E), \<lambda>n \<in> nat. r(n) O Rp(DD`n,E,r(n))) = id(set(E));
  3.2304 +      commute(DD,ee,E,r); commute(DD,ee,G,f);
  3.2305 +      emb_chain(DD,ee); cpo(E); cpo(G) |]
  3.2306 +   ==> mediating(E,G,r,f,lub(cf(E,G), \<lambda>n \<in> nat. f(n) O Rp(DD`n,E,r(n))))"
  3.2307 +apply (assumption | rule mediatingI emb_theta)+
  3.2308 +apply (rule_tac b = "r (n) " in lub_const [THEN subst])
  3.2309 +apply (rule_tac [3] comp_lubs [THEN ssubst])
  3.2310 +apply (blast intro: cont_cf emb_cont commute_emb cpo_cf theta_chain chain_const emb_chain_cpo)+
  3.2311 +apply (simp (no_asm))
  3.2312 +apply (rule_tac n1 = n in lub_suffix [THEN subst])
  3.2313 +apply (assumption | rule chain_lemma cpo_cf emb_chain_cpo)+
  3.2314 +apply (simp add: suffix_lemma lub_const cont_cf emb_cont commute_emb cpo_cf emb_chain_cpo)
  3.2315 +done
  3.2316 +
  3.2317 +lemma lub_universal_unique:
  3.2318 +  "[| mediating(E,G,r,f,t);
  3.2319 +      lub(cf(E,E), \<lambda>n \<in> nat. r(n) O Rp(DD`n,E,r(n))) = id(set(E));
  3.2320 +      commute(DD,ee,E,r); commute(DD,ee,G,f);
  3.2321 +      emb_chain(DD,ee); cpo(E); cpo(G) |] ==>
  3.2322 +   t = lub(cf(E,G), \<lambda>n \<in> nat. f(n) O Rp(DD`n,E,r(n)))"
  3.2323 +apply (rule_tac b = t in comp_id [THEN subst])
  3.2324 +apply (erule_tac [2] subst)
  3.2325 +apply (rule_tac [2] b = t in lub_const [THEN subst])
  3.2326 +apply (rule_tac [4] comp_lubs [THEN ssubst])
  3.2327 +prefer 9 apply (simp add: comp_assoc mediating_eq)
  3.2328 +apply (assumption |
  3.2329 +       rule cont_fun emb_cont mediating_emb cont_cf cpo_cf chain_const
  3.2330 +            commute_chain emb_chain_cpo)+
  3.2331 +done
  3.2332 +
  3.2333 +(*---------------------------------------------------------------------*)
  3.2334 +(* Dinf yields the inverse_limit, stated as rho_emb_commute and        *)
  3.2335 +(* Dinf_universal.                                                     *)
  3.2336 +(*---------------------------------------------------------------------*)
  3.2337 +
  3.2338 +lemma Dinf_universal:
  3.2339 +  "[| commute(DD,ee,G,f); emb_chain(DD,ee); cpo(G) |] ==>
  3.2340 +   mediating
  3.2341 +    (Dinf(DD,ee),G,rho_emb(DD,ee),f,
  3.2342 +     lub(cf(Dinf(DD,ee),G),
  3.2343 +         \<lambda>n \<in> nat. f(n) O Rp(DD`n,Dinf(DD,ee),rho_emb(DD,ee,n)))) &
  3.2344 +   (\<forall>t. mediating(Dinf(DD,ee),G,rho_emb(DD,ee),f,t) -->
  3.2345 +     t = lub(cf(Dinf(DD,ee),G),
  3.2346 +         \<lambda>n \<in> nat. f(n) O Rp(DD`n,Dinf(DD,ee),rho_emb(DD,ee,n))))"
  3.2347 +apply safe
  3.2348 +apply (assumption | rule lub_universal_mediating rho_emb_commute rho_emb_lub cpo_Dinf)+
  3.2349 +apply (auto intro: lub_universal_unique rho_emb_commute rho_emb_lub cpo_Dinf)
  3.2350 +done
  3.2351 +
  3.2352  
  3.2353  end