Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
authornipkow
Wed Jan 19 17:35:01 1994 +0100 (1994-01-19)
changeset 243c22b85994e17
parent 242 8fe3e66abf0c
child 244 929fc2c63bd0
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
in HOL.
src/HOLCF/Cfun1.ML
src/HOLCF/Cfun1.thy
src/HOLCF/Cfun2.ML
src/HOLCF/Cfun2.thy
src/HOLCF/Cfun3.ML
src/HOLCF/Cfun3.thy
src/HOLCF/Cont.ML
src/HOLCF/Cont.thy
src/HOLCF/Cprod1.ML
src/HOLCF/Cprod1.thy
src/HOLCF/Cprod2.ML
src/HOLCF/Cprod2.thy
src/HOLCF/Cprod3.ML
src/HOLCF/Cprod3.thy
src/HOLCF/Dnat.ML
src/HOLCF/Dnat.thy
src/HOLCF/Dnat2.ML
src/HOLCF/Dnat2.thy
src/HOLCF/Fix.ML
src/HOLCF/Fix.thy
src/HOLCF/Fun1.ML
src/HOLCF/Fun1.thy
src/HOLCF/Fun2.ML
src/HOLCF/Fun2.thy
src/HOLCF/Fun3.ML
src/HOLCF/Fun3.thy
src/HOLCF/HOLCF.ML
src/HOLCF/HOLCF.thy
src/HOLCF/Holcfb.ML
src/HOLCF/Holcfb.thy
src/HOLCF/Lift1.ML
src/HOLCF/Lift1.thy
src/HOLCF/Lift2.ML
src/HOLCF/Lift2.thy
src/HOLCF/Lift3.ML
src/HOLCF/Lift3.thy
src/HOLCF/Makefile
src/HOLCF/One.ML
src/HOLCF/One.thy
src/HOLCF/Pcpo.ML
src/HOLCF/Pcpo.thy
src/HOLCF/Porder.ML
src/HOLCF/Porder.thy
src/HOLCF/ROOT.ML
src/HOLCF/Sprod0.ML
src/HOLCF/Sprod0.thy
src/HOLCF/Sprod1.ML
src/HOLCF/Sprod1.thy
src/HOLCF/Sprod2.ML
src/HOLCF/Sprod2.thy
src/HOLCF/Sprod3.ML
src/HOLCF/Sprod3.thy
src/HOLCF/Ssum0.ML
src/HOLCF/Ssum0.thy
src/HOLCF/Ssum1.ML
src/HOLCF/Ssum1.thy
src/HOLCF/Ssum2.ML
src/HOLCF/Ssum2.thy
src/HOLCF/Ssum3.ML
src/HOLCF/Ssum3.thy
src/HOLCF/Stream.ML
src/HOLCF/Stream.thy
src/HOLCF/Stream2.ML
src/HOLCF/Stream2.thy
src/HOLCF/Tr1.ML
src/HOLCF/Tr1.thy
src/HOLCF/Tr2.ML
src/HOLCF/Tr2.thy
src/HOLCF/Void.ML
src/HOLCF/Void.thy
src/HOLCF/ccc1.ML
src/HOLCF/ccc1.thy
src/HOLCF/cfun1.ML
src/HOLCF/cfun1.thy
src/HOLCF/cfun2.ML
src/HOLCF/cfun2.thy
src/HOLCF/cfun3.ML
src/HOLCF/cfun3.thy
src/HOLCF/cinfix.ML
src/HOLCF/cont.ML
src/HOLCF/cont.thy
src/HOLCF/cprod1.ML
src/HOLCF/cprod1.thy
src/HOLCF/cprod2.ML
src/HOLCF/cprod2.thy
src/HOLCF/cprod3.ML
src/HOLCF/cprod3.thy
src/HOLCF/dnat.ML
src/HOLCF/dnat.thy
src/HOLCF/dnat2.ML
src/HOLCF/dnat2.thy
src/HOLCF/fix.ML
src/HOLCF/fix.thy
src/HOLCF/fun1.ML
src/HOLCF/fun1.thy
src/HOLCF/fun2.ML
src/HOLCF/fun2.thy
src/HOLCF/fun3.ML
src/HOLCF/fun3.thy
src/HOLCF/holcf.ML
src/HOLCF/holcf.thy
src/HOLCF/holcfb.ML
src/HOLCF/holcfb.thy
src/HOLCF/lift1.ML
src/HOLCF/lift1.thy
src/HOLCF/lift2.ML
src/HOLCF/lift2.thy
src/HOLCF/lift3.ML
src/HOLCF/lift3.thy
src/HOLCF/one.ML
src/HOLCF/one.thy
src/HOLCF/pcpo.ML
src/HOLCF/pcpo.thy
src/HOLCF/porder.ML
src/HOLCF/porder.thy
src/HOLCF/sprod0.ML
src/HOLCF/sprod0.thy
src/HOLCF/sprod1.ML
src/HOLCF/sprod1.thy
src/HOLCF/sprod2.ML
src/HOLCF/sprod2.thy
src/HOLCF/sprod3.ML
src/HOLCF/sprod3.thy
src/HOLCF/ssum0.ML
src/HOLCF/ssum0.thy
src/HOLCF/ssum1.ML
src/HOLCF/ssum1.thy
src/HOLCF/ssum2.ML
src/HOLCF/ssum2.thy
src/HOLCF/ssum3.ML
src/HOLCF/ssum3.thy
src/HOLCF/stream.ML
src/HOLCF/stream.thy
src/HOLCF/stream2.ML
src/HOLCF/stream2.thy
src/HOLCF/test
src/HOLCF/tr1.ML
src/HOLCF/tr1.thy
src/HOLCF/tr2.ML
src/HOLCF/tr2.thy
src/HOLCF/void.ML
src/HOLCF/void.thy
     1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/src/HOLCF/Cfun1.ML	Wed Jan 19 17:35:01 1994 +0100
     1.3 @@ -0,0 +1,129 @@
     1.4 +(*  Title: 	HOLCF/cfun1.ML
     1.5 +    ID:         $Id$
     1.6 +    Author: 	Franz Regensburger
     1.7 +    Copyright   1993 Technische Universitaet Muenchen
     1.8 +
     1.9 +Lemmas for cfun1.thy 
    1.10 +*)
    1.11 +
    1.12 +open Cfun1;
    1.13 +
    1.14 +(* ------------------------------------------------------------------------ *)
    1.15 +(* A non-emptyness result for Cfun                                          *)
    1.16 +(* ------------------------------------------------------------------------ *)
    1.17 +
    1.18 +val CfunI = prove_goalw Cfun1.thy [Cfun_def] "(% x.x):Cfun"
    1.19 + (fn prems =>
    1.20 +	[
    1.21 +	(rtac (mem_Collect_eq RS ssubst) 1),
    1.22 +	(rtac contX_id 1)
    1.23 +	]);
    1.24 +
    1.25 +
    1.26 +(* ------------------------------------------------------------------------ *)
    1.27 +(* less_cfun is a partial order on type 'a -> 'b                            *)
    1.28 +(* ------------------------------------------------------------------------ *)
    1.29 +
    1.30 +val refl_less_cfun = prove_goalw Cfun1.thy [less_cfun_def] "less_cfun(f,f)"
    1.31 +(fn prems =>
    1.32 +	[
    1.33 +	(rtac refl_less 1)
    1.34 +	]);
    1.35 +
    1.36 +val antisym_less_cfun = prove_goalw Cfun1.thy [less_cfun_def] 
    1.37 +	"[|less_cfun(f1,f2); less_cfun(f2,f1)|] ==> f1 = f2"
    1.38 +(fn prems =>
    1.39 +	[
    1.40 +	(cut_facts_tac prems 1),
    1.41 +	(rtac injD 1),
    1.42 +	(rtac antisym_less 2),
    1.43 +	(atac 3),
    1.44 +	(atac 2),
    1.45 +	(rtac inj_inverseI 1),
    1.46 +	(rtac Rep_Cfun_inverse 1)
    1.47 +	]);
    1.48 +
    1.49 +val trans_less_cfun = prove_goalw Cfun1.thy [less_cfun_def] 
    1.50 +	"[|less_cfun(f1,f2); less_cfun(f2,f3)|] ==> less_cfun(f1,f3)"
    1.51 +(fn prems =>
    1.52 +	[
    1.53 +	(cut_facts_tac prems 1),
    1.54 +	(etac trans_less 1),
    1.55 +	(atac 1)
    1.56 +	]);
    1.57 +
    1.58 +(* ------------------------------------------------------------------------ *)
    1.59 +(* lemmas about application of continuous functions                         *)
    1.60 +(* ------------------------------------------------------------------------ *)
    1.61 +
    1.62 +val cfun_cong = prove_goal Cfun1.thy 
    1.63 +	 "[| f=g; x=y |] ==> f[x] = g[y]"
    1.64 +(fn prems =>
    1.65 +	[
    1.66 +	(cut_facts_tac prems 1),
    1.67 +	(fast_tac HOL_cs 1)
    1.68 +	]);
    1.69 +
    1.70 +val cfun_fun_cong = prove_goal Cfun1.thy "f=g ==> f[x] = g[x]"
    1.71 +(fn prems =>
    1.72 +	[
    1.73 +	(cut_facts_tac prems 1),
    1.74 +	(etac cfun_cong 1),
    1.75 +	(rtac refl 1)
    1.76 +	]);
    1.77 +
    1.78 +val cfun_arg_cong = prove_goal Cfun1.thy "x=y ==> f[x] = f[y]"
    1.79 +(fn prems =>
    1.80 +	[
    1.81 +	(cut_facts_tac prems 1),
    1.82 +	(rtac cfun_cong 1),
    1.83 +	(rtac refl 1),
    1.84 +	(atac 1)
    1.85 +	]);
    1.86 +
    1.87 +
    1.88 +(* ------------------------------------------------------------------------ *)
    1.89 +(* additional lemma about the isomorphism between -> and Cfun               *)
    1.90 +(* ------------------------------------------------------------------------ *)
    1.91 +
    1.92 +val Abs_Cfun_inverse2 = prove_goal Cfun1.thy "contX(f) ==> fapp(fabs(f)) = f"
    1.93 +(fn prems =>
    1.94 +	[
    1.95 +	(cut_facts_tac prems 1),
    1.96 +	(rtac Abs_Cfun_inverse 1),
    1.97 +	(rewrite_goals_tac [Cfun_def]),
    1.98 +	(etac (mem_Collect_eq RS ssubst) 1)
    1.99 +	]);
   1.100 +
   1.101 +(* ------------------------------------------------------------------------ *)
   1.102 +(* simplification of application                                            *)
   1.103 +(* ------------------------------------------------------------------------ *)
   1.104 +
   1.105 +val Cfunapp2 = prove_goal Cfun1.thy 
   1.106 +	"contX(f) ==> (fabs(f))[x] = f(x)"
   1.107 +(fn prems =>
   1.108 +	[
   1.109 +	(cut_facts_tac prems 1),
   1.110 +	(etac (Abs_Cfun_inverse2 RS fun_cong) 1)
   1.111 +	]);
   1.112 +
   1.113 +(* ------------------------------------------------------------------------ *)
   1.114 +(* beta - equality for continuous functions                                 *)
   1.115 +(* ------------------------------------------------------------------------ *)
   1.116 +
   1.117 +val beta_cfun = prove_goal Cfun1.thy 
   1.118 +	"contX(c1) ==> (LAM x .c1(x))[u] = c1(u)"
   1.119 +(fn prems =>
   1.120 +	[
   1.121 +	(cut_facts_tac prems 1),
   1.122 +	(rtac Cfunapp2 1),
   1.123 +	(atac 1)
   1.124 +	]);
   1.125 +
   1.126 +(* ------------------------------------------------------------------------ *)
   1.127 +(* load ML file cinfix.ML                                                   *)
   1.128 +(* ------------------------------------------------------------------------ *)
   1.129 +
   1.130 +
   1.131 + writeln "Reading file  cinfix.ML"; 
   1.132 +use "cinfix.ML";
     2.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     2.2 +++ b/src/HOLCF/Cfun1.thy	Wed Jan 19 17:35:01 1994 +0100
     2.3 @@ -0,0 +1,45 @@
     2.4 +(*  Title: 	HOLCF/cfun1.thy
     2.5 +    ID:         $Id$
     2.6 +    Author: 	Franz Regensburger
     2.7 +    Copyright   1993 Technische Universitaet Muenchen
     2.8 +
     2.9 +Definition of the type ->  of continuous functions
    2.10 +
    2.11 +*)
    2.12 +
    2.13 +Cfun1 = Cont +
    2.14 +
    2.15 +
    2.16 +(* new type of continuous functions *)
    2.17 +
    2.18 +types "->" 2        (infixr 5)
    2.19 +
    2.20 +arities "->" :: (pcpo,pcpo)term		(* No properties for ->'s range *)
    2.21 +
    2.22 +consts  
    2.23 +	Cfun	:: "('a => 'b)set"
    2.24 +	fapp	:: "('a -> 'b)=>('a => 'b)"	("(_[_])" [11,0] 1000)
    2.25 +						(* usually Rep_Cfun *)
    2.26 +						(* application      *)
    2.27 +
    2.28 +	fabs	:: "('a => 'b)=>('a -> 'b)"	(binder "LAM " 10)
    2.29 +						(* usually Abs_Cfun *)
    2.30 +						(* abstraction      *)
    2.31 +
    2.32 +	less_cfun :: "[('a -> 'b),('a -> 'b)]=>bool"
    2.33 +
    2.34 +rules 
    2.35 +
    2.36 +  Cfun_def	"Cfun == {f. contX(f)}"
    2.37 +
    2.38 +  (*faking a type definition... *)
    2.39 +  (* -> is isomorphic to Cfun   *)
    2.40 +
    2.41 +  Rep_Cfun		"fapp(fo):Cfun"
    2.42 +  Rep_Cfun_inverse	"fabs(fapp(fo)) = fo"
    2.43 +  Abs_Cfun_inverse	"f:Cfun ==> fapp(fabs(f))=f"
    2.44 +
    2.45 +  (*defining the abstract constants*)
    2.46 +  less_cfun_def		"less_cfun(fo1,fo2) == ( fapp(fo1) << fapp(fo2) )"
    2.47 +
    2.48 +end
     3.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     3.2 +++ b/src/HOLCF/Cfun2.ML	Wed Jan 19 17:35:01 1994 +0100
     3.3 @@ -0,0 +1,276 @@
     3.4 +(*  Title: 	HOLCF/cfun2.thy
     3.5 +    ID:         $Id$
     3.6 +    Author: 	Franz Regensburger
     3.7 +    Copyright   1993 Technische Universitaet Muenchen
     3.8 +
     3.9 +Lemmas for cfun2.thy 
    3.10 +*)
    3.11 +
    3.12 +open Cfun2;
    3.13 +
    3.14 +(* ------------------------------------------------------------------------ *)
    3.15 +(* access to less_cfun in class po                                          *)
    3.16 +(* ------------------------------------------------------------------------ *)
    3.17 +
    3.18 +val less_cfun = prove_goal Cfun2.thy "( f1 << f2 ) = (fapp(f1) << fapp(f2))"
    3.19 +(fn prems =>
    3.20 +	[
    3.21 +	(rtac (inst_cfun_po RS ssubst) 1),
    3.22 +	(fold_goals_tac [less_cfun_def]),
    3.23 +	(rtac refl 1)
    3.24 +	]);
    3.25 +
    3.26 +(* ------------------------------------------------------------------------ *)
    3.27 +(* Type 'a ->'b  is pointed                                                 *)
    3.28 +(* ------------------------------------------------------------------------ *)
    3.29 +
    3.30 +val minimal_cfun = prove_goalw Cfun2.thy [UU_cfun_def] "UU_cfun << f"
    3.31 +(fn prems =>
    3.32 +	[
    3.33 +	(rtac (less_cfun RS ssubst) 1),
    3.34 +	(rtac (Abs_Cfun_inverse2 RS ssubst) 1),
    3.35 +	(rtac contX_const 1),
    3.36 +	(fold_goals_tac [UU_fun_def]),
    3.37 +	(rtac minimal_fun 1)
    3.38 +	]);
    3.39 +
    3.40 +(* ------------------------------------------------------------------------ *)
    3.41 +(* fapp yields continuous functions in 'a => 'b                             *)
    3.42 +(* this is continuity of fapp in its 'second' argument                      *)
    3.43 +(* contX_fapp2 ==> monofun_fapp2 & contlub_fapp2                            *)
    3.44 +(* ------------------------------------------------------------------------ *)
    3.45 +
    3.46 +val contX_fapp2 = prove_goal Cfun2.thy "contX(fapp(fo))"
    3.47 +(fn prems =>
    3.48 +	[
    3.49 +	(res_inst_tac [("P","contX")] CollectD 1),
    3.50 +	(fold_goals_tac [Cfun_def]),
    3.51 +	(rtac Rep_Cfun 1)
    3.52 +	]);
    3.53 +
    3.54 +val monofun_fapp2 = contX_fapp2 RS contX2mono;
    3.55 +(* monofun(fapp(?fo1)) *)
    3.56 +
    3.57 +
    3.58 +val contlub_fapp2 = contX_fapp2 RS contX2contlub;
    3.59 +(* contlub(fapp(?fo1)) *)
    3.60 +
    3.61 +(* ------------------------------------------------------------------------ *)
    3.62 +(* expanded thms contX_fapp2, contlub_fapp2                                 *)
    3.63 +(* looks nice with mixfix syntac _[_]                                       *)
    3.64 +(* ------------------------------------------------------------------------ *)
    3.65 +
    3.66 +val contX_cfun_arg = (contX_fapp2 RS contXE RS spec RS mp);
    3.67 +(* is_chain(?x1) ==> range(%i. ?fo3[?x1(i)]) <<| ?fo3[lub(range(?x1))]      *)
    3.68 + 
    3.69 +val contlub_cfun_arg = (contlub_fapp2 RS contlubE RS spec RS mp);
    3.70 +(* is_chain(?x1) ==> ?fo4[lub(range(?x1))] = lub(range(%i. ?fo4[?x1(i)]))   *)
    3.71 +
    3.72 +
    3.73 +
    3.74 +(* ------------------------------------------------------------------------ *)
    3.75 +(* fapp is monotone in its 'first' argument                                 *)
    3.76 +(* ------------------------------------------------------------------------ *)
    3.77 +
    3.78 +val monofun_fapp1 = prove_goalw Cfun2.thy [monofun] "monofun(fapp)"
    3.79 +(fn prems =>
    3.80 +	[
    3.81 +	(strip_tac 1),
    3.82 +	(etac (less_cfun RS subst) 1)
    3.83 +	]);
    3.84 +
    3.85 +
    3.86 +(* ------------------------------------------------------------------------ *)
    3.87 +(* monotonicity of application fapp in mixfix syntax [_]_                   *)
    3.88 +(* ------------------------------------------------------------------------ *)
    3.89 +
    3.90 +val monofun_cfun_fun = prove_goal Cfun2.thy  "f1 << f2 ==> f1[x] << f2[x]"
    3.91 +(fn prems =>
    3.92 +	[
    3.93 +	(cut_facts_tac prems 1),
    3.94 +	(res_inst_tac [("x","x")] spec 1),
    3.95 +	(rtac (less_fun RS subst) 1),
    3.96 +	(etac (monofun_fapp1 RS monofunE RS spec RS spec RS mp) 1)
    3.97 +	]);
    3.98 +
    3.99 +
   3.100 +val monofun_cfun_arg = (monofun_fapp2 RS monofunE RS spec RS spec RS mp);
   3.101 +(* ?x2 << ?x1 ==> ?fo5[?x2] << ?fo5[?x1]                                    *)
   3.102 +
   3.103 +(* ------------------------------------------------------------------------ *)
   3.104 +(* monotonicity of fapp in both arguments in mixfix syntax [_]_             *)
   3.105 +(* ------------------------------------------------------------------------ *)
   3.106 +
   3.107 +val monofun_cfun = prove_goal Cfun2.thy
   3.108 +	"[|f1<<f2;x1<<x2|] ==> f1[x1] << f2[x2]"
   3.109 +(fn prems =>
   3.110 +	[
   3.111 +	(cut_facts_tac prems 1),
   3.112 +	(rtac trans_less 1),
   3.113 +	(etac monofun_cfun_arg 1),
   3.114 +	(etac monofun_cfun_fun 1)
   3.115 +	]);
   3.116 +
   3.117 +
   3.118 +(* ------------------------------------------------------------------------ *)
   3.119 +(* ch2ch - rules for the type 'a -> 'b                                      *)
   3.120 +(* use MF2 lemmas from Cont.ML                                              *)
   3.121 +(* ------------------------------------------------------------------------ *)
   3.122 +
   3.123 +val ch2ch_fappR = prove_goal Cfun2.thy 
   3.124 + "is_chain(Y) ==> is_chain(%i. f[Y(i)])"
   3.125 +(fn prems =>
   3.126 +	[
   3.127 +	(cut_facts_tac prems 1),
   3.128 +	(etac (monofun_fapp2 RS ch2ch_MF2R) 1)
   3.129 +	]);
   3.130 +
   3.131 +
   3.132 +val ch2ch_fappL = (monofun_fapp1 RS ch2ch_MF2L);
   3.133 +(* is_chain(?F) ==> is_chain(%i. ?F(i)[?x])                                 *)
   3.134 +
   3.135 +
   3.136 +(* ------------------------------------------------------------------------ *)
   3.137 +(*  the lub of a chain of continous functions is monotone                   *)
   3.138 +(* use MF2 lemmas from Cont.ML                                              *)
   3.139 +(* ------------------------------------------------------------------------ *)
   3.140 +
   3.141 +val lub_cfun_mono = prove_goal Cfun2.thy 
   3.142 +	"is_chain(F) ==> monofun(% x.lub(range(% j.F(j)[x])))"
   3.143 +(fn prems =>
   3.144 +	[
   3.145 +	(cut_facts_tac prems 1),
   3.146 +	(rtac lub_MF2_mono 1),
   3.147 +	(rtac monofun_fapp1 1),
   3.148 +	(rtac (monofun_fapp2 RS allI) 1),
   3.149 +	(atac 1)
   3.150 +	]);
   3.151 +
   3.152 +(* ------------------------------------------------------------------------ *)
   3.153 +(* a lemma about the exchange of lubs for type 'a -> 'b                     *)
   3.154 +(* use MF2 lemmas from Cont.ML                                              *)
   3.155 +(* ------------------------------------------------------------------------ *)
   3.156 +
   3.157 +val ex_lubcfun = prove_goal Cfun2.thy
   3.158 +	"[| is_chain(F); is_chain(Y) |] ==>\
   3.159 +\		lub(range(%j. lub(range(%i. F(j)[Y(i)])))) =\
   3.160 +\		lub(range(%i. lub(range(%j. F(j)[Y(i)]))))"
   3.161 +(fn prems =>
   3.162 +	[
   3.163 +	(cut_facts_tac prems 1),
   3.164 +	(rtac ex_lubMF2 1),
   3.165 +	(rtac monofun_fapp1 1),
   3.166 +	(rtac (monofun_fapp2 RS allI) 1),
   3.167 +	(atac 1),
   3.168 +	(atac 1)
   3.169 +	]);
   3.170 +
   3.171 +(* ------------------------------------------------------------------------ *)
   3.172 +(* the lub of a chain of cont. functions is continuous                      *)
   3.173 +(* ------------------------------------------------------------------------ *)
   3.174 +
   3.175 +val contX_lubcfun = prove_goal Cfun2.thy 
   3.176 +	"is_chain(F) ==> contX(% x.lub(range(% j.F(j)[x])))"
   3.177 +(fn prems =>
   3.178 +	[
   3.179 +	(cut_facts_tac prems 1),
   3.180 +	(rtac monocontlub2contX 1),
   3.181 +	(etac lub_cfun_mono 1),
   3.182 +	(rtac contlubI 1),
   3.183 +	(strip_tac 1),
   3.184 +	(rtac (contlub_cfun_arg RS ext RS ssubst) 1),
   3.185 +	(atac 1),
   3.186 +	(etac ex_lubcfun 1),
   3.187 +	(atac 1)
   3.188 +	]);
   3.189 +
   3.190 +(* ------------------------------------------------------------------------ *)
   3.191 +(* type 'a -> 'b is chain complete                                          *)
   3.192 +(* ------------------------------------------------------------------------ *)
   3.193 +
   3.194 +val lub_cfun = prove_goal Cfun2.thy 
   3.195 +  "is_chain(CCF) ==> range(CCF) <<| fabs(% x.lub(range(% i.CCF(i)[x])))"
   3.196 +(fn prems =>
   3.197 +	[
   3.198 +	(cut_facts_tac prems 1),
   3.199 +	(rtac is_lubI 1),
   3.200 +	(rtac conjI 1),
   3.201 +	(rtac ub_rangeI 1),  
   3.202 +	(rtac allI 1),
   3.203 +	(rtac (less_cfun RS ssubst) 1),
   3.204 +	(rtac (Abs_Cfun_inverse2 RS ssubst) 1),
   3.205 +	(etac contX_lubcfun 1),
   3.206 +	(rtac (lub_fun RS is_lubE RS conjunct1 RS ub_rangeE RS spec) 1),
   3.207 +	(etac (monofun_fapp1 RS ch2ch_monofun) 1),
   3.208 +	(strip_tac 1),
   3.209 +	(rtac (less_cfun RS ssubst) 1),
   3.210 +	(rtac (Abs_Cfun_inverse2 RS ssubst) 1),
   3.211 +	(etac contX_lubcfun 1),
   3.212 +	(rtac (lub_fun RS is_lubE RS conjunct2 RS spec RS mp) 1),
   3.213 +	(etac (monofun_fapp1 RS ch2ch_monofun) 1),
   3.214 +	(etac (monofun_fapp1 RS ub2ub_monofun) 1)
   3.215 +	]);
   3.216 +
   3.217 +val thelub_cfun = (lub_cfun RS thelubI);
   3.218 +(* 
   3.219 +is_chain(?CCF1) ==> lub(range(?CCF1)) = fabs(%x. lub(range(%i. ?CCF1(i)[x])))
   3.220 +*)
   3.221 +
   3.222 +val cpo_fun = prove_goal Cfun2.thy 
   3.223 +  "is_chain(CCF::nat=>('a::pcpo->'b::pcpo)) ==> ? x. range(CCF) <<| x"
   3.224 +(fn prems =>
   3.225 +	[
   3.226 +	(cut_facts_tac prems 1),
   3.227 +	(rtac exI 1),
   3.228 +	(etac lub_cfun 1)
   3.229 +	]);
   3.230 +
   3.231 +
   3.232 +(* ------------------------------------------------------------------------ *)
   3.233 +(* Extensionality in 'a -> 'b                                               *)
   3.234 +(* ------------------------------------------------------------------------ *)
   3.235 +
   3.236 +val ext_cfun = prove_goal Cfun1.thy "(!!x. f[x] = g[x]) ==> f = g"
   3.237 + (fn prems =>
   3.238 +	[
   3.239 +	(res_inst_tac [("t","f")] (Rep_Cfun_inverse RS subst) 1),
   3.240 +	(res_inst_tac [("t","g")] (Rep_Cfun_inverse RS subst) 1),
   3.241 +	(res_inst_tac [("f","fabs")] arg_cong 1),
   3.242 +	(rtac ext 1),
   3.243 +	(resolve_tac prems 1)
   3.244 +	]);
   3.245 +
   3.246 +(* ------------------------------------------------------------------------ *)
   3.247 +(* Monotonicity of fabs                                                     *)
   3.248 +(* ------------------------------------------------------------------------ *)
   3.249 +
   3.250 +val semi_monofun_fabs = prove_goal Cfun2.thy 
   3.251 +	"[|contX(f);contX(g);f<<g|]==>fabs(f)<<fabs(g)"
   3.252 + (fn prems =>
   3.253 +	[
   3.254 +	(rtac (less_cfun RS iffD2) 1),
   3.255 +	(rtac (Abs_Cfun_inverse2 RS ssubst) 1),
   3.256 +	(resolve_tac prems 1),
   3.257 +	(rtac (Abs_Cfun_inverse2 RS ssubst) 1),
   3.258 +	(resolve_tac prems 1),
   3.259 +	(resolve_tac prems 1)
   3.260 +	]);
   3.261 +
   3.262 +(* ------------------------------------------------------------------------ *)
   3.263 +(* Extenionality wrt. << in 'a -> 'b                                        *)
   3.264 +(* ------------------------------------------------------------------------ *)
   3.265 +
   3.266 +val less_cfun2 = prove_goal Cfun2.thy "(!!x. f[x] << g[x]) ==> f << g"
   3.267 + (fn prems =>
   3.268 +	[
   3.269 +	(res_inst_tac [("t","f")] (Rep_Cfun_inverse RS subst) 1),
   3.270 +	(res_inst_tac [("t","g")] (Rep_Cfun_inverse RS subst) 1),
   3.271 +	(rtac semi_monofun_fabs 1),
   3.272 +	(rtac contX_fapp2 1),
   3.273 +	(rtac contX_fapp2 1),
   3.274 +	(rtac (less_fun RS iffD2) 1),
   3.275 +	(rtac allI 1),
   3.276 +	(resolve_tac prems 1)
   3.277 +	]);
   3.278 +
   3.279 +
     4.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     4.2 +++ b/src/HOLCF/Cfun2.thy	Wed Jan 19 17:35:01 1994 +0100
     4.3 @@ -0,0 +1,39 @@
     4.4 +(*  Title: 	HOLCF/cfun2.thy
     4.5 +    ID:         $Id$
     4.6 +    Author: 	Franz Regensburger
     4.7 +    Copyright   1993 Technische Universitaet Muenchen
     4.8 +
     4.9 +Class Instance ->::(pcpo,pcpo)po
    4.10 +
    4.11 +*)
    4.12 +
    4.13 +Cfun2 = Cfun1 + 
    4.14 +
    4.15 +(* Witness for the above arity axiom is cfun1.ML *)
    4.16 +arities "->" :: (pcpo,pcpo)po
    4.17 +
    4.18 +consts	
    4.19 +	UU_cfun  :: "'a->'b"
    4.20 +
    4.21 +rules
    4.22 +
    4.23 +(* instance of << for type ['a -> 'b]  *)
    4.24 +
    4.25 +inst_cfun_po	"(op <<)::['a->'b,'a->'b]=>bool = less_cfun"
    4.26 +
    4.27 +(* definitions *)
    4.28 +(* The least element in type 'a->'b *)
    4.29 +
    4.30 +UU_cfun_def	"UU_cfun == fabs(% x.UU)"
    4.31 +
    4.32 +end
    4.33 +
    4.34 +ML
    4.35 +
    4.36 +(* ----------------------------------------------------------------------*)
    4.37 +(* unique setup of print translation for fapp                            *)
    4.38 +(* ----------------------------------------------------------------------*)
    4.39 +
    4.40 +val print_translation = [("fapp",fapptr')];
    4.41 +
    4.42 +
     5.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     5.2 +++ b/src/HOLCF/Cfun3.ML	Wed Jan 19 17:35:01 1994 +0100
     5.3 @@ -0,0 +1,403 @@
     5.4 +(*  Title: 	HOLCF/cfun3.ML
     5.5 +    ID:         $Id$
     5.6 +    Author: 	Franz Regensburger
     5.7 +    Copyright   1993 Technische Universitaet Muenchen
     5.8 +*)
     5.9 +
    5.10 +open Cfun3;
    5.11 +
    5.12 +(* ------------------------------------------------------------------------ *)
    5.13 +(* the contlub property for fapp its 'first' argument                       *)
    5.14 +(* ------------------------------------------------------------------------ *)
    5.15 +
    5.16 +val contlub_fapp1 = prove_goal Cfun3.thy "contlub(fapp)"
    5.17 +(fn prems =>
    5.18 +	[
    5.19 +	(rtac contlubI 1),
    5.20 +	(strip_tac 1),
    5.21 +	(rtac (expand_fun_eq RS iffD2) 1),
    5.22 +	(strip_tac 1),
    5.23 +	(rtac (lub_cfun RS thelubI RS ssubst) 1),
    5.24 +	(atac 1),
    5.25 +	(rtac (Cfunapp2 RS ssubst) 1),
    5.26 +	(etac contX_lubcfun 1),
    5.27 +	(rtac (lub_fun RS thelubI RS ssubst) 1),
    5.28 +	(etac (monofun_fapp1 RS ch2ch_monofun) 1),
    5.29 +	(rtac refl 1)
    5.30 +	]);
    5.31 +
    5.32 +
    5.33 +(* ------------------------------------------------------------------------ *)
    5.34 +(* the contX property for fapp in its first argument                        *)
    5.35 +(* ------------------------------------------------------------------------ *)
    5.36 +
    5.37 +val contX_fapp1 = prove_goal Cfun3.thy "contX(fapp)"
    5.38 +(fn prems =>
    5.39 +	[
    5.40 +	(rtac monocontlub2contX 1),
    5.41 +	(rtac monofun_fapp1 1),
    5.42 +	(rtac contlub_fapp1 1)
    5.43 +	]);
    5.44 +
    5.45 +
    5.46 +(* ------------------------------------------------------------------------ *)
    5.47 +(* contlub, contX properties of fapp in its first argument in mixfix _[_]   *)
    5.48 +(* ------------------------------------------------------------------------ *)
    5.49 +
    5.50 +val contlub_cfun_fun = prove_goal Cfun3.thy 
    5.51 +"is_chain(FY) ==>\
    5.52 +\ lub(range(FY))[x] = lub(range(%i.FY(i)[x]))"
    5.53 +(fn prems =>
    5.54 +	[
    5.55 +	(cut_facts_tac prems 1),
    5.56 +	(rtac trans 1),
    5.57 +	(etac (contlub_fapp1 RS contlubE RS spec RS mp RS fun_cong) 1),
    5.58 +	(rtac (thelub_fun RS ssubst) 1),
    5.59 +	(etac (monofun_fapp1 RS ch2ch_monofun) 1),
    5.60 +	(rtac refl 1)
    5.61 +	]);
    5.62 +
    5.63 +
    5.64 +val contX_cfun_fun = prove_goal Cfun3.thy 
    5.65 +"is_chain(FY) ==>\
    5.66 +\ range(%i.FY(i)[x]) <<| lub(range(FY))[x]"
    5.67 +(fn prems =>
    5.68 +	[
    5.69 +	(cut_facts_tac prems 1),
    5.70 +	(rtac thelubE 1),
    5.71 +	(etac ch2ch_fappL 1),
    5.72 +	(etac (contlub_cfun_fun RS sym) 1)
    5.73 +	]);
    5.74 +
    5.75 +
    5.76 +(* ------------------------------------------------------------------------ *)
    5.77 +(* contlub, contX  properties of fapp in both argument in mixfix _[_]       *)
    5.78 +(* ------------------------------------------------------------------------ *)
    5.79 +
    5.80 +val contlub_cfun = prove_goal Cfun3.thy 
    5.81 +"[|is_chain(FY);is_chain(TY)|] ==>\
    5.82 +\ lub(range(FY))[lub(range(TY))] = lub(range(%i.FY(i)[TY(i)]))"
    5.83 +(fn prems =>
    5.84 +	[
    5.85 +	(cut_facts_tac prems 1),
    5.86 +	(rtac contlub_CF2 1),
    5.87 +	(rtac contX_fapp1 1),
    5.88 +	(rtac allI 1),
    5.89 +	(rtac contX_fapp2 1),
    5.90 +	(atac 1),
    5.91 +	(atac 1)
    5.92 +	]);
    5.93 +
    5.94 +val contX_cfun = prove_goal Cfun3.thy 
    5.95 +"[|is_chain(FY);is_chain(TY)|] ==>\
    5.96 +\ range(%i.FY(i)[TY(i)]) <<| lub(range(FY))[lub(range(TY))]"
    5.97 +(fn prems =>
    5.98 +	[
    5.99 +	(cut_facts_tac prems 1),
   5.100 +	(rtac thelubE 1),
   5.101 +	(rtac (monofun_fapp1 RS ch2ch_MF2LR) 1),
   5.102 +	(rtac allI 1),
   5.103 +	(rtac monofun_fapp2 1),
   5.104 +	(atac 1),
   5.105 +	(atac 1),
   5.106 +	(etac (contlub_cfun RS sym) 1),
   5.107 +	(atac 1)
   5.108 +	]);
   5.109 +
   5.110 +
   5.111 +(* ------------------------------------------------------------------------ *)
   5.112 +(* contX2contX lemma for fapp                                               *)
   5.113 +(* ------------------------------------------------------------------------ *)
   5.114 +
   5.115 +val contX2contX_fapp = prove_goal Cfun3.thy 
   5.116 +	"[|contX(%x.ft(x));contX(%x.tt(x))|] ==> contX(%x.(ft(x))[tt(x)])"
   5.117 + (fn prems =>
   5.118 +	[
   5.119 +	(cut_facts_tac prems 1),
   5.120 +	(rtac contX2contX_app2 1),
   5.121 +	(rtac contX2contX_app2 1),
   5.122 +	(rtac contX_const 1),
   5.123 +	(rtac contX_fapp1 1),
   5.124 +	(atac 1),
   5.125 +	(rtac contX_fapp2 1),
   5.126 +	(atac 1)
   5.127 +	]);
   5.128 +
   5.129 +
   5.130 +
   5.131 +(* ------------------------------------------------------------------------ *)
   5.132 +(* contX2mono Lemma for %x. LAM y. c1(x,y)                                  *)
   5.133 +(* ------------------------------------------------------------------------ *)
   5.134 +
   5.135 +val contX2mono_LAM = prove_goal Cfun3.thy 
   5.136 + "[|!x.contX(c1(x)); !y.monofun(%x.c1(x,y))|] ==>\
   5.137 +\	 		monofun(%x. LAM y. c1(x,y))"
   5.138 +(fn prems =>
   5.139 +	[
   5.140 +	(cut_facts_tac prems 1),
   5.141 +	(rtac monofunI 1),
   5.142 +	(strip_tac 1),
   5.143 +	(rtac (less_cfun RS ssubst) 1),
   5.144 +	(rtac (less_fun RS ssubst) 1),
   5.145 +	(rtac allI 1),
   5.146 +	(rtac (beta_cfun RS ssubst) 1),
   5.147 +	(etac spec 1),
   5.148 +	(rtac (beta_cfun RS ssubst) 1),
   5.149 +	(etac spec 1),
   5.150 +	(etac ((hd (tl prems)) RS spec RS monofunE RS spec RS spec RS mp) 1)
   5.151 +	]);
   5.152 +
   5.153 +(* ------------------------------------------------------------------------ *)
   5.154 +(* contX2contX Lemma for %x. LAM y. c1(x,y)                                 *)
   5.155 +(* ------------------------------------------------------------------------ *)
   5.156 +
   5.157 +val contX2contX_LAM = prove_goal Cfun3.thy 
   5.158 + "[| !x.contX(c1(x)); !y.contX(%x.c1(x,y)) |] ==> contX(%x. LAM y. c1(x,y))"
   5.159 +(fn prems =>
   5.160 +	[
   5.161 +	(cut_facts_tac prems 1),
   5.162 +	(rtac monocontlub2contX 1),
   5.163 +	(etac contX2mono_LAM 1),
   5.164 +	(rtac (contX2mono RS allI) 1),
   5.165 +	(etac spec 1),
   5.166 +	(rtac contlubI 1),
   5.167 +	(strip_tac 1),
   5.168 +	(rtac (thelub_cfun RS ssubst) 1),
   5.169 +	(rtac (contX2mono_LAM RS ch2ch_monofun) 1),
   5.170 +	(atac 1),
   5.171 +	(rtac (contX2mono RS allI) 1),
   5.172 +	(etac spec 1),
   5.173 +	(atac 1),
   5.174 +	(res_inst_tac [("f","fabs")] arg_cong 1),
   5.175 +	(rtac ext 1),
   5.176 +	(rtac (beta_cfun RS ext RS ssubst) 1),
   5.177 +	(etac spec 1),
   5.178 +	(rtac (contX2contlub RS contlubE 
   5.179 +		RS spec RS mp ) 1),
   5.180 +	(etac spec 1),
   5.181 +	(atac 1)
   5.182 +	]);
   5.183 +
   5.184 +(* ------------------------------------------------------------------------ *)
   5.185 +(* elimination of quantifier in premisses of contX2contX_LAM yields good    *)
   5.186 +(* lemma for the contX tactic                                               *)
   5.187 +(* ------------------------------------------------------------------------ *)
   5.188 +
   5.189 +val contX2contX_LAM2 = (allI RSN (2,(allI RS contX2contX_LAM)));
   5.190 +(*
   5.191 +	[| !!x. contX(?c1.0(x)); !!y. contX(%x. ?c1.0(x,y)) |] ==>
   5.192 +					contX(%x. LAM y. ?c1.0(x,y))
   5.193 +*)
   5.194 +
   5.195 +(* ------------------------------------------------------------------------ *)
   5.196 +(* contX2contX tactic                                                       *)
   5.197 +(* ------------------------------------------------------------------------ *)
   5.198 +
   5.199 +val contX_lemmas = [contX_const, contX_id, contX_fapp2,
   5.200 +			contX2contX_fapp,contX2contX_LAM2];
   5.201 +
   5.202 +
   5.203 +val contX_tac = (fn i => (resolve_tac contX_lemmas i));
   5.204 +
   5.205 +val contX_tacR = (fn i => (REPEAT (contX_tac i)));
   5.206 +
   5.207 +(* ------------------------------------------------------------------------ *)
   5.208 +(* function application _[_]  is strict in its first arguments              *)
   5.209 +(* ------------------------------------------------------------------------ *)
   5.210 +
   5.211 +val strict_fapp1 = prove_goal Cfun3.thy "UU[x] = UU"
   5.212 + (fn prems =>
   5.213 +	[
   5.214 +	(rtac (inst_cfun_pcpo RS ssubst) 1),
   5.215 +	(rewrite_goals_tac [UU_cfun_def]),
   5.216 +	(rtac (beta_cfun RS ssubst) 1),
   5.217 +	(contX_tac 1),
   5.218 +	(rtac refl 1)
   5.219 +	]);
   5.220 +
   5.221 +
   5.222 +(* ------------------------------------------------------------------------ *)
   5.223 +(* results about strictify                                                  *)
   5.224 +(* ------------------------------------------------------------------------ *)
   5.225 +
   5.226 +val Istrictify1 = prove_goalw Cfun3.thy [Istrictify_def]
   5.227 +	"Istrictify(f)(UU)=UU"
   5.228 + (fn prems =>
   5.229 +	[
   5.230 +	(rtac select_equality 1),
   5.231 +	(fast_tac HOL_cs 1),
   5.232 +	(fast_tac HOL_cs 1)
   5.233 +	]);
   5.234 +
   5.235 +val Istrictify2 = prove_goalw Cfun3.thy [Istrictify_def]
   5.236 +	"~x=UU ==> Istrictify(f)(x)=f[x]"
   5.237 + (fn prems =>
   5.238 +	[
   5.239 +	(cut_facts_tac prems 1),
   5.240 +	(rtac select_equality 1),
   5.241 +	(fast_tac HOL_cs 1),
   5.242 +	(fast_tac HOL_cs 1)
   5.243 +	]);
   5.244 +
   5.245 +val monofun_Istrictify1 = prove_goal Cfun3.thy "monofun(Istrictify)"
   5.246 + (fn prems =>
   5.247 +	[
   5.248 +	(rtac monofunI 1),
   5.249 +	(strip_tac 1),
   5.250 +	(rtac (less_fun RS iffD2) 1),
   5.251 +	(strip_tac 1),
   5.252 +	(res_inst_tac [("Q","xa=UU")] (excluded_middle RS disjE) 1),
   5.253 +	(rtac (Istrictify2 RS ssubst) 1),
   5.254 +	(atac 1),
   5.255 +	(rtac (Istrictify2 RS ssubst) 1),
   5.256 +	(atac 1),
   5.257 +	(rtac monofun_cfun_fun 1),
   5.258 +	(atac 1),
   5.259 +	(hyp_subst_tac 1),
   5.260 +	(rtac (Istrictify1 RS ssubst) 1),
   5.261 +	(rtac (Istrictify1 RS ssubst) 1),
   5.262 +	(rtac refl_less 1)
   5.263 +	]);
   5.264 +
   5.265 +val monofun_Istrictify2 = prove_goal Cfun3.thy "monofun(Istrictify(f))"
   5.266 + (fn prems =>
   5.267 +	[
   5.268 +	(rtac monofunI 1),
   5.269 +	(strip_tac 1),
   5.270 +	(res_inst_tac [("Q","x=UU")] (excluded_middle RS disjE) 1),
   5.271 +	(rtac (Istrictify2 RS ssubst) 1),
   5.272 +	(etac notUU_I 1),
   5.273 +	(atac 1),
   5.274 +	(rtac (Istrictify2 RS ssubst) 1),
   5.275 +	(atac 1),
   5.276 +	(rtac monofun_cfun_arg 1),
   5.277 +	(atac 1),
   5.278 +	(hyp_subst_tac 1),
   5.279 +	(rtac (Istrictify1 RS ssubst) 1),
   5.280 +	(rtac minimal 1)
   5.281 +	]);
   5.282 +
   5.283 +
   5.284 +val contlub_Istrictify1 = prove_goal Cfun3.thy "contlub(Istrictify)"
   5.285 + (fn prems =>
   5.286 +	[
   5.287 +	(rtac contlubI 1),
   5.288 +	(strip_tac 1),
   5.289 +	(rtac (expand_fun_eq RS iffD2) 1),
   5.290 +	(strip_tac 1),
   5.291 +	(rtac (thelub_fun RS ssubst) 1),
   5.292 +	(etac (monofun_Istrictify1 RS ch2ch_monofun) 1),
   5.293 +	(res_inst_tac [("Q","x=UU")] (excluded_middle RS disjE) 1),
   5.294 +	(rtac (Istrictify2 RS ssubst) 1),
   5.295 +	(atac 1),
   5.296 +	(rtac (Istrictify2 RS ext RS ssubst) 1),
   5.297 +	(atac 1),
   5.298 +	(rtac (thelub_cfun RS ssubst) 1),
   5.299 +	(atac 1),
   5.300 +	(rtac (beta_cfun RS ssubst) 1),
   5.301 +	(rtac contX_lubcfun 1),
   5.302 +	(atac 1),
   5.303 +	(rtac refl 1),
   5.304 +	(hyp_subst_tac 1),
   5.305 +	(rtac (Istrictify1 RS ssubst) 1),
   5.306 +	(rtac (Istrictify1 RS ext RS ssubst) 1),
   5.307 +	(rtac (chain_UU_I_inverse RS sym) 1),
   5.308 +	(rtac (refl RS allI) 1)
   5.309 +	]);
   5.310 +
   5.311 +val contlub_Istrictify2 = prove_goal Cfun3.thy "contlub(Istrictify(f))"
   5.312 + (fn prems =>
   5.313 +	[
   5.314 +	(rtac contlubI 1),
   5.315 +	(strip_tac 1),
   5.316 +	(res_inst_tac [("Q","lub(range(Y))=UU")] classical2 1),
   5.317 +	(res_inst_tac [("t","lub(range(Y))")] subst 1),
   5.318 +	(rtac sym 1),
   5.319 +	(atac 1),
   5.320 +	(rtac (Istrictify1 RS ssubst) 1),
   5.321 +	(rtac sym 1),
   5.322 +	(rtac chain_UU_I_inverse 1),
   5.323 +	(strip_tac 1),
   5.324 +	(res_inst_tac [("t","Y(i)"),("s","UU")] subst 1),
   5.325 +	(rtac sym 1),
   5.326 +	(rtac (chain_UU_I RS spec) 1),
   5.327 +	(atac 1),
   5.328 +	(atac 1),
   5.329 +	(rtac Istrictify1 1),
   5.330 +	(rtac (Istrictify2 RS ssubst) 1),
   5.331 +	(atac 1),
   5.332 +	(res_inst_tac [("s","lub(range(%i. f[Y(i)]))")] trans 1),
   5.333 +	(rtac contlub_cfun_arg 1),
   5.334 +	(atac 1),
   5.335 +	(rtac lub_equal2 1),
   5.336 +	(rtac (chain_mono2 RS exE) 1),
   5.337 +	(atac 2),
   5.338 +	(rtac chain_UU_I_inverse2 1),
   5.339 +	(atac 1),
   5.340 +	(rtac exI 1),
   5.341 +	(strip_tac 1),
   5.342 +	(rtac (Istrictify2 RS sym) 1),
   5.343 +	(fast_tac HOL_cs 1),
   5.344 +	(rtac ch2ch_monofun 1),
   5.345 +	(rtac monofun_fapp2 1),
   5.346 +	(atac 1),
   5.347 +	(rtac ch2ch_monofun 1),
   5.348 +	(rtac monofun_Istrictify2 1),
   5.349 +	(atac 1)
   5.350 +	]);
   5.351 +
   5.352 +
   5.353 +val contX_Istrictify1 =	(contlub_Istrictify1 RS 
   5.354 +	(monofun_Istrictify1 RS monocontlub2contX)); 
   5.355 +
   5.356 +val contX_Istrictify2 = (contlub_Istrictify2 RS 
   5.357 +	(monofun_Istrictify2 RS monocontlub2contX)); 
   5.358 +
   5.359 +
   5.360 +val strictify1 = prove_goalw Cfun3.thy [strictify_def]
   5.361 +	"strictify[f][UU]=UU"
   5.362 + (fn prems =>
   5.363 +	[
   5.364 +	(rtac (beta_cfun RS ssubst) 1),
   5.365 +	(contX_tac 1),
   5.366 +	(rtac contX_Istrictify2 1),
   5.367 +	(rtac contX2contX_CF1L 1),
   5.368 +	(rtac contX_Istrictify1 1),
   5.369 +	(rtac (beta_cfun RS ssubst) 1),
   5.370 +	(rtac contX_Istrictify2 1),
   5.371 +	(rtac Istrictify1 1)
   5.372 +	]);
   5.373 +
   5.374 +val strictify2 = prove_goalw Cfun3.thy [strictify_def]
   5.375 +	"~x=UU ==> strictify[f][x]=f[x]"
   5.376 + (fn prems =>
   5.377 +	[
   5.378 +	(rtac (beta_cfun RS ssubst) 1),
   5.379 +	(contX_tac 1),
   5.380 +	(rtac contX_Istrictify2 1),
   5.381 +	(rtac contX2contX_CF1L 1),
   5.382 +	(rtac contX_Istrictify1 1),
   5.383 +	(rtac (beta_cfun RS ssubst) 1),
   5.384 +	(rtac contX_Istrictify2 1),
   5.385 +	(rtac Istrictify2 1),
   5.386 +	(resolve_tac prems 1)
   5.387 +	]);
   5.388 +
   5.389 +
   5.390 +(* ------------------------------------------------------------------------ *)
   5.391 +(* Instantiate the simplifier                                               *)
   5.392 +(* ------------------------------------------------------------------------ *)
   5.393 +
   5.394 +val Cfun_rews  = [minimal,refl_less,beta_cfun,strict_fapp1,strictify1,
   5.395 +		strictify2];
   5.396 +
   5.397 +(* ------------------------------------------------------------------------ *)
   5.398 +(* use contX_tac as autotac.                                                *)
   5.399 +(* ------------------------------------------------------------------------ *)
   5.400 +
   5.401 +val Cfun_ss = HOL_ss 
   5.402 +	addsimps  Cfun_rews 
   5.403 +	setsolver 
   5.404 +	(fn thms => (resolve_tac (TrueI::refl::thms)) ORELSE' atac ORELSE'
   5.405 +		    (fn i => DEPTH_SOLVE_1 (contX_tac i))
   5.406 +	);
     6.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     6.2 +++ b/src/HOLCF/Cfun3.thy	Wed Jan 19 17:35:01 1994 +0100
     6.3 @@ -0,0 +1,31 @@
     6.4 +(*  Title: 	HOLCF/cfun3.thy
     6.5 +    ID:         $Id$
     6.6 +    Author: 	Franz Regensburger
     6.7 +    Copyright   1993 Technische Universitaet Muenchen
     6.8 +
     6.9 +Class instance of  -> for class pcpo
    6.10 +
    6.11 +*)
    6.12 +
    6.13 +Cfun3 = Cfun2 +
    6.14 +
    6.15 +arities "->"	:: (pcpo,pcpo)pcpo		(* Witness cfun2.ML *)
    6.16 +
    6.17 +consts  
    6.18 +	Istrictify   :: "('a->'b)=>'a=>'b"
    6.19 +	strictify    :: "('a->'b)->'a->'b"
    6.20 +
    6.21 +rules 
    6.22 +
    6.23 +inst_cfun_pcpo	"UU::'a->'b = UU_cfun"
    6.24 +
    6.25 +Istrictify_def	"Istrictify(f,x) == (@z.\
    6.26 +\			  ( x=UU --> z = UU)\
    6.27 +\			& (~x=UU --> z = f[x]))"	
    6.28 +
    6.29 +strictify_def	"strictify == (LAM f x.Istrictify(f,x))"
    6.30 +
    6.31 +end
    6.32 +
    6.33 +
    6.34 +
     7.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     7.2 +++ b/src/HOLCF/Cont.ML	Wed Jan 19 17:35:01 1994 +0100
     7.3 @@ -0,0 +1,670 @@
     7.4 +(*  Title: 	HOLCF/cont.ML
     7.5 +    ID:         $Id$
     7.6 +    Author: 	Franz Regensburger
     7.7 +    Copyright   1993 Technische Universitaet Muenchen
     7.8 +
     7.9 +Lemmas for cont.thy 
    7.10 +*)
    7.11 +
    7.12 +open Cont;
    7.13 +
    7.14 +(* ------------------------------------------------------------------------ *)
    7.15 +(* access to definition                                                     *)
    7.16 +(* ------------------------------------------------------------------------ *)
    7.17 +
    7.18 +val contlubI = prove_goalw Cont.thy [contlub]
    7.19 +	"! Y. is_chain(Y) --> f(lub(range(Y))) = lub(range(%i. f(Y(i))))==>\
    7.20 +\	 contlub(f)"
    7.21 +(fn prems =>
    7.22 +	[
    7.23 +	(cut_facts_tac prems 1),
    7.24 +	(atac 1)
    7.25 +	]);
    7.26 +
    7.27 +val contlubE = prove_goalw Cont.thy [contlub]
    7.28 +	" contlub(f)==>\
    7.29 +\         ! Y. is_chain(Y) --> f(lub(range(Y))) = lub(range(%i. f(Y(i))))"
    7.30 +(fn prems =>
    7.31 +	[
    7.32 +	(cut_facts_tac prems 1),
    7.33 +	(atac 1)
    7.34 +	]);
    7.35 +
    7.36 +
    7.37 +val contXI = prove_goalw Cont.thy [contX]
    7.38 + "! Y. is_chain(Y) --> range(% i.f(Y(i))) <<| f(lub(range(Y))) ==> contX(f)"
    7.39 +(fn prems =>
    7.40 +	[
    7.41 +	(cut_facts_tac prems 1),
    7.42 +	(atac 1)
    7.43 +	]);
    7.44 +
    7.45 +val contXE = prove_goalw Cont.thy [contX]
    7.46 + "contX(f) ==> ! Y. is_chain(Y) --> range(% i.f(Y(i))) <<| f(lub(range(Y)))"
    7.47 +(fn prems =>
    7.48 +	[
    7.49 +	(cut_facts_tac prems 1),
    7.50 +	(atac 1)
    7.51 +	]);
    7.52 +
    7.53 +
    7.54 +val monofunI = prove_goalw Cont.thy [monofun]
    7.55 +	"! x y. x << y --> f(x) << f(y) ==> monofun(f)"
    7.56 +(fn prems =>
    7.57 +	[
    7.58 +	(cut_facts_tac prems 1),
    7.59 +	(atac 1)
    7.60 +	]);
    7.61 +
    7.62 +val monofunE = prove_goalw Cont.thy [monofun]
    7.63 +	"monofun(f) ==> ! x y. x << y --> f(x) << f(y)"
    7.64 +(fn prems =>
    7.65 +	[
    7.66 +	(cut_facts_tac prems 1),
    7.67 +	(atac 1)
    7.68 +	]);
    7.69 +
    7.70 +(* ------------------------------------------------------------------------ *)
    7.71 +(* the main purpose of cont.thy is to show:                                 *)
    7.72 +(*              monofun(f) & contlub(f)  <==> contX(f)                      *)
    7.73 +(* ------------------------------------------------------------------------ *)
    7.74 +
    7.75 +(* ------------------------------------------------------------------------ *)
    7.76 +(* monotone functions map chains to chains                                  *)
    7.77 +(* ------------------------------------------------------------------------ *)
    7.78 +
    7.79 +val ch2ch_monofun= prove_goal Cont.thy 
    7.80 +	"[| monofun(f); is_chain(Y) |] ==> is_chain(%i. f(Y(i)))"
    7.81 +(fn prems =>
    7.82 +	[
    7.83 +	(cut_facts_tac prems 1),
    7.84 +	(rtac is_chainI 1),
    7.85 +	(rtac allI 1),
    7.86 +	(etac (monofunE RS spec RS spec RS mp) 1),
    7.87 +	(etac (is_chainE RS spec) 1)
    7.88 +	]);
    7.89 +
    7.90 +(* ------------------------------------------------------------------------ *)
    7.91 +(* monotone functions map upper bound to upper bounds                       *)
    7.92 +(* ------------------------------------------------------------------------ *)
    7.93 +
    7.94 +val ub2ub_monofun = prove_goal Cont.thy 
    7.95 + "[| monofun(f); range(Y) <| u|]  ==> range(%i.f(Y(i))) <| f(u)"
    7.96 +(fn prems =>
    7.97 +	[
    7.98 +	(cut_facts_tac prems 1),
    7.99 +	(rtac ub_rangeI 1),
   7.100 +	(rtac allI 1),
   7.101 +	(etac (monofunE RS spec RS spec RS mp) 1),
   7.102 +	(etac (ub_rangeE RS spec) 1)
   7.103 +	]);
   7.104 +
   7.105 +(* ------------------------------------------------------------------------ *)
   7.106 +(* left to right: monofun(f) & contlub(f)  ==> contX(f)                     *)
   7.107 +(* ------------------------------------------------------------------------ *)
   7.108 +
   7.109 +val monocontlub2contX = prove_goalw Cont.thy [contX]
   7.110 +	"[|monofun(f);contlub(f)|] ==> contX(f)"
   7.111 +(fn prems =>
   7.112 +	[
   7.113 +	(cut_facts_tac prems 1),
   7.114 +	(strip_tac 1),
   7.115 +	(rtac thelubE 1),
   7.116 +	(etac ch2ch_monofun 1),
   7.117 +	(atac 1),
   7.118 +	(etac (contlubE RS spec RS mp RS sym) 1),
   7.119 +	(atac 1)
   7.120 +	]);
   7.121 +
   7.122 +(* ------------------------------------------------------------------------ *)
   7.123 +(* first a lemma about binary chains                                        *)
   7.124 +(* ------------------------------------------------------------------------ *)
   7.125 +
   7.126 +val binchain_contX =  prove_goal Cont.thy
   7.127 +"[| contX(f); x << y |]  ==> range(%i. f(if(i = 0,x,y))) <<| f(y)"
   7.128 +(fn prems => 
   7.129 +	[
   7.130 +	(cut_facts_tac prems 1),
   7.131 +	(rtac subst 1), 
   7.132 +	(etac (contXE RS spec RS mp) 2),
   7.133 +	(etac bin_chain 2),
   7.134 +	(res_inst_tac [("y","y")] arg_cong 1),
   7.135 +	(etac (lub_bin_chain RS thelubI) 1)
   7.136 +	]);
   7.137 +
   7.138 +(* ------------------------------------------------------------------------ *)
   7.139 +(* right to left: contX(f) ==> monofun(f) & contlub(f)                      *)
   7.140 +(* part1:         contX(f) ==> monofun(f                                    *)
   7.141 +(* ------------------------------------------------------------------------ *)
   7.142 +
   7.143 +val contX2mono =  prove_goalw Cont.thy [monofun]
   7.144 +	"contX(f) ==> monofun(f)"
   7.145 +(fn prems =>
   7.146 +	[
   7.147 +	(cut_facts_tac prems 1),
   7.148 +	(strip_tac 1),
   7.149 +	(res_inst_tac [("s","if(0 = 0,x,y)")] subst 1),
   7.150 +	(rtac (binchain_contX RS is_ub_lub) 2),
   7.151 +	(atac 2),
   7.152 +	(atac 2),
   7.153 +	(simp_tac nat_ss 1)
   7.154 +	]);
   7.155 +
   7.156 +(* ------------------------------------------------------------------------ *)
   7.157 +(* right to left: contX(f) ==> monofun(f) & contlub(f)                      *)
   7.158 +(* part2:         contX(f) ==>              contlub(f)                      *)
   7.159 +(* ------------------------------------------------------------------------ *)
   7.160 +
   7.161 +val contX2contlub = prove_goalw Cont.thy [contlub]
   7.162 +	"contX(f) ==> contlub(f)"
   7.163 +(fn prems =>
   7.164 +	[
   7.165 +	(cut_facts_tac prems 1),
   7.166 +	(strip_tac 1),
   7.167 +	(rtac (thelubI RS sym) 1),
   7.168 +	(etac (contXE RS spec RS mp) 1),
   7.169 +	(atac 1)
   7.170 +	]);
   7.171 +
   7.172 +(* ------------------------------------------------------------------------ *)
   7.173 +(* The following results are about a curried function that is monotone      *)
   7.174 +(* in both arguments                                                        *)
   7.175 +(* ------------------------------------------------------------------------ *)
   7.176 +
   7.177 +val ch2ch_MF2L = prove_goal Cont.thy 
   7.178 +"[|monofun(MF2::('a::po=>'b::po=>'c::po));\
   7.179 +\	is_chain(F)|] ==> is_chain(%i. MF2(F(i),x))"
   7.180 +(fn prems =>
   7.181 +	[
   7.182 +	(cut_facts_tac prems 1),
   7.183 +	(etac (ch2ch_monofun RS ch2ch_fun) 1),
   7.184 +	(atac 1)
   7.185 +	]);
   7.186 +
   7.187 +
   7.188 +val ch2ch_MF2R = prove_goal Cont.thy "[|monofun(MF2(f)::('b::po=>'c::po));\
   7.189 +\	is_chain(Y)|] ==> is_chain(%i. MF2(f,Y(i)))"
   7.190 +(fn prems =>
   7.191 +	[
   7.192 +	(cut_facts_tac prems 1),
   7.193 +	(etac ch2ch_monofun 1),
   7.194 +	(atac 1)
   7.195 +	]);
   7.196 +
   7.197 +val ch2ch_MF2LR = prove_goal Cont.thy 
   7.198 +"[|monofun(MF2::('a::po=>'b::po=>'c::pcpo));\
   7.199 +\  !f.monofun(MF2(f)::('b::po=>'c::pcpo));\
   7.200 +\	is_chain(F); is_chain(Y)|] ==> \
   7.201 +\  is_chain(%i. MF2(F(i))(Y(i)))"
   7.202 +(fn prems =>
   7.203 +	[
   7.204 +	(cut_facts_tac prems 1),
   7.205 +	(rtac is_chainI 1),
   7.206 +	(strip_tac 1 ),
   7.207 +	(rtac trans_less 1),
   7.208 +	(etac (ch2ch_MF2L RS is_chainE RS spec) 1),
   7.209 +	(atac 1),
   7.210 +	((rtac (monofunE RS spec RS spec RS mp) 1) THEN (etac spec 1)),
   7.211 +	(etac (is_chainE RS spec) 1)
   7.212 +	]);
   7.213 +
   7.214 +val ch2ch_lubMF2R = prove_goal Cont.thy 
   7.215 +"[|monofun(MF2::('a::po=>'b::po=>'c::pcpo));\
   7.216 +\  !f.monofun(MF2(f)::('b::po=>'c::pcpo));\
   7.217 +\	is_chain(F);is_chain(Y)|] ==> \
   7.218 +\	is_chain(%j. lub(range(%i. MF2(F(j),Y(i)))))"
   7.219 +(fn prems =>
   7.220 +	[
   7.221 +	(cut_facts_tac prems 1),
   7.222 +	(rtac (lub_mono RS allI RS is_chainI) 1),
   7.223 +	((rtac ch2ch_MF2R 1) THEN (etac spec 1)),
   7.224 +	(atac 1),
   7.225 +	((rtac ch2ch_MF2R 1) THEN (etac spec 1)),
   7.226 +	(atac 1),
   7.227 +	(strip_tac 1),
   7.228 +	(rtac (is_chainE RS spec) 1),
   7.229 +	(etac ch2ch_MF2L 1),
   7.230 +	(atac 1)
   7.231 +	]);
   7.232 +
   7.233 +
   7.234 +val ch2ch_lubMF2L = prove_goal Cont.thy 
   7.235 +"[|monofun(MF2::('a::po=>'b::po=>'c::pcpo));\
   7.236 +\  !f.monofun(MF2(f)::('b::po=>'c::pcpo));\
   7.237 +\	is_chain(F);is_chain(Y)|] ==> \
   7.238 +\	is_chain(%i. lub(range(%j. MF2(F(j),Y(i)))))"
   7.239 +(fn prems =>
   7.240 +	[
   7.241 +	(cut_facts_tac prems 1),
   7.242 +	(rtac (lub_mono RS allI RS is_chainI) 1),
   7.243 +	(etac ch2ch_MF2L 1),
   7.244 +	(atac 1),
   7.245 +	(etac ch2ch_MF2L 1),
   7.246 +	(atac 1),
   7.247 +	(strip_tac 1),
   7.248 +	(rtac (is_chainE RS spec) 1),
   7.249 +	((rtac ch2ch_MF2R 1) THEN (etac spec 1)),
   7.250 +	(atac 1)
   7.251 +	]);
   7.252 +
   7.253 +
   7.254 +val lub_MF2_mono = prove_goal Cont.thy 
   7.255 +"[|monofun(MF2::('a::po=>'b::po=>'c::pcpo));\
   7.256 +\  !f.monofun(MF2(f)::('b::po=>'c::pcpo));\
   7.257 +\	is_chain(F)|] ==> \
   7.258 +\	monofun(% x.lub(range(% j.MF2(F(j),x))))"
   7.259 +(fn prems =>
   7.260 +	[
   7.261 +	(cut_facts_tac prems 1),
   7.262 +	(rtac monofunI 1),
   7.263 +	(strip_tac 1),
   7.264 +	(rtac lub_mono 1),
   7.265 +	(etac ch2ch_MF2L 1),
   7.266 +	(atac 1),
   7.267 +	(etac ch2ch_MF2L 1),
   7.268 +	(atac 1),
   7.269 +	(strip_tac 1),
   7.270 +	((rtac (monofunE RS spec RS spec RS mp) 1) THEN (etac spec 1)),
   7.271 +	(atac 1)
   7.272 +	]);
   7.273 +
   7.274 +
   7.275 +val ex_lubMF2 = prove_goal Cont.thy 
   7.276 +"[|monofun(MF2::('a::po=>'b::po=>'c::pcpo));\
   7.277 +\  !f.monofun(MF2(f)::('b::po=>'c::pcpo));\
   7.278 +\	is_chain(F); is_chain(Y)|] ==> \
   7.279 +\		lub(range(%j. lub(range(%i. MF2(F(j),Y(i)))))) =\
   7.280 +\		lub(range(%i. lub(range(%j. MF2(F(j),Y(i))))))"
   7.281 +(fn prems =>
   7.282 +	[
   7.283 +	(cut_facts_tac prems 1),
   7.284 +	(rtac antisym_less 1),
   7.285 +	(rtac is_lub_thelub 1),
   7.286 +	(etac ch2ch_lubMF2R 1),
   7.287 +	(atac 1),(atac 1),(atac 1),
   7.288 +	(rtac ub_rangeI 1),
   7.289 +	(strip_tac 1),
   7.290 +	(rtac lub_mono 1),
   7.291 +	((rtac ch2ch_MF2R 1) THEN (etac spec 1)),
   7.292 +	(atac 1),
   7.293 +	(etac ch2ch_lubMF2L 1),
   7.294 +	(atac 1),(atac 1),(atac 1),
   7.295 +	(strip_tac 1),
   7.296 +	(rtac is_ub_thelub 1),
   7.297 +	(etac ch2ch_MF2L 1),(atac 1),
   7.298 +	(rtac is_lub_thelub 1),
   7.299 +	(etac ch2ch_lubMF2L 1),
   7.300 +	(atac 1),(atac 1),(atac 1),
   7.301 +	(rtac ub_rangeI 1),
   7.302 +	(strip_tac 1),
   7.303 +	(rtac lub_mono 1),
   7.304 +	(etac ch2ch_MF2L 1),(atac 1),
   7.305 +	(etac ch2ch_lubMF2R 1),
   7.306 +	(atac 1),(atac 1),(atac 1),
   7.307 +	(strip_tac 1),
   7.308 +	(rtac is_ub_thelub 1),
   7.309 +	((rtac ch2ch_MF2R 1) THEN (etac spec 1)),
   7.310 +	(atac 1)
   7.311 +	]);
   7.312 +
   7.313 +(* ------------------------------------------------------------------------ *)
   7.314 +(* The following results are about a curried function that is continuous    *)
   7.315 +(* in both arguments                                                        *)
   7.316 +(* ------------------------------------------------------------------------ *)
   7.317 +
   7.318 +val diag_lubCF2_1 = prove_goal Cont.thy 
   7.319 +"[|contX(CF2);!f.contX(CF2(f));is_chain(FY);is_chain(TY)|] ==>\
   7.320 +\ lub(range(%i. lub(range(%j. CF2(FY(j))(TY(i)))))) =\
   7.321 +\ lub(range(%i. CF2(FY(i))(TY(i))))"
   7.322 +(fn prems =>
   7.323 +	[
   7.324 +	(cut_facts_tac prems 1),
   7.325 +	(rtac antisym_less 1),
   7.326 +	(rtac is_lub_thelub 1),
   7.327 +	(rtac ch2ch_lubMF2L 1),
   7.328 +	(rtac contX2mono 1),
   7.329 +	(atac 1),
   7.330 +	(rtac allI 1),
   7.331 +	(rtac contX2mono 1),
   7.332 +	(etac spec 1),
   7.333 +	(atac 1),
   7.334 +	(atac 1),
   7.335 +	(rtac ub_rangeI 1),
   7.336 +	(strip_tac 1 ),
   7.337 +	(rtac is_lub_thelub 1),
   7.338 +	((rtac ch2ch_MF2L 1) THEN (rtac contX2mono 1) THEN (atac 1)),
   7.339 +	(atac 1),
   7.340 +	(rtac ub_rangeI 1),
   7.341 +	(strip_tac 1 ),
   7.342 +	(res_inst_tac [("m","i"),("n","ia")] nat_less_cases 1),
   7.343 +	(rtac trans_less 1),
   7.344 +	(rtac is_ub_thelub 2),
   7.345 +	(rtac (chain_mono RS mp) 1),
   7.346 +	((rtac ch2ch_MF2R 1) THEN (rtac contX2mono 1) THEN (etac spec 1)),
   7.347 +	(atac 1),
   7.348 +	(atac 1),
   7.349 +	((rtac ch2ch_MF2LR 1) THEN (etac contX2mono 1)),
   7.350 +	(rtac allI 1),
   7.351 +	((rtac contX2mono 1) THEN (etac spec 1)),
   7.352 +	(atac 1),
   7.353 +	(atac 1),
   7.354 +	(hyp_subst_tac 1),
   7.355 +	(rtac is_ub_thelub 1),
   7.356 +	((rtac ch2ch_MF2LR 1) THEN (etac contX2mono 1)),
   7.357 +	(rtac allI 1),
   7.358 +	((rtac contX2mono 1) THEN (etac spec 1)),
   7.359 +	(atac 1),
   7.360 +	(atac 1),
   7.361 +	(rtac trans_less 1),
   7.362 +	(rtac is_ub_thelub 2),
   7.363 +	(res_inst_tac [("x1","ia")] (chain_mono RS mp) 1),
   7.364 +	((rtac ch2ch_MF2L 1) THEN (etac contX2mono 1)),
   7.365 +	(atac 1),
   7.366 +	(atac 1),
   7.367 +	((rtac ch2ch_MF2LR 1) THEN (etac contX2mono 1)),
   7.368 +	(rtac allI 1),
   7.369 +	((rtac contX2mono 1) THEN (etac spec 1)),
   7.370 +	(atac 1),
   7.371 +	(atac 1),
   7.372 +	(rtac lub_mono 1),
   7.373 +	((rtac ch2ch_MF2LR 1) THEN (etac contX2mono 1)),
   7.374 +	(rtac allI 1),
   7.375 +	((rtac contX2mono 1) THEN (etac spec 1)),
   7.376 +	(atac 1),
   7.377 +	(atac 1),
   7.378 +	(rtac ch2ch_lubMF2L 1),
   7.379 +	(rtac contX2mono 1),
   7.380 +	(atac 1),
   7.381 +	(rtac allI 1),
   7.382 +	((rtac contX2mono 1) THEN (etac spec 1)),
   7.383 +	(atac 1),
   7.384 +	(atac 1),
   7.385 +	(strip_tac 1 ),
   7.386 +	(rtac is_ub_thelub 1),
   7.387 +	((rtac ch2ch_MF2L 1) THEN (etac contX2mono 1)),
   7.388 +	(atac 1)
   7.389 +	]);
   7.390 +
   7.391 +
   7.392 +val diag_lubCF2_2 = prove_goal Cont.thy 
   7.393 +"[|contX(CF2);!f.contX(CF2(f));is_chain(FY);is_chain(TY)|] ==>\
   7.394 +\ lub(range(%j. lub(range(%i. CF2(FY(j))(TY(i)))))) =\
   7.395 +\ lub(range(%i. CF2(FY(i))(TY(i))))"
   7.396 +(fn prems =>
   7.397 +	[
   7.398 +	(cut_facts_tac prems 1),
   7.399 +	(rtac trans 1),
   7.400 +	(rtac ex_lubMF2 1),
   7.401 +	(rtac ((hd prems) RS contX2mono) 1), 
   7.402 +	(rtac allI 1),
   7.403 +	(rtac (((hd (tl prems)) RS spec RS contX2mono)) 1),
   7.404 +	(atac 1),
   7.405 +	(atac 1),
   7.406 +	(rtac diag_lubCF2_1 1),
   7.407 +	(atac 1),
   7.408 +	(atac 1),
   7.409 +	(atac 1),
   7.410 +	(atac 1)
   7.411 +	]);
   7.412 +
   7.413 +
   7.414 +val contlub_CF2 = prove_goal Cont.thy 
   7.415 +"[|contX(CF2);!f.contX(CF2(f));is_chain(FY);is_chain(TY)|] ==>\
   7.416 +\ CF2(lub(range(FY)))(lub(range(TY))) = lub(range(%i.CF2(FY(i))(TY(i))))"
   7.417 +(fn prems =>
   7.418 +	[
   7.419 +	(cut_facts_tac prems 1),
   7.420 +	(rtac ((hd prems) RS contX2contlub RS contlubE RS 
   7.421 +		spec RS mp RS ssubst) 1),
   7.422 +	(atac 1),
   7.423 +	(rtac (thelub_fun RS ssubst) 1),
   7.424 +	(rtac ((hd prems) RS contX2mono RS ch2ch_monofun) 1), 
   7.425 +	(atac 1),
   7.426 +	(rtac trans 1),
   7.427 +	(rtac (((hd (tl prems)) RS spec RS contX2contlub) RS 
   7.428 +	contlubE RS spec RS mp RS ext RS arg_cong RS arg_cong) 1),
   7.429 +	(atac 1),
   7.430 +	(rtac diag_lubCF2_2 1),
   7.431 +	(atac 1),
   7.432 +	(atac 1),
   7.433 +	(atac 1),
   7.434 +	(atac 1)
   7.435 +	]);
   7.436 +
   7.437 +(* ------------------------------------------------------------------------ *)
   7.438 +(* The following results are about application for functions in 'a=>'b      *)
   7.439 +(* ------------------------------------------------------------------------ *)
   7.440 +
   7.441 +val monofun_fun_fun = prove_goal Cont.thy 
   7.442 +	"f1 << f2 ==> f1(x) << f2(x)"
   7.443 +(fn prems =>
   7.444 +	[
   7.445 +	(cut_facts_tac prems 1),
   7.446 +	(etac (less_fun RS iffD1 RS spec) 1)
   7.447 +	]);
   7.448 +
   7.449 +val monofun_fun_arg = prove_goal Cont.thy 
   7.450 +	"[|monofun(f); x1 << x2|] ==> f(x1) << f(x2)"
   7.451 +(fn prems =>
   7.452 +	[
   7.453 +	(cut_facts_tac prems 1),
   7.454 +	(etac (monofunE RS spec RS spec RS mp) 1),
   7.455 +	(atac 1)
   7.456 +	]);
   7.457 +
   7.458 +val monofun_fun = prove_goal Cont.thy 
   7.459 +"[|monofun(f1); monofun(f2); f1 << f2; x1 << x2|] ==> f1(x1) << f2(x2)"
   7.460 +(fn prems =>
   7.461 +	[
   7.462 +	(cut_facts_tac prems 1),
   7.463 +	(rtac trans_less 1),
   7.464 +	(etac monofun_fun_arg 1),
   7.465 +	(atac 1),
   7.466 +	(etac monofun_fun_fun 1)
   7.467 +	]);
   7.468 +
   7.469 +
   7.470 +(* ------------------------------------------------------------------------ *)
   7.471 +(* The following results are about the propagation of monotonicity and      *)
   7.472 +(* continuity                                                               *)
   7.473 +(* ------------------------------------------------------------------------ *)
   7.474 +
   7.475 +val mono2mono_MF1L = prove_goal Cont.thy 
   7.476 +	"[|monofun(c1)|] ==> monofun(%x. c1(x,y))"
   7.477 +(fn prems =>
   7.478 +	[
   7.479 +	(cut_facts_tac prems 1),
   7.480 +	(rtac monofunI 1),
   7.481 +	(strip_tac 1),
   7.482 +	(etac (monofun_fun_arg RS monofun_fun_fun) 1),
   7.483 +	(atac 1)
   7.484 +	]);
   7.485 +
   7.486 +val contX2contX_CF1L = prove_goal Cont.thy 
   7.487 +	"[|contX(c1)|] ==> contX(%x. c1(x,y))"
   7.488 +(fn prems =>
   7.489 +	[
   7.490 +	(cut_facts_tac prems 1),
   7.491 +	(rtac monocontlub2contX 1),
   7.492 +	(etac (contX2mono RS mono2mono_MF1L) 1),
   7.493 +	(rtac contlubI 1),
   7.494 +	(strip_tac 1),
   7.495 +	(rtac ((hd prems) RS contX2contlub RS 
   7.496 +		contlubE RS spec RS mp RS ssubst) 1),
   7.497 +	(atac 1),
   7.498 +	(rtac (thelub_fun RS ssubst) 1),
   7.499 +	(rtac ch2ch_monofun 1),
   7.500 +	(etac contX2mono 1),
   7.501 +	(atac 1),
   7.502 +	(rtac refl 1)
   7.503 +	]);
   7.504 +
   7.505 +(*********  Note "(%x.%y.c1(x,y)) = c1" ***********)
   7.506 +
   7.507 +val mono2mono_MF1L_rev = prove_goal Cont.thy
   7.508 +	"!y.monofun(%x.c1(x,y)) ==> monofun(c1)"
   7.509 +(fn prems =>
   7.510 +	[
   7.511 +	(cut_facts_tac prems 1),
   7.512 +	(rtac monofunI 1),
   7.513 +	(strip_tac 1),
   7.514 +	(rtac (less_fun RS iffD2) 1),
   7.515 +	(strip_tac 1),
   7.516 +	(rtac ((hd prems) RS spec RS monofunE RS spec RS spec RS mp) 1),
   7.517 +	(atac 1)
   7.518 +	]);
   7.519 +
   7.520 +val contX2contX_CF1L_rev = prove_goal Cont.thy
   7.521 +	"!y.contX(%x.c1(x,y)) ==> contX(c1)"
   7.522 +(fn prems =>
   7.523 +	[
   7.524 +	(cut_facts_tac prems 1),
   7.525 +	(rtac monocontlub2contX 1),
   7.526 +	(rtac (contX2mono RS allI RS mono2mono_MF1L_rev ) 1),
   7.527 +	(etac spec 1),
   7.528 +	(rtac contlubI 1),
   7.529 +	(strip_tac 1),
   7.530 +	(rtac ext 1),
   7.531 +	(rtac (thelub_fun RS ssubst) 1),
   7.532 +	(rtac (contX2mono RS allI RS mono2mono_MF1L_rev RS ch2ch_monofun) 1),
   7.533 +	(etac spec 1),
   7.534 +	(atac 1),
   7.535 +	(rtac 
   7.536 +	((hd prems) RS spec RS contX2contlub RS contlubE RS spec RS mp) 1),
   7.537 +	(atac 1)
   7.538 +	]);
   7.539 +
   7.540 +
   7.541 +(* ------------------------------------------------------------------------ *)
   7.542 +(* What D.A.Schmidt calls continuity of abstraction                         *)
   7.543 +(* never used here                                                          *)
   7.544 +(* ------------------------------------------------------------------------ *)
   7.545 +
   7.546 +val contlub_abstraction = prove_goal Cont.thy
   7.547 +"[|is_chain(Y::nat=>'a);!y.contX(%x.(c::'a=>'b=>'c)(x,y))|] ==>\
   7.548 +\ (%y.lub(range(%i.c(Y(i),y)))) = (lub(range(%i.%y.c(Y(i),y))))"
   7.549 + (fn prems =>
   7.550 +	[
   7.551 +	(cut_facts_tac prems 1),
   7.552 +	(rtac trans 1),
   7.553 +	(rtac (contX2contlub RS contlubE RS spec RS mp) 2),
   7.554 +	(atac 3),
   7.555 +	(etac contX2contX_CF1L_rev 2),
   7.556 +	(rtac ext 1), 
   7.557 +	(rtac (contX2contlub RS contlubE RS spec RS mp RS sym) 1),
   7.558 +	(etac spec 1),
   7.559 +	(atac 1)
   7.560 +	]);
   7.561 +
   7.562 +
   7.563 +val mono2mono_app = prove_goal Cont.thy 
   7.564 +"[|monofun(ft);!x.monofun(ft(x));monofun(tt)|] ==>\
   7.565 +\	 monofun(%x.(ft(x))(tt(x)))"
   7.566 + (fn prems =>
   7.567 +	[
   7.568 +	(cut_facts_tac prems 1),
   7.569 +	(rtac monofunI 1),
   7.570 +	(strip_tac 1),
   7.571 +	(res_inst_tac [("f1.0","ft(x)"),("f2.0","ft(y)")] monofun_fun 1),
   7.572 +	(etac spec 1),
   7.573 +	(etac spec 1),
   7.574 +	(etac (monofunE RS spec RS spec RS mp) 1),
   7.575 +	(atac 1),
   7.576 +	(etac (monofunE RS spec RS spec RS mp) 1),
   7.577 +	(atac 1)
   7.578 +	]);
   7.579 +
   7.580 +val contX2contlub_app = prove_goal Cont.thy 
   7.581 +"[|contX(ft);!x.contX(ft(x));contX(tt)|] ==>\
   7.582 +\	 contlub(%x.(ft(x))(tt(x)))"
   7.583 + (fn prems =>
   7.584 +	[
   7.585 +	(cut_facts_tac prems 1),
   7.586 +	(rtac contlubI 1),
   7.587 +	(strip_tac 1),
   7.588 +	(res_inst_tac [("f3","tt")] (contlubE RS spec RS mp RS ssubst) 1),
   7.589 +	(rtac contX2contlub 1),
   7.590 +	(resolve_tac prems 1),
   7.591 +	(atac 1),
   7.592 +	(rtac contlub_CF2 1),
   7.593 +	(resolve_tac prems 1),
   7.594 +	(resolve_tac prems 1),
   7.595 +	(atac 1),
   7.596 +	(rtac (contX2mono RS ch2ch_monofun) 1),
   7.597 +	(resolve_tac prems 1),
   7.598 +	(atac 1)
   7.599 +	]);
   7.600 +
   7.601 +
   7.602 +val contX2contX_app = prove_goal Cont.thy 
   7.603 +"[|contX(ft);!x.contX(ft(x));contX(tt)|] ==>\
   7.604 +\	 contX(%x.(ft(x))(tt(x)))"
   7.605 + (fn prems =>
   7.606 +	[
   7.607 +	(rtac monocontlub2contX 1),
   7.608 +	(rtac mono2mono_app 1),
   7.609 +	(rtac contX2mono 1),
   7.610 +	(resolve_tac prems 1),
   7.611 +	(strip_tac 1),
   7.612 +	(rtac contX2mono 1),
   7.613 +	(cut_facts_tac prems 1),
   7.614 +	(etac spec 1),
   7.615 +	(rtac contX2mono 1),
   7.616 +	(resolve_tac prems 1),
   7.617 +	(rtac contX2contlub_app 1),
   7.618 +	(resolve_tac prems 1),
   7.619 +	(resolve_tac prems 1),
   7.620 +	(resolve_tac prems 1)
   7.621 +	]);
   7.622 +
   7.623 +
   7.624 +val contX2contX_app2 = (allI RSN (2,contX2contX_app));
   7.625 +(*  [| contX(?ft); !!x. contX(?ft(x)); contX(?tt) |] ==>                 *)
   7.626 +(*                                      contX(%x. ?ft(x,?tt(x)))         *)
   7.627 +
   7.628 +
   7.629 +(* ------------------------------------------------------------------------ *)
   7.630 +(* The identity function is continuous                                      *)
   7.631 +(* ------------------------------------------------------------------------ *)
   7.632 +
   7.633 +val contX_id = prove_goal Cont.thy "contX(% x.x)"
   7.634 + (fn prems =>
   7.635 +	[
   7.636 +	(rtac contXI 1),
   7.637 +	(strip_tac 1),
   7.638 +	(etac thelubE 1),
   7.639 +	(rtac refl 1)
   7.640 +	]);
   7.641 +
   7.642 +
   7.643 +
   7.644 +(* ------------------------------------------------------------------------ *)
   7.645 +(* constant functions are continuous                                        *)
   7.646 +(* ------------------------------------------------------------------------ *)
   7.647 +
   7.648 +val contX_const = prove_goalw Cont.thy [contX] "contX(%x.c)"
   7.649 + (fn prems =>
   7.650 +	[
   7.651 +	(strip_tac 1),
   7.652 +	(rtac is_lubI 1),
   7.653 +	(rtac conjI 1),
   7.654 +	(rtac ub_rangeI 1),
   7.655 +	(strip_tac 1),
   7.656 +	(rtac refl_less 1),
   7.657 +	(strip_tac 1),
   7.658 +	(dtac ub_rangeE 1),
   7.659 +	(etac spec 1)
   7.660 +	]);
   7.661 +
   7.662 +
   7.663 +val contX2contX_app3 = prove_goal Cont.thy 
   7.664 + "[|contX(f);contX(t) |] ==> contX(%x. f(t(x)))"
   7.665 + (fn prems =>
   7.666 +	[
   7.667 +	(cut_facts_tac prems 1),
   7.668 +	(rtac contX2contX_app2 1),
   7.669 +	(rtac contX_const 1),
   7.670 +	(atac 1),
   7.671 +	(atac 1)
   7.672 +	]);
   7.673 +
     8.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     8.2 +++ b/src/HOLCF/Cont.thy	Wed Jan 19 17:35:01 1994 +0100
     8.3 @@ -0,0 +1,41 @@
     8.4 +(*  Title: 	HOLCF/cont.thy
     8.5 +    ID:         $Id$
     8.6 +    Author: 	Franz Regensburger
     8.7 +    Copyright   1993 Technische Universitaet Muenchen
     8.8 +
     8.9 +    Results about continuity and monotonicity
    8.10 +*)
    8.11 +
    8.12 +Cont = Fun3 +
    8.13 +
    8.14 +(* 
    8.15 +
    8.16 +   Now we change the default class! Form now on all untyped typevariables are
    8.17 +   of default class pcpo
    8.18 +
    8.19 +*)
    8.20 +
    8.21 +
    8.22 +default pcpo
    8.23 +
    8.24 +consts  
    8.25 +	monofun :: "('a::po => 'b::po) => bool"	(* monotonicity    *)
    8.26 +	contlub	:: "('a => 'b) => bool"		(* first cont. def *)
    8.27 +	contX	:: "('a => 'b) => bool"		(* secnd cont. def *)
    8.28 +
    8.29 +rules 
    8.30 +
    8.31 +monofun		"monofun(f) == ! x y. x << y --> f(x) << f(y)"
    8.32 +
    8.33 +contlub		"contlub(f) == ! Y. is_chain(Y) --> \
    8.34 +\				f(lub(range(Y))) = lub(range(% i.f(Y(i))))"
    8.35 +
    8.36 +contX		"contX(f)   == ! Y. is_chain(Y) --> \
    8.37 +\				range(% i.f(Y(i))) <<| f(lub(range(Y)))"
    8.38 +
    8.39 +(* ------------------------------------------------------------------------ *)
    8.40 +(* the main purpose of cont.thy is to show:                                 *)
    8.41 +(*              monofun(f) & contlub(f)  <==> contX(f)                      *)
    8.42 +(* ------------------------------------------------------------------------ *)
    8.43 +
    8.44 +end
     9.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     9.2 +++ b/src/HOLCF/Cprod1.ML	Wed Jan 19 17:35:01 1994 +0100
     9.3 @@ -0,0 +1,117 @@
     9.4 +(*  Title: 	HOLCF/cprod1.ML
     9.5 +    ID:         $Id$
     9.6 +    Author: 	Franz Regensburger
     9.7 +    Copyright   1993  Technische Universitaet Muenchen
     9.8 +
     9.9 +Lemmas for theory cprod1.thy 
    9.10 +*)
    9.11 +
    9.12 +open Cprod1;
    9.13 +
    9.14 +val less_cprod1b = prove_goalw Cprod1.thy [less_cprod_def]
    9.15 + "less_cprod(p1,p2) = ( fst(p1) << fst(p2) & snd(p1) << snd(p2))"
    9.16 + (fn prems =>
    9.17 +	[
    9.18 +	(rtac refl 1)
    9.19 +	]);
    9.20 +
    9.21 +val less_cprod2a = prove_goalw Cprod1.thy [less_cprod_def]
    9.22 + "less_cprod(<x,y>,<UU,UU>) ==> x = UU & y = UU"
    9.23 + (fn prems =>
    9.24 +	[
    9.25 +	(cut_facts_tac prems 1),
    9.26 +	(etac conjE 1),
    9.27 +	(dtac (fst_conv RS subst) 1),
    9.28 +	(dtac (fst_conv RS subst) 1),
    9.29 +	(dtac (fst_conv RS subst) 1),
    9.30 +	(dtac (snd_conv RS subst) 1),
    9.31 +	(dtac (snd_conv RS subst) 1),
    9.32 +	(dtac (snd_conv RS subst) 1),
    9.33 +	(rtac conjI 1),
    9.34 +	(etac UU_I 1),
    9.35 +	(etac UU_I 1)
    9.36 +	]);
    9.37 +
    9.38 +val less_cprod2b = prove_goal Cprod1.thy 
    9.39 + "less_cprod(p,<UU,UU>) ==> p=<UU,UU>"
    9.40 + (fn prems =>
    9.41 +	[
    9.42 +	(cut_facts_tac prems 1),
    9.43 +	(res_inst_tac [("p","p")] PairE 1),
    9.44 +	(hyp_subst_tac 1),
    9.45 +	(dtac less_cprod2a 1),
    9.46 +	(asm_simp_tac HOL_ss 1)
    9.47 +	]);
    9.48 +
    9.49 +val less_cprod2c = prove_goalw Cprod1.thy [less_cprod_def]
    9.50 + "less_cprod(<x1,y1>,<x2,y2>) ==> x1 << x2 & y1 << y2"
    9.51 + (fn prems =>
    9.52 +	[
    9.53 +	(cut_facts_tac prems 1),
    9.54 +	(etac conjE 1),
    9.55 +	(dtac (fst_conv RS subst) 1),
    9.56 +	(dtac (fst_conv RS subst) 1),
    9.57 +	(dtac (fst_conv RS subst) 1),
    9.58 +	(dtac (snd_conv RS subst) 1),
    9.59 +	(dtac (snd_conv RS subst) 1),
    9.60 +	(dtac (snd_conv RS subst) 1),
    9.61 +	(rtac conjI 1),
    9.62 +	(atac 1),
    9.63 +	(atac 1)
    9.64 +	]);
    9.65 +
    9.66 +(* ------------------------------------------------------------------------ *)
    9.67 +(* less_cprod is a partial order on 'a * 'b                                 *)
    9.68 +(* ------------------------------------------------------------------------ *)
    9.69 +
    9.70 +val refl_less_cprod = prove_goalw Cprod1.thy [less_cprod_def] "less_cprod(p,p)"
    9.71 + (fn prems =>
    9.72 +	[
    9.73 +	(res_inst_tac [("p","p")] PairE 1),
    9.74 +	(hyp_subst_tac 1),
    9.75 +	(simp_tac pair_ss 1),
    9.76 +	(simp_tac Cfun_ss 1)
    9.77 +	]);
    9.78 +
    9.79 +val antisym_less_cprod = prove_goal Cprod1.thy 
    9.80 + "[|less_cprod(p1,p2);less_cprod(p2,p1)|] ==> p1=p2"
    9.81 + (fn prems =>
    9.82 +	[
    9.83 +	(cut_facts_tac prems 1),
    9.84 +	(res_inst_tac [("p","p1")] PairE 1),
    9.85 +	(hyp_subst_tac 1),
    9.86 +	(res_inst_tac [("p","p2")] PairE 1),
    9.87 +	(hyp_subst_tac 1),
    9.88 +	(dtac less_cprod2c 1),
    9.89 +	(dtac less_cprod2c 1),
    9.90 +	(etac conjE 1),
    9.91 +	(etac conjE 1),
    9.92 +	(rtac (Pair_eq RS ssubst) 1),
    9.93 +	(fast_tac (HOL_cs addSIs [antisym_less]) 1)
    9.94 +	]);
    9.95 +
    9.96 +
    9.97 +val trans_less_cprod = prove_goal Cprod1.thy 
    9.98 + "[|less_cprod(p1,p2);less_cprod(p2,p3)|] ==> less_cprod(p1,p3)"
    9.99 + (fn prems =>
   9.100 +	[
   9.101 +	(cut_facts_tac prems 1),
   9.102 +	(res_inst_tac [("p","p1")] PairE 1),
   9.103 +	(hyp_subst_tac 1),
   9.104 +	(res_inst_tac [("p","p3")] PairE 1),
   9.105 +	(hyp_subst_tac 1),
   9.106 +	(res_inst_tac [("p","p2")] PairE 1),
   9.107 +	(hyp_subst_tac 1),
   9.108 +	(dtac less_cprod2c 1),
   9.109 +	(dtac less_cprod2c 1),
   9.110 +	(rtac (less_cprod1b RS ssubst) 1),
   9.111 +	(simp_tac pair_ss 1),
   9.112 +	(etac conjE 1),
   9.113 +	(etac conjE 1),
   9.114 +	(rtac conjI 1),
   9.115 +	(etac trans_less 1),
   9.116 +	(atac 1),
   9.117 +	(etac trans_less 1),
   9.118 +	(atac 1)
   9.119 +	]);
   9.120 +
    10.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    10.2 +++ b/src/HOLCF/Cprod1.thy	Wed Jan 19 17:35:01 1994 +0100
    10.3 @@ -0,0 +1,23 @@
    10.4 +(*  Title: 	HOLCF/cprod1.thy
    10.5 +    ID:         $Id$
    10.6 +    Author: 	Franz Regensburger
    10.7 +    Copyright   1993  Technische Universitaet Muenchen
    10.8 +
    10.9 +
   10.10 +Partial ordering for cartesian product of HOL theory prod.thy
   10.11 +
   10.12 +*)
   10.13 +
   10.14 +Cprod1 = Cfun3 +
   10.15 +
   10.16 +
   10.17 +consts
   10.18 +  less_cprod	:: "[('a::pcpo * 'b::pcpo),('a * 'b)] => bool"	
   10.19 +
   10.20 +rules
   10.21 +
   10.22 +  less_cprod_def "less_cprod(p1,p2) == ( fst(p1) << fst(p2) &\
   10.23 +\					snd(p1) << snd(p2))"
   10.24 +
   10.25 +end
   10.26 +
    11.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    11.2 +++ b/src/HOLCF/Cprod2.ML	Wed Jan 19 17:35:01 1994 +0100
    11.3 @@ -0,0 +1,181 @@
    11.4 +(*  Title: 	HOLCF/cprod2.ML
    11.5 +    ID:         $Id$
    11.6 +    Author: 	Franz Regensburger
    11.7 +    Copyright   1993 Technische Universitaet Muenchen
    11.8 +
    11.9 +Lemmas for cprod2.thy 
   11.10 +*)
   11.11 +
   11.12 +open Cprod2;
   11.13 +
   11.14 +val less_cprod3a = prove_goal Cprod2.thy 
   11.15 +	"p1=<UU,UU> ==> p1 << p2"
   11.16 + (fn prems =>
   11.17 +	[
   11.18 +	(cut_facts_tac prems 1),
   11.19 +	(rtac (inst_cprod_po RS ssubst) 1),
   11.20 +	(rtac (less_cprod1b RS ssubst) 1),
   11.21 +	(hyp_subst_tac 1),
   11.22 +	(asm_simp_tac pair_ss  1),
   11.23 +	(rtac conjI 1),
   11.24 +	(rtac minimal 1),
   11.25 +	(rtac minimal 1)
   11.26 +	]);
   11.27 +
   11.28 +val less_cprod3b = prove_goal Cprod2.thy
   11.29 + "(p1 << p2) = (fst(p1)<<fst(p2) & snd(p1)<<snd(p2))"
   11.30 + (fn prems =>
   11.31 +	[
   11.32 +	(rtac (inst_cprod_po RS ssubst) 1),
   11.33 +	(rtac less_cprod1b 1)
   11.34 +	]);
   11.35 +
   11.36 +val less_cprod4a = prove_goal Cprod2.thy 
   11.37 +	"<x1,x2> << <UU,UU> ==> x1=UU & x2=UU"
   11.38 + (fn prems =>
   11.39 +	[
   11.40 +	(cut_facts_tac prems 1),
   11.41 +	(rtac less_cprod2a 1),
   11.42 +	(etac (inst_cprod_po RS subst) 1)
   11.43 +	]);
   11.44 +
   11.45 +val less_cprod4b = prove_goal Cprod2.thy 
   11.46 +	"p << <UU,UU> ==> p = <UU,UU>"
   11.47 +(fn prems =>
   11.48 +	[
   11.49 +	(cut_facts_tac prems 1),
   11.50 +	(rtac less_cprod2b 1),
   11.51 +	(etac (inst_cprod_po RS subst) 1)
   11.52 +	]);
   11.53 +
   11.54 +val less_cprod4c = prove_goal Cprod2.thy
   11.55 + " <xa,ya> << <x,y> ==> xa<<x & ya << y"
   11.56 +(fn prems =>
   11.57 +	[
   11.58 +	(cut_facts_tac prems 1),
   11.59 +	(rtac less_cprod2c 1),
   11.60 +	(etac (inst_cprod_po RS subst) 1),
   11.61 +	(REPEAT (atac 1))
   11.62 +	]);
   11.63 +
   11.64 +(* ------------------------------------------------------------------------ *)
   11.65 +(* type cprod is pointed                                                    *)
   11.66 +(* ------------------------------------------------------------------------ *)
   11.67 +
   11.68 +val minimal_cprod = prove_goal Cprod2.thy  "<UU,UU><<p"
   11.69 +(fn prems =>
   11.70 +	[
   11.71 +	(rtac less_cprod3a 1),
   11.72 +	(rtac refl 1)
   11.73 +	]);
   11.74 +
   11.75 +(* ------------------------------------------------------------------------ *)
   11.76 +(* Pair <_,_>  is monotone in both arguments                                *)
   11.77 +(* ------------------------------------------------------------------------ *)
   11.78 +
   11.79 +val monofun_pair1 = prove_goalw Cprod2.thy [monofun] "monofun(Pair)"
   11.80 + (fn prems =>
   11.81 +	[
   11.82 +	(strip_tac 1),
   11.83 +	(rtac (less_fun RS iffD2) 1),
   11.84 +	(strip_tac 1),
   11.85 +	(rtac (less_cprod3b RS iffD2) 1),
   11.86 +	(simp_tac pair_ss 1),
   11.87 +	(asm_simp_tac Cfun_ss 1)
   11.88 +	]);
   11.89 +
   11.90 +val monofun_pair2 = prove_goalw Cprod2.thy [monofun] "monofun(Pair(x))"
   11.91 + (fn prems =>
   11.92 +	[
   11.93 +	(strip_tac 1),
   11.94 +	(rtac (less_cprod3b RS iffD2) 1),
   11.95 +	(simp_tac pair_ss 1),
   11.96 +	(asm_simp_tac Cfun_ss 1)
   11.97 +	]);
   11.98 +
   11.99 +val monofun_pair = prove_goal Cprod2.thy 
  11.100 + "[|x1<<x2; y1<<y2|] ==> <x1,y1> << <x2,y2>"
  11.101 + (fn prems =>
  11.102 +	[
  11.103 +	(cut_facts_tac prems 1),
  11.104 +	(rtac trans_less 1),
  11.105 +	(rtac (monofun_pair1 RS monofunE RS spec RS spec RS mp RS 
  11.106 +	(less_fun RS iffD1 RS spec)) 1),
  11.107 +	(rtac (monofun_pair2 RS monofunE RS spec RS spec RS mp) 2),
  11.108 +	(atac 1),
  11.109 +	(atac 1)
  11.110 +	]);
  11.111 +
  11.112 +(* ------------------------------------------------------------------------ *)
  11.113 +(* fst and snd are monotone                                                 *)
  11.114 +(* ------------------------------------------------------------------------ *)
  11.115 +
  11.116 +val monofun_fst = prove_goalw Cprod2.thy [monofun] "monofun(fst)"
  11.117 + (fn prems =>
  11.118 +	[
  11.119 +	(strip_tac 1),
  11.120 +	(res_inst_tac [("p","x")] PairE 1),
  11.121 +	(hyp_subst_tac 1),
  11.122 +	(res_inst_tac [("p","y")] PairE 1),
  11.123 +	(hyp_subst_tac 1),
  11.124 +	(asm_simp_tac pair_ss  1),
  11.125 +	(etac (less_cprod4c RS conjunct1) 1)
  11.126 +	]);
  11.127 +
  11.128 +val monofun_snd = prove_goalw Cprod2.thy [monofun] "monofun(snd)"
  11.129 + (fn prems =>
  11.130 +	[
  11.131 +	(strip_tac 1),
  11.132 +	(res_inst_tac [("p","x")] PairE 1),
  11.133 +	(hyp_subst_tac 1),
  11.134 +	(res_inst_tac [("p","y")] PairE 1),
  11.135 +	(hyp_subst_tac 1),
  11.136 +	(asm_simp_tac pair_ss  1),
  11.137 +	(etac (less_cprod4c RS conjunct2) 1)
  11.138 +	]);
  11.139 +
  11.140 +(* ------------------------------------------------------------------------ *)
  11.141 +(* the type 'a * 'b is a cpo                                                *)
  11.142 +(* ------------------------------------------------------------------------ *)
  11.143 +
  11.144 +val lub_cprod = prove_goal Cprod2.thy 
  11.145 +" is_chain(S) ==> range(S) <<| \
  11.146 +\   < lub(range(%i.fst(S(i)))),lub(range(%i.snd(S(i))))> "
  11.147 + (fn prems =>
  11.148 +	[
  11.149 +	(cut_facts_tac prems 1),
  11.150 +	(rtac is_lubI 1),
  11.151 +	(rtac conjI 1),
  11.152 +	(rtac ub_rangeI 1),
  11.153 +	(rtac allI 1),
  11.154 +	(res_inst_tac [("t","S(i)")] (surjective_pairing RS ssubst) 1),
  11.155 +	(rtac monofun_pair 1),
  11.156 +	(rtac is_ub_thelub 1),
  11.157 +	(etac (monofun_fst RS ch2ch_monofun) 1),
  11.158 +	(rtac is_ub_thelub 1),
  11.159 +	(etac (monofun_snd RS ch2ch_monofun) 1),
  11.160 +	(strip_tac 1),
  11.161 +	(res_inst_tac [("t","u")] (surjective_pairing RS ssubst) 1),
  11.162 +	(rtac monofun_pair 1),
  11.163 +	(rtac is_lub_thelub 1),
  11.164 +	(etac (monofun_fst RS ch2ch_monofun) 1),
  11.165 +	(etac (monofun_fst RS ub2ub_monofun) 1),
  11.166 +	(rtac is_lub_thelub 1),
  11.167 +	(etac (monofun_snd RS ch2ch_monofun) 1),
  11.168 +	(etac (monofun_snd RS ub2ub_monofun) 1)
  11.169 +	]);
  11.170 +
  11.171 +val thelub_cprod = (lub_cprod RS thelubI);
  11.172 +(* "is_chain(?S1) ==> lub(range(?S1)) =                                *)
  11.173 +(*  <lub(range(%i. fst(?S1(i)))), lub(range(%i. snd(?S1(i))))>"        *)
  11.174 +
  11.175 +
  11.176 +val cpo_cprod = prove_goal Cprod2.thy 
  11.177 +	"is_chain(S::nat=>'a*'b)==>? x.range(S)<<| x"
  11.178 +(fn prems =>
  11.179 +	[
  11.180 +	(cut_facts_tac prems 1),
  11.181 +	(rtac exI 1),
  11.182 +	(etac lub_cprod 1)
  11.183 +	]);
  11.184 +
    12.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    12.2 +++ b/src/HOLCF/Cprod2.thy	Wed Jan 19 17:35:01 1994 +0100
    12.3 @@ -0,0 +1,25 @@
    12.4 +(*  Title: 	HOLCF/cprod2.thy
    12.5 +    ID:         $Id$
    12.6 +    Author: 	Franz Regensburger
    12.7 +    Copyright   1993 Technische Universitaet Muenchen
    12.8 +
    12.9 +Class Instance *::(pcpo,pcpo)po
   12.10 +
   12.11 +*)
   12.12 +
   12.13 +Cprod2 = Cprod1 + 
   12.14 +
   12.15 +(* Witness for the above arity axiom is cprod1.ML *)
   12.16 +
   12.17 +arities "*" :: (pcpo,pcpo)po
   12.18 +
   12.19 +rules
   12.20 +
   12.21 +(* instance of << for type ['a * 'b]  *)
   12.22 +
   12.23 +inst_cprod_po	"(op <<)::['a * 'b,'a * 'b]=>bool = less_cprod"
   12.24 +
   12.25 +end
   12.26 +
   12.27 +
   12.28 +
    13.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    13.2 +++ b/src/HOLCF/Cprod3.ML	Wed Jan 19 17:35:01 1994 +0100
    13.3 @@ -0,0 +1,315 @@
    13.4 +(*  Title: 	HOLCF/cprod3.ML
    13.5 +    ID:         $Id$
    13.6 +    Author: 	Franz Regensburger
    13.7 +    Copyright   1993 Technische Universitaet Muenchen
    13.8 +
    13.9 +Lemmas for Cprod3.thy 
   13.10 +*)
   13.11 +
   13.12 +open Cprod3;
   13.13 +
   13.14 +(* ------------------------------------------------------------------------ *)
   13.15 +(* continuity of <_,_> , fst, snd                                           *)
   13.16 +(* ------------------------------------------------------------------------ *)
   13.17 +
   13.18 +val Cprod3_lemma1 = prove_goal Cprod3.thy 
   13.19 +"is_chain(Y::(nat=>'a)) ==>\
   13.20 +\ <lub(range(Y)),(x::'b)> =\
   13.21 +\ <lub(range(%i. fst(<Y(i),x>))),lub(range(%i. snd(<Y(i),x>)))>"
   13.22 + (fn prems =>
   13.23 +	[
   13.24 +	(cut_facts_tac prems 1),
   13.25 +	(res_inst_tac [("f1","Pair")] (arg_cong RS cong) 1),
   13.26 +	(rtac lub_equal 1),
   13.27 +	(atac 1),
   13.28 +	(rtac (monofun_fst RS ch2ch_monofun) 1),
   13.29 +	(rtac ch2ch_fun 1),
   13.30 +	(rtac (monofun_pair1 RS ch2ch_monofun) 1),
   13.31 +	(atac 1),
   13.32 +	(rtac allI 1),
   13.33 +	(simp_tac pair_ss 1),
   13.34 +	(rtac sym 1),
   13.35 +	(simp_tac pair_ss 1),
   13.36 +	(rtac (lub_const RS thelubI) 1)
   13.37 +	]);
   13.38 +
   13.39 +val contlub_pair1 = prove_goal Cprod3.thy "contlub(Pair)"
   13.40 + (fn prems =>
   13.41 +	[
   13.42 +	(rtac contlubI 1),
   13.43 +	(strip_tac 1),
   13.44 +	(rtac (expand_fun_eq RS iffD2) 1),
   13.45 +	(strip_tac 1),
   13.46 +	(rtac (lub_fun RS thelubI RS ssubst) 1),
   13.47 +	(etac (monofun_pair1 RS ch2ch_monofun) 1),
   13.48 +	(rtac trans 1),
   13.49 +	(rtac (thelub_cprod RS sym) 2),
   13.50 +	(rtac ch2ch_fun 2),
   13.51 +	(etac (monofun_pair1 RS ch2ch_monofun) 2),
   13.52 +	(etac Cprod3_lemma1 1)
   13.53 +	]);
   13.54 +
   13.55 +val Cprod3_lemma2 = prove_goal Cprod3.thy 
   13.56 +"is_chain(Y::(nat=>'a)) ==>\
   13.57 +\ <(x::'b),lub(range(Y))> =\
   13.58 +\ <lub(range(%i. fst(<x,Y(i)>))),lub(range(%i. snd(<x,Y(i)>)))>"
   13.59 + (fn prems =>
   13.60 +	[
   13.61 +	(cut_facts_tac prems 1),
   13.62 +	(res_inst_tac [("f1","Pair")] (arg_cong RS cong) 1),
   13.63 +	(rtac sym 1),
   13.64 +	(simp_tac pair_ss 1),
   13.65 +	(rtac (lub_const RS thelubI) 1),
   13.66 +	(rtac lub_equal 1),
   13.67 +	(atac 1),
   13.68 +	(rtac (monofun_snd RS ch2ch_monofun) 1),
   13.69 +	(rtac (monofun_pair2 RS ch2ch_monofun) 1),
   13.70 +	(atac 1),
   13.71 +	(rtac allI 1),
   13.72 +	(simp_tac pair_ss 1)
   13.73 +	]);
   13.74 +
   13.75 +val contlub_pair2 = prove_goal Cprod3.thy "contlub(Pair(x))"
   13.76 + (fn prems =>
   13.77 +	[
   13.78 +	(rtac contlubI 1),
   13.79 +	(strip_tac 1),
   13.80 +	(rtac trans 1),
   13.81 +	(rtac (thelub_cprod RS sym) 2),
   13.82 +	(etac (monofun_pair2 RS ch2ch_monofun) 2),
   13.83 +	(etac Cprod3_lemma2 1)
   13.84 +	]);
   13.85 +
   13.86 +val contX_pair1 = prove_goal Cprod3.thy "contX(Pair)"
   13.87 +(fn prems =>
   13.88 +	[
   13.89 +	(rtac monocontlub2contX 1),
   13.90 +	(rtac monofun_pair1 1),
   13.91 +	(rtac contlub_pair1 1)
   13.92 +	]);
   13.93 +
   13.94 +val contX_pair2 = prove_goal Cprod3.thy "contX(Pair(x))"
   13.95 +(fn prems =>
   13.96 +	[
   13.97 +	(rtac monocontlub2contX 1),
   13.98 +	(rtac monofun_pair2 1),
   13.99 +	(rtac contlub_pair2 1)
  13.100 +	]);
  13.101 +
  13.102 +val contlub_fst = prove_goal Cprod3.thy "contlub(fst)"
  13.103 + (fn prems =>
  13.104 +	[
  13.105 +	(rtac contlubI 1),
  13.106 +	(strip_tac 1),
  13.107 +	(rtac (lub_cprod RS thelubI RS ssubst) 1),
  13.108 +	(atac 1),
  13.109 +	(simp_tac pair_ss 1)
  13.110 +	]);
  13.111 +
  13.112 +val contlub_snd = prove_goal Cprod3.thy "contlub(snd)"
  13.113 + (fn prems =>
  13.114 +	[
  13.115 +	(rtac contlubI 1),
  13.116 +	(strip_tac 1),
  13.117 +	(rtac (lub_cprod RS thelubI RS ssubst) 1),
  13.118 +	(atac 1),
  13.119 +	(simp_tac pair_ss 1)
  13.120 +	]);
  13.121 +
  13.122 +val contX_fst = prove_goal Cprod3.thy "contX(fst)"
  13.123 +(fn prems =>
  13.124 +	[
  13.125 +	(rtac monocontlub2contX 1),
  13.126 +	(rtac monofun_fst 1),
  13.127 +	(rtac contlub_fst 1)
  13.128 +	]);
  13.129 +
  13.130 +val contX_snd = prove_goal Cprod3.thy "contX(snd)"
  13.131 +(fn prems =>
  13.132 +	[
  13.133 +	(rtac monocontlub2contX 1),
  13.134 +	(rtac monofun_snd 1),
  13.135 +	(rtac contlub_snd 1)
  13.136 +	]);
  13.137 +
  13.138 +(* 
  13.139 + -------------------------------------------------------------------------- 
  13.140 + more lemmas for Cprod3.thy 
  13.141 + 
  13.142 + -------------------------------------------------------------------------- 
  13.143 +*)
  13.144 +
  13.145 +(* ------------------------------------------------------------------------ *)
  13.146 +(* convert all lemmas to the continuous versions                            *)
  13.147 +(* ------------------------------------------------------------------------ *)
  13.148 +
  13.149 +val beta_cfun_cprod = prove_goalw Cprod3.thy [cpair_def]
  13.150 +	"(LAM x y.<x,y>)[a][b] = <a,b>"
  13.151 + (fn prems =>
  13.152 +	[
  13.153 +	(rtac (beta_cfun RS ssubst) 1),
  13.154 +	(contX_tac 1),
  13.155 +	(rtac contX_pair2 1),
  13.156 +	(rtac contX2contX_CF1L 1),
  13.157 +	(rtac contX_pair1 1),
  13.158 +	(rtac (beta_cfun RS ssubst) 1),
  13.159 +	(rtac contX_pair2 1),
  13.160 +	(rtac refl 1)
  13.161 +	]);
  13.162 +
  13.163 +val inject_cpair = prove_goalw Cprod3.thy [cpair_def]
  13.164 +	" (a#b)=(aa#ba)  ==> a=aa & b=ba"
  13.165 + (fn prems =>
  13.166 +	[
  13.167 +	(cut_facts_tac prems 1),
  13.168 +	(dtac (beta_cfun_cprod RS subst) 1),
  13.169 +	(dtac (beta_cfun_cprod RS subst) 1),
  13.170 +	(etac Pair_inject 1),
  13.171 +	(fast_tac HOL_cs 1)
  13.172 +	]);
  13.173 +
  13.174 +val inst_cprod_pcpo2 = prove_goalw Cprod3.thy [cpair_def] "UU = (UU#UU)"
  13.175 + (fn prems =>
  13.176 +	[
  13.177 +	(rtac sym 1),
  13.178 +	(rtac trans 1),
  13.179 +	(rtac beta_cfun_cprod 1),
  13.180 +	(rtac sym 1),
  13.181 +	(rtac inst_cprod_pcpo 1)
  13.182 +	]);
  13.183 +
  13.184 +val defined_cpair_rev = prove_goal Cprod3.thy
  13.185 + "(a#b) = UU ==> a = UU & b = UU"
  13.186 + (fn prems =>
  13.187 +	[
  13.188 +	(cut_facts_tac prems 1),
  13.189 +	(dtac (inst_cprod_pcpo2 RS subst) 1),
  13.190 +	(etac inject_cpair 1)
  13.191 +	]);
  13.192 +
  13.193 +val Exh_Cprod2 = prove_goalw Cprod3.thy [cpair_def]
  13.194 +	"? a b. z=(a#b) "
  13.195 + (fn prems =>
  13.196 +	[
  13.197 +	(rtac PairE 1),
  13.198 +	(rtac exI 1),
  13.199 +	(rtac exI 1),
  13.200 +	(etac (beta_cfun_cprod RS ssubst) 1)
  13.201 +	]);
  13.202 +
  13.203 +val cprodE = prove_goalw Cprod3.thy [cpair_def]
  13.204 +"[|!!x y. [|p=(x#y) |] ==> Q|] ==> Q"
  13.205 + (fn prems =>
  13.206 +	[
  13.207 +	(rtac PairE 1),
  13.208 +	(resolve_tac prems 1),
  13.209 +	(etac (beta_cfun_cprod RS ssubst) 1)
  13.210 +	]);
  13.211 +
  13.212 +val cfst2 = prove_goalw Cprod3.thy [cfst_def,cpair_def] 
  13.213 +	"cfst[x#y]=x"
  13.214 + (fn prems =>
  13.215 +	[
  13.216 +	(cut_facts_tac prems 1),
  13.217 +	(rtac (beta_cfun_cprod RS ssubst) 1),
  13.218 +	(rtac (beta_cfun RS ssubst) 1),
  13.219 +	(rtac contX_fst 1),
  13.220 +	(simp_tac pair_ss  1)
  13.221 +	]);
  13.222 +
  13.223 +val csnd2 = prove_goalw Cprod3.thy [csnd_def,cpair_def] 
  13.224 +	"csnd[x#y]=y"
  13.225 + (fn prems =>
  13.226 +	[
  13.227 +	(cut_facts_tac prems 1),
  13.228 +	(rtac (beta_cfun_cprod RS ssubst) 1),
  13.229 +	(rtac (beta_cfun RS ssubst) 1),
  13.230 +	(rtac contX_snd 1),
  13.231 +	(simp_tac pair_ss  1)
  13.232 +	]);
  13.233 +
  13.234 +val surjective_pairing_Cprod2 = prove_goalw Cprod3.thy 
  13.235 +	[cfst_def,csnd_def,cpair_def] "(cfst[p] # csnd[p]) = p"
  13.236 + (fn prems =>
  13.237 +	[
  13.238 +	(rtac (beta_cfun_cprod RS ssubst) 1),
  13.239 +	(rtac (beta_cfun RS ssubst) 1),
  13.240 +	(rtac contX_snd 1),
  13.241 +	(rtac (beta_cfun RS ssubst) 1),
  13.242 +	(rtac contX_fst 1),
  13.243 +	(rtac (surjective_pairing RS sym) 1)
  13.244 +	]);
  13.245 +
  13.246 +
  13.247 +val less_cprod5b = prove_goalw Cprod3.thy [cfst_def,csnd_def,cpair_def]
  13.248 + " (p1 << p2) = (cfst[p1]<<cfst[p2] & csnd[p1]<<csnd[p2])"
  13.249 + (fn prems =>
  13.250 +	[
  13.251 +	(rtac (beta_cfun RS ssubst) 1),
  13.252 +	(rtac contX_snd 1),
  13.253 +	(rtac (beta_cfun RS ssubst) 1),
  13.254 +	(rtac contX_snd 1),
  13.255 +	(rtac (beta_cfun RS ssubst) 1),
  13.256 +	(rtac contX_fst 1),
  13.257 +	(rtac (beta_cfun RS ssubst) 1),
  13.258 +	(rtac contX_fst 1),
  13.259 +	(rtac less_cprod3b 1)
  13.260 +	]);
  13.261 +
  13.262 +val less_cprod5c = prove_goalw Cprod3.thy [cfst_def,csnd_def,cpair_def]
  13.263 + "xa#ya << x#y ==>xa<<x & ya << y"
  13.264 + (fn prems =>
  13.265 +	[
  13.266 +	(cut_facts_tac prems 1),
  13.267 +	(rtac less_cprod4c 1),
  13.268 +	(dtac (beta_cfun_cprod RS subst) 1),
  13.269 +	(dtac (beta_cfun_cprod RS subst) 1),
  13.270 +	(atac 1)
  13.271 +	]);
  13.272 +
  13.273 +
  13.274 +val lub_cprod2 = prove_goalw Cprod3.thy [cfst_def,csnd_def,cpair_def]
  13.275 +"[|is_chain(S)|] ==> range(S) <<| \
  13.276 +\ (lub(range(%i.cfst[S(i)])) # lub(range(%i.csnd[S(i)])))"
  13.277 + (fn prems =>
  13.278 +	[
  13.279 +	(cut_facts_tac prems 1),
  13.280 +	(rtac (beta_cfun_cprod RS ssubst) 1),
  13.281 +	(rtac (beta_cfun RS ext RS ssubst) 1),
  13.282 +	(rtac contX_snd 1),
  13.283 +	(rtac (beta_cfun RS ext RS ssubst) 1),
  13.284 +	(rtac contX_fst 1),
  13.285 +	(rtac lub_cprod 1),
  13.286 +	(atac 1)
  13.287 +	]);
  13.288 +
  13.289 +val thelub_cprod2 = (lub_cprod2 RS thelubI);
  13.290 +(*  "is_chain(?S1) ==> lub(range(?S1)) =                         *)
  13.291 +(*    lub(range(%i. cfst[?S1(i)]))#lub(range(%i. csnd[?S1(i)]))" *)
  13.292 +
  13.293 +val csplit2 = prove_goalw Cprod3.thy [csplit_def]
  13.294 +	"csplit[f][x#y]=f[x][y]"
  13.295 + (fn prems =>
  13.296 +	[
  13.297 +	(rtac (beta_cfun RS ssubst) 1),
  13.298 +	(contX_tacR 1),
  13.299 +	(simp_tac Cfun_ss 1),
  13.300 +	(simp_tac (Cfun_ss addsimps [cfst2,csnd2]) 1)
  13.301 +	]);
  13.302 +
  13.303 +val csplit3 = prove_goalw Cprod3.thy [csplit_def]
  13.304 +  "csplit[cpair][z]=z"
  13.305 + (fn prems =>
  13.306 +	[
  13.307 +	(rtac (beta_cfun RS ssubst) 1),
  13.308 +	(contX_tacR 1),
  13.309 +	(simp_tac (Cfun_ss addsimps [surjective_pairing_Cprod2]) 1)
  13.310 +	]);
  13.311 +
  13.312 +(* ------------------------------------------------------------------------ *)
  13.313 +(* install simplifier for Cprod                                             *)
  13.314 +(* ------------------------------------------------------------------------ *)
  13.315 +
  13.316 +val Cprod_rews = [cfst2,csnd2,csplit2];
  13.317 +
  13.318 +val Cprod_ss = Cfun_ss addsimps Cprod_rews;
    14.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    14.2 +++ b/src/HOLCF/Cprod3.thy	Wed Jan 19 17:35:01 1994 +0100
    14.3 @@ -0,0 +1,43 @@
    14.4 +(*  Title: 	HOLCF/cprod3.thy
    14.5 +    ID:         $Id$
    14.6 +    Author: 	Franz Regensburger
    14.7 +    Copyright   1993 Technische Universitaet Muenchen
    14.8 +
    14.9 +
   14.10 +Class instance of  * for class pcpo
   14.11 +
   14.12 +*)
   14.13 +
   14.14 +Cprod3 = Cprod2 +
   14.15 +
   14.16 +arities "*" :: (pcpo,pcpo)pcpo			(* Witness cprod2.ML *)
   14.17 +
   14.18 +consts  
   14.19 +	"@cpair"     :: "'a => 'b => ('a*'b)" ("_#_" [101,100] 100)
   14.20 +	"cop @cpair" :: "'a -> 'b -> ('a*'b)" ("cpair")
   14.21 +					(* continuous  pairing *)
   14.22 +	cfst         :: "('a*'b)->'a"
   14.23 +	csnd         :: "('a*'b)->'b"
   14.24 +	csplit       :: "('a->'b->'c)->('a*'b)->'c"
   14.25 +
   14.26 +rules 
   14.27 +
   14.28 +inst_cprod_pcpo	"UU::'a*'b = <UU,UU>"
   14.29 +
   14.30 +cpair_def	"cpair  == (LAM x y.<x,y>)"
   14.31 +cfst_def	"cfst   == (LAM p.fst(p))"
   14.32 +csnd_def	"csnd   == (LAM p.snd(p))"	
   14.33 +csplit_def	"csplit == (LAM f p.f[cfst[p]][csnd[p]])"
   14.34 +
   14.35 +end
   14.36 +
   14.37 +ML
   14.38 +
   14.39 +(* ----------------------------------------------------------------------*)
   14.40 +(* parse translations for the above mixfix                               *)
   14.41 +(* ----------------------------------------------------------------------*)
   14.42 +
   14.43 +val parse_translation = [("@cpair",mk_cinfixtr "@cpair")];
   14.44 +
   14.45 +
   14.46 +
    15.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    15.2 +++ b/src/HOLCF/Dnat.ML	Wed Jan 19 17:35:01 1994 +0100
    15.3 @@ -0,0 +1,471 @@
    15.4 +(*  Title: 	HOLCF/dnat.ML
    15.5 +    ID:         $Id$
    15.6 +    Author: 	Franz Regensburger
    15.7 +    Copyright   1993 Technische Universitaet Muenchen
    15.8 +
    15.9 +Lemmas for dnat.thy 
   15.10 +*)
   15.11 +
   15.12 +open Dnat;
   15.13 +
   15.14 +(* ------------------------------------------------------------------------*)
   15.15 +(* The isomorphisms dnat_rep_iso and dnat_abs_iso are strict               *)
   15.16 +(* ------------------------------------------------------------------------*)
   15.17 +
   15.18 +val dnat_iso_strict= dnat_rep_iso RS (dnat_abs_iso RS 
   15.19 +	(allI  RSN (2,allI RS iso_strict)));
   15.20 +
   15.21 +val dnat_rews = [dnat_iso_strict RS conjunct1,
   15.22 +		dnat_iso_strict RS conjunct2];
   15.23 +
   15.24 +(* ------------------------------------------------------------------------*)
   15.25 +(* Properties of dnat_copy                                                 *)
   15.26 +(* ------------------------------------------------------------------------*)
   15.27 +
   15.28 +fun prover defs thm =  prove_goalw Dnat.thy defs thm
   15.29 + (fn prems =>
   15.30 +	[
   15.31 +	(cut_facts_tac prems 1),
   15.32 +	(asm_simp_tac (HOLCF_ss addsimps 
   15.33 +		(dnat_rews @ [dnat_abs_iso,dnat_rep_iso])) 1)
   15.34 +	]);
   15.35 +
   15.36 +val dnat_copy = 
   15.37 +	[
   15.38 +	prover [dnat_copy_def] "dnat_copy[f][UU]=UU",
   15.39 +	prover [dnat_copy_def,dzero_def] "dnat_copy[f][dzero]= dzero",
   15.40 +	prover [dnat_copy_def,dsucc_def] 
   15.41 +		"n~=UU ==> dnat_copy[f][dsucc[n]] = dsucc[f[n]]"
   15.42 +	];
   15.43 +
   15.44 +val dnat_rews =  dnat_copy @ dnat_rews; 
   15.45 +
   15.46 +(* ------------------------------------------------------------------------*)
   15.47 +(* Exhaustion and elimination for dnat                                     *)
   15.48 +(* ------------------------------------------------------------------------*)
   15.49 +
   15.50 +val Exh_dnat = prove_goalw Dnat.thy [dsucc_def,dzero_def]
   15.51 +	"n = UU | n = dzero | (? x . x~=UU & n = dsucc[x])"
   15.52 + (fn prems =>
   15.53 +	[
   15.54 +	(simp_tac HOLCF_ss  1),
   15.55 +	(rtac (dnat_rep_iso RS subst) 1),
   15.56 +	(res_inst_tac [("p","dnat_rep[n]")] ssumE 1),
   15.57 +	(rtac disjI1 1),
   15.58 +	(asm_simp_tac (HOLCF_ss addsimps dnat_rews) 1),
   15.59 +	(rtac (disjI1 RS disjI2) 1),
   15.60 +	(asm_simp_tac (HOLCF_ss addsimps dnat_rews) 1),
   15.61 +	(res_inst_tac [("p","x")] oneE 1),
   15.62 +	(contr_tac 1),
   15.63 +	(asm_simp_tac (HOLCF_ss addsimps dnat_rews) 1),
   15.64 +	(rtac (disjI2 RS disjI2) 1),
   15.65 +	(asm_simp_tac (HOLCF_ss addsimps dnat_rews) 1),
   15.66 +	(fast_tac HOL_cs 1)
   15.67 +	]);
   15.68 +
   15.69 +val dnatE = prove_goal Dnat.thy 
   15.70 + "[| n=UU ==> Q; n=dzero ==> Q; !!x.[|n=dsucc[x];x~=UU|]==>Q|]==>Q"
   15.71 + (fn prems =>
   15.72 +	[
   15.73 +	(rtac (Exh_dnat RS disjE) 1),
   15.74 +	(eresolve_tac prems 1),
   15.75 +	(etac disjE 1),
   15.76 +	(eresolve_tac prems 1),
   15.77 +	(REPEAT (etac exE 1)),
   15.78 +	(resolve_tac prems 1),
   15.79 +	(fast_tac HOL_cs 1),
   15.80 +	(fast_tac HOL_cs 1)
   15.81 +	]);
   15.82 +
   15.83 +(* ------------------------------------------------------------------------*)
   15.84 +(* Properties of dnat_when                                                 *)
   15.85 +(* ------------------------------------------------------------------------*)
   15.86 +
   15.87 +fun prover defs thm =  prove_goalw Dnat.thy defs thm
   15.88 + (fn prems =>
   15.89 +	[
   15.90 +	(cut_facts_tac prems 1),
   15.91 +	(asm_simp_tac (HOLCF_ss addsimps 
   15.92 +		(dnat_rews @ [dnat_abs_iso,dnat_rep_iso])) 1)
   15.93 +	]);
   15.94 +
   15.95 +
   15.96 +val dnat_when = [
   15.97 +	prover [dnat_when_def] "dnat_when[c][f][UU]=UU",
   15.98 +	prover [dnat_when_def,dzero_def] "dnat_when[c][f][dzero]=c",
   15.99 +	prover [dnat_when_def,dsucc_def] 
  15.100 +		"n~=UU ==> dnat_when[c][f][dsucc[n]]=f[n]"
  15.101 +	];
  15.102 +
  15.103 +val dnat_rews = dnat_when @ dnat_rews;
  15.104 +
  15.105 +(* ------------------------------------------------------------------------*)
  15.106 +(* Rewrites for  discriminators and  selectors                             *)
  15.107 +(* ------------------------------------------------------------------------*)
  15.108 +
  15.109 +fun prover defs thm = prove_goalw Dnat.thy defs thm
  15.110 + (fn prems =>
  15.111 +	[
  15.112 +	(simp_tac (HOLCF_ss addsimps dnat_rews) 1)
  15.113 +	]);
  15.114 +
  15.115 +val dnat_discsel = [
  15.116 +	prover [is_dzero_def] "is_dzero[UU]=UU",
  15.117 +	prover [is_dsucc_def] "is_dsucc[UU]=UU",
  15.118 +	prover [dpred_def] "dpred[UU]=UU"
  15.119 +	];
  15.120 +
  15.121 +
  15.122 +fun prover defs thm = prove_goalw Dnat.thy defs thm
  15.123 + (fn prems =>
  15.124 +	[
  15.125 +	(cut_facts_tac prems 1),
  15.126 +	(asm_simp_tac (HOLCF_ss addsimps dnat_rews) 1)
  15.127 +	]);
  15.128 +
  15.129 +val dnat_discsel = [
  15.130 +	prover [is_dzero_def] "is_dzero[dzero]=TT",
  15.131 +	prover [is_dzero_def] "n~=UU ==>is_dzero[dsucc[n]]=FF",
  15.132 +	prover [is_dsucc_def] "is_dsucc[dzero]=FF",
  15.133 +	prover [is_dsucc_def] "n~=UU ==> is_dsucc[dsucc[n]]=TT",
  15.134 +	prover [dpred_def] "dpred[dzero]=UU",
  15.135 +	prover [dpred_def] "n~=UU ==> dpred[dsucc[n]]=n"
  15.136 +	] @ dnat_discsel;
  15.137 +
  15.138 +val dnat_rews = dnat_discsel @ dnat_rews;
  15.139 +
  15.140 +(* ------------------------------------------------------------------------*)
  15.141 +(* Definedness and strictness                                              *)
  15.142 +(* ------------------------------------------------------------------------*)
  15.143 +
  15.144 +fun prover contr thm = prove_goal Dnat.thy thm
  15.145 + (fn prems =>
  15.146 +	[
  15.147 +	(res_inst_tac [("P1",contr)] classical3 1),
  15.148 +	(simp_tac (HOLCF_ss addsimps dnat_rews) 1),
  15.149 +	(dtac sym 1),
  15.150 +	(asm_simp_tac HOLCF_ss  1),
  15.151 +	(simp_tac (HOLCF_ss addsimps (prems @ dnat_rews)) 1)
  15.152 +	]);
  15.153 +
  15.154 +val dnat_constrdef = [
  15.155 +	prover "is_dzero[UU] ~= UU" "dzero~=UU",
  15.156 +	prover "is_dsucc[UU] ~= UU" "n~=UU ==> dsucc[n]~=UU"
  15.157 +	]; 
  15.158 +
  15.159 +
  15.160 +fun prover defs thm = prove_goalw Dnat.thy defs thm
  15.161 + (fn prems =>
  15.162 +	[
  15.163 +	(simp_tac (HOLCF_ss addsimps dnat_rews) 1)
  15.164 +	]);
  15.165 +
  15.166 +val dnat_constrdef = [
  15.167 +	prover [dsucc_def] "dsucc[UU]=UU"
  15.168 +	] @ dnat_constrdef;
  15.169 +
  15.170 +val dnat_rews = dnat_constrdef @ dnat_rews;
  15.171 +
  15.172 +
  15.173 +(* ------------------------------------------------------------------------*)
  15.174 +(* Distinctness wrt. << and =                                              *)
  15.175 +(* ------------------------------------------------------------------------*)
  15.176 +
  15.177 +fun prover contrfun thm = prove_goal Dnat.thy thm
  15.178 + (fn prems =>
  15.179 +	[
  15.180 +	(cut_facts_tac prems 1),
  15.181 +	(res_inst_tac [("P1","TT << FF")] classical3 1),
  15.182 +	(resolve_tac dist_less_tr 1),
  15.183 +	(dres_inst_tac [("fo5",contrfun)] monofun_cfun_arg 1),
  15.184 +	(etac box_less 1),
  15.185 +	(asm_simp_tac (HOLCF_ss addsimps dnat_rews) 1),
  15.186 +	(asm_simp_tac (HOLCF_ss addsimps dnat_rews) 1)
  15.187 +	]);
  15.188 +
  15.189 +val dnat_dist_less = 
  15.190 +	[
  15.191 +prover "is_dzero" "n~=UU ==> ~dzero << dsucc[n]",
  15.192 +prover "is_dsucc" "n~=UU ==> ~dsucc[n] << dzero"
  15.193 +	];
  15.194 +
  15.195 +fun prover contrfun thm = prove_goal Dnat.thy thm
  15.196 + (fn prems =>
  15.197 +	[
  15.198 +	(cut_facts_tac prems 1),
  15.199 +	(res_inst_tac [("P1","TT = FF")] classical3 1),
  15.200 +	(resolve_tac dist_eq_tr 1),
  15.201 +	(dres_inst_tac [("f",contrfun)] cfun_arg_cong 1),
  15.202 +	(etac box_equals 1),
  15.203 +	(asm_simp_tac (HOLCF_ss addsimps dnat_rews) 1),
  15.204 +	(asm_simp_tac (HOLCF_ss addsimps dnat_rews) 1)
  15.205 +	]);
  15.206 +
  15.207 +val dnat_dist_eq = 
  15.208 +	[
  15.209 +prover "is_dzero" "n~=UU ==> dzero ~= dsucc[n]",
  15.210 +prover "is_dsucc" "n~=UU ==> dsucc[n] ~= dzero"
  15.211 +	];
  15.212 +
  15.213 +val dnat_rews = dnat_dist_less @ dnat_dist_eq @ dnat_rews;
  15.214 +
  15.215 +(* ------------------------------------------------------------------------*)
  15.216 +(* Invertibility                                                           *)
  15.217 +(* ------------------------------------------------------------------------*)
  15.218 +
  15.219 +val dnat_invert = 
  15.220 +	[
  15.221 +prove_goal Dnat.thy 
  15.222 +"[|x1~=UU; y1~=UU; dsucc[x1] << dsucc[y1] |] ==> x1<< y1"
  15.223 + (fn prems =>
  15.224 +	[
  15.225 +	(cut_facts_tac prems 1),
  15.226 +	(dres_inst_tac [("fo5","dnat_when[c][LAM x.x]")] monofun_cfun_arg 1),
  15.227 +	(etac box_less 1),
  15.228 +	(asm_simp_tac (HOLCF_ss addsimps dnat_rews) 1),
  15.229 +	(asm_simp_tac (HOLCF_ss addsimps dnat_rews) 1)
  15.230 +	])
  15.231 +	];
  15.232 +
  15.233 +(* ------------------------------------------------------------------------*)
  15.234 +(* Injectivity                                                             *)
  15.235 +(* ------------------------------------------------------------------------*)
  15.236 +
  15.237 +val dnat_inject = 
  15.238 +	[
  15.239 +prove_goal Dnat.thy 
  15.240 +"[|x1~=UU; y1~=UU; dsucc[x1] = dsucc[y1] |] ==> x1= y1"
  15.241 + (fn prems =>
  15.242 +	[
  15.243 +	(cut_facts_tac prems 1),
  15.244 +	(dres_inst_tac [("f","dnat_when[c][LAM x.x]")] cfun_arg_cong 1),
  15.245 +	(etac box_equals 1),
  15.246 +	(asm_simp_tac (HOLCF_ss addsimps dnat_rews) 1),
  15.247 +	(asm_simp_tac (HOLCF_ss addsimps dnat_rews) 1)
  15.248 +	])
  15.249 +	];
  15.250 +
  15.251 +(* ------------------------------------------------------------------------*)
  15.252 +(* definedness for  discriminators and  selectors                          *)
  15.253 +(* ------------------------------------------------------------------------*)
  15.254 +
  15.255 +
  15.256 +fun prover thm = prove_goal Dnat.thy thm
  15.257 + (fn prems =>
  15.258 +	[
  15.259 +	(cut_facts_tac prems 1),
  15.260 +	(rtac dnatE 1),
  15.261 +	(contr_tac 1),
  15.262 +	(REPEAT (asm_simp_tac (HOLCF_ss addsimps dnat_rews) 1))
  15.263 +	]);
  15.264 +
  15.265 +val dnat_discsel_def = 
  15.266 +	[
  15.267 +	prover  "n~=UU ==> is_dzero[n]~=UU",
  15.268 +	prover  "n~=UU ==> is_dsucc[n]~=UU"
  15.269 +	];
  15.270 +
  15.271 +val dnat_rews = dnat_discsel_def @ dnat_rews;
  15.272 +
  15.273 + 
  15.274 +(* ------------------------------------------------------------------------*)
  15.275 +(* Properties dnat_take                                                    *)
  15.276 +(* ------------------------------------------------------------------------*)
  15.277 +
  15.278 +val dnat_take =
  15.279 +	[
  15.280 +prove_goalw Dnat.thy [dnat_take_def] "dnat_take(n)[UU]=UU"
  15.281 + (fn prems =>
  15.282 +	[
  15.283 +	(res_inst_tac [("n","n")] natE 1),
  15.284 +	(asm_simp_tac iterate_ss 1),
  15.285 +	(asm_simp_tac iterate_ss 1),
  15.286 +	(simp_tac (HOLCF_ss addsimps dnat_rews) 1)
  15.287 +	]),
  15.288 +prove_goalw Dnat.thy [dnat_take_def] "dnat_take(0)[xs]=UU"
  15.289 + (fn prems =>
  15.290 +	[
  15.291 +	(asm_simp_tac iterate_ss 1)
  15.292 +	])];
  15.293 +
  15.294 +fun prover thm = prove_goalw Dnat.thy [dnat_take_def] thm
  15.295 + (fn prems =>
  15.296 +	[
  15.297 +	(cut_facts_tac prems 1),
  15.298 +	(simp_tac iterate_ss 1),
  15.299 +	(asm_simp_tac (HOLCF_ss addsimps dnat_rews) 1)
  15.300 +	]);
  15.301 +
  15.302 +val dnat_take = [
  15.303 +prover "dnat_take(Suc(n))[dzero]=dzero",
  15.304 +prover "xs~=UU ==> dnat_take(Suc(n))[dsucc[xs]]=dsucc[dnat_take(n)[xs]]"
  15.305 +	] @ dnat_take;
  15.306 +
  15.307 +
  15.308 +val dnat_rews = dnat_take @ dnat_rews;
  15.309 +
  15.310 +(* ------------------------------------------------------------------------*)
  15.311 +(* take lemma for dnats                                                  *)
  15.312 +(* ------------------------------------------------------------------------*)
  15.313 +
  15.314 +fun prover reach defs thm  = prove_goalw Dnat.thy defs thm
  15.315 + (fn prems =>
  15.316 +	[
  15.317 +	(res_inst_tac [("t","s1")] (reach RS subst) 1),
  15.318 +	(res_inst_tac [("t","s2")] (reach RS subst) 1),
  15.319 +	(rtac (fix_def2 RS ssubst) 1),
  15.320 +	(rtac (contlub_cfun_fun RS ssubst) 1),
  15.321 +	(rtac is_chain_iterate 1),
  15.322 +	(rtac (contlub_cfun_fun RS ssubst) 1),
  15.323 +	(rtac is_chain_iterate 1),
  15.324 +	(rtac lub_equal 1),
  15.325 +	(rtac (is_chain_iterate RS ch2ch_fappL) 1),
  15.326 +	(rtac (is_chain_iterate RS ch2ch_fappL) 1),
  15.327 +	(rtac allI 1),
  15.328 +	(resolve_tac prems 1)
  15.329 +	]);
  15.330 +
  15.331 +val dnat_take_lemma = prover dnat_reach  [dnat_take_def]
  15.332 +	"(!!n.dnat_take(n)[s1]=dnat_take(n)[s2]) ==> s1=s2";
  15.333 +
  15.334 +
  15.335 +(* ------------------------------------------------------------------------*)
  15.336 +(* Co -induction for dnats                                                 *)
  15.337 +(* ------------------------------------------------------------------------*)
  15.338 +
  15.339 +val dnat_coind_lemma = prove_goalw Dnat.thy [dnat_bisim_def] 
  15.340 +"dnat_bisim(R) ==> ! p q.R(p,q) --> dnat_take(n)[p]=dnat_take(n)[q]"
  15.341 + (fn prems =>
  15.342 +	[
  15.343 +	(cut_facts_tac prems 1),
  15.344 +	(nat_ind_tac "n" 1),
  15.345 +	(simp_tac (HOLCF_ss addsimps dnat_take) 1),
  15.346 +	(strip_tac 1),
  15.347 +	((etac allE 1) THEN (etac allE 1) THEN (etac (mp RS disjE) 1)),
  15.348 +	(atac 1),
  15.349 +	(asm_simp_tac (HOLCF_ss addsimps dnat_take) 1),
  15.350 +	(etac disjE 1),
  15.351 +	(asm_simp_tac (HOLCF_ss addsimps dnat_take) 1),
  15.352 +	(etac exE 1),
  15.353 +	(etac exE 1),
  15.354 +	(asm_simp_tac (HOLCF_ss addsimps dnat_take) 1),
  15.355 +	(REPEAT (etac conjE 1)),
  15.356 +	(rtac cfun_arg_cong 1),
  15.357 +	(fast_tac HOL_cs 1)
  15.358 +	]);
  15.359 +
  15.360 +val dnat_coind = prove_goal Dnat.thy "[|dnat_bisim(R);R(p,q)|] ==> p = q"
  15.361 + (fn prems =>
  15.362 +	[
  15.363 +	(rtac dnat_take_lemma 1),
  15.364 +	(rtac (dnat_coind_lemma RS spec RS spec RS mp) 1),
  15.365 +	(resolve_tac prems 1),
  15.366 +	(resolve_tac prems 1)
  15.367 +	]);
  15.368 +
  15.369 +
  15.370 +(* ------------------------------------------------------------------------*)
  15.371 +(* structural induction for admissible predicates                          *)
  15.372 +(* ------------------------------------------------------------------------*)
  15.373 +
  15.374 +val dnat_ind = prove_goal Dnat.thy
  15.375 +"[| adm(P);\
  15.376 +\   P(UU);\
  15.377 +\   P(dzero);\
  15.378 +\   !! s1.[|s1~=UU ; P(s1)|] ==> P(dsucc[s1])|] ==> P(s)"
  15.379 + (fn prems =>
  15.380 +	[
  15.381 +	(rtac (dnat_reach RS subst) 1),
  15.382 +	(res_inst_tac [("x","s")] spec 1),
  15.383 +	(rtac fix_ind 1),
  15.384 +	(rtac adm_all2 1),
  15.385 +	(rtac adm_subst 1),
  15.386 +	(contX_tacR 1),
  15.387 +	(resolve_tac prems 1),
  15.388 +	(simp_tac HOLCF_ss 1),
  15.389 +	(resolve_tac prems 1),
  15.390 +	(strip_tac 1),
  15.391 +	(res_inst_tac [("n","xa")] dnatE 1),
  15.392 +	(asm_simp_tac (HOLCF_ss addsimps dnat_copy) 1),
  15.393 +	(resolve_tac prems 1),
  15.394 +	(asm_simp_tac (HOLCF_ss addsimps dnat_copy) 1),
  15.395 +	(resolve_tac prems 1),
  15.396 +	(asm_simp_tac (HOLCF_ss addsimps dnat_copy) 1),
  15.397 +	(res_inst_tac [("Q","x[xb]=UU")] classical2 1),
  15.398 +	(asm_simp_tac (HOLCF_ss addsimps dnat_rews) 1),
  15.399 +	(resolve_tac prems 1),
  15.400 +	(eresolve_tac prems 1),
  15.401 +	(etac spec 1)
  15.402 +	]);
  15.403 +
  15.404 +
  15.405 +val dnat_flat = prove_goalw Dnat.thy [flat_def] "flat(dzero)"
  15.406 + (fn prems =>
  15.407 +	[
  15.408 +	(rtac allI 1),
  15.409 +	(res_inst_tac [("s","x")] dnat_ind 1),
  15.410 +	(REPEAT (resolve_tac adm_thms 1)),
  15.411 +	(contX_tacR 1),
  15.412 +	(REPEAT (resolve_tac adm_thms 1)),
  15.413 +	(contX_tacR 1),
  15.414 +	(REPEAT (resolve_tac adm_thms 1)),
  15.415 +	(contX_tacR 1),
  15.416 +	(fast_tac HOL_cs 1),
  15.417 +	(rtac allI 1),
  15.418 +	(res_inst_tac [("n","y")] dnatE 1),
  15.419 +	(fast_tac (HOL_cs addSIs [UU_I]) 1),
  15.420 +	(asm_simp_tac HOLCF_ss 1),
  15.421 +	(asm_simp_tac (HOLCF_ss addsimps dnat_dist_less) 1),
  15.422 +	(rtac allI 1),
  15.423 +	(res_inst_tac [("n","y")] dnatE 1),
  15.424 +	(fast_tac (HOL_cs addSIs [UU_I]) 1),
  15.425 +	(asm_simp_tac (HOLCF_ss addsimps dnat_rews) 1),
  15.426 +	(hyp_subst_tac 1),
  15.427 +	(strip_tac 1),
  15.428 +	(rtac disjI2 1),
  15.429 +	(forward_tac dnat_invert 1),
  15.430 +	(atac 2),
  15.431 +	(atac 1),
  15.432 +	(etac allE 1),
  15.433 +	(dtac mp 1),
  15.434 +	(atac 1),
  15.435 +	(etac disjE 1),
  15.436 +	(contr_tac 1),
  15.437 +	(asm_simp_tac HOLCF_ss 1)
  15.438 +	]);
  15.439 +
  15.440 +val dnat_ind = prove_goal Dnat.thy
  15.441 +"[| adm(P);\
  15.442 +\   P(UU);\
  15.443 +\   P(dzero);\
  15.444 +\   !! s1.[|s1~=UU ; P(s1)|] ==> P(dsucc[s1])|] ==> P(s)"
  15.445 + (fn prems =>
  15.446 +	[
  15.447 +	(rtac (dnat_reach RS subst) 1),
  15.448 +	(res_inst_tac [("x","s")] spec 1),
  15.449 +	(rtac fix_ind 1),
  15.450 +	(rtac adm_all2 1),
  15.451 +	(rtac adm_subst 1),
  15.452 +	(contX_tacR 1),
  15.453 +	(resolve_tac prems 1),
  15.454 +	(simp_tac HOLCF_ss 1),
  15.455 +	(resolve_tac prems 1),
  15.456 +	(strip_tac 1),
  15.457 +	(res_inst_tac [("n","xa")] dnatE 1),
  15.458 +	(asm_simp_tac (HOLCF_ss addsimps dnat_copy) 1),
  15.459 +	(resolve_tac prems 1),
  15.460 +	(asm_simp_tac (HOLCF_ss addsimps dnat_copy) 1),
  15.461 +	(resolve_tac prems 1),
  15.462 +	(asm_simp_tac (HOLCF_ss addsimps dnat_copy) 1),
  15.463 +	(res_inst_tac [("Q","x[xb]=UU")] classical2 1),
  15.464 +	(asm_simp_tac (HOLCF_ss addsimps dnat_rews) 1),
  15.465 +	(resolve_tac prems 1),
  15.466 +	(eresolve_tac prems 1),
  15.467 +	(etac spec 1)
  15.468 +	]);
  15.469 +
  15.470 +val dnat_ind2 = dnat_flat RS adm_flat RS dnat_ind;
  15.471 +(*  "[| ?P(UU); ?P(dzero);
  15.472 +    !!s1. [| s1 ~= UU; ?P(s1) |] ==> ?P(dsucc[s1]) |] ==> ?P(?s)" : thm
  15.473 +*)
  15.474 +
    16.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    16.2 +++ b/src/HOLCF/Dnat.thy	Wed Jan 19 17:35:01 1994 +0100
    16.3 @@ -0,0 +1,101 @@
    16.4 +(*  Title: 	HOLCF/dnat.thy
    16.5 +    ID:         $Id$
    16.6 +    Author: 	Franz Regensburger
    16.7 +    Copyright   1993 Technische Universitaet Muenchen
    16.8 +
    16.9 +Theory for the domain of natural numbers
   16.10 +
   16.11 +*)
   16.12 +
   16.13 +Dnat = HOLCF +
   16.14 +
   16.15 +types dnat 0
   16.16 +
   16.17 +(* ----------------------------------------------------------------------- *)
   16.18 +(* arrity axiom is valuated by semantical reasoning                        *)
   16.19 +
   16.20 +arities dnat::pcpo
   16.21 +
   16.22 +consts
   16.23 +
   16.24 +(* ----------------------------------------------------------------------- *)
   16.25 +(* essential constants                                                     *)
   16.26 +
   16.27 +dnat_rep	:: " dnat -> (one ++ dnat)"
   16.28 +dnat_abs	:: "(one ++ dnat) -> dnat"
   16.29 +
   16.30 +(* ----------------------------------------------------------------------- *)
   16.31 +(* abstract constants and auxiliary constants                              *)
   16.32 +
   16.33 +dnat_copy	:: "(dnat -> dnat) -> dnat -> dnat"
   16.34 +
   16.35 +dzero		:: "dnat"
   16.36 +dsucc		:: "dnat -> dnat"
   16.37 +dnat_when	:: "'b -> (dnat -> 'b) -> dnat -> 'b"
   16.38 +is_dzero	:: "dnat -> tr"
   16.39 +is_dsucc	:: "dnat -> tr"
   16.40 +dpred		:: "dnat -> dnat"
   16.41 +dnat_take	:: "nat => dnat -> dnat"
   16.42 +dnat_bisim	:: "(dnat => dnat => bool) => bool"
   16.43 +
   16.44 +rules
   16.45 +
   16.46 +(* ----------------------------------------------------------------------- *)
   16.47 +(* axiomatization of recursive type dnat                                   *)
   16.48 +(* ----------------------------------------------------------------------- *)
   16.49 +(* (dnat,dnat_abs) is the initial F-algebra where                          *)
   16.50 +(* F is the locally continuous functor determined by domain equation       *)
   16.51 +(* X = one ++ X                                                            *)
   16.52 +(* ----------------------------------------------------------------------- *)
   16.53 +(* dnat_abs is an isomorphism with inverse dnat_rep                        *)
   16.54 +(* identity is the least endomorphism on dnat                              *)
   16.55 +
   16.56 +dnat_abs_iso	"dnat_rep[dnat_abs[x]] = x"
   16.57 +dnat_rep_iso	"dnat_abs[dnat_rep[x]] = x"
   16.58 +dnat_copy_def	"dnat_copy == (LAM f. dnat_abs oo \
   16.59 +\		 (when[sinl][sinr oo f]) oo dnat_rep )"
   16.60 +dnat_reach	"(fix[dnat_copy])[x]=x"
   16.61 +
   16.62 +(* ----------------------------------------------------------------------- *)
   16.63 +(* properties of additional constants                                      *)
   16.64 +(* ----------------------------------------------------------------------- *)
   16.65 +(* constructors                                                            *)
   16.66 +
   16.67 +dzero_def	"dzero == dnat_abs[sinl[one]]"
   16.68 +dsucc_def	"dsucc == (LAM n. dnat_abs[sinr[n]])"
   16.69 +
   16.70 +(* ----------------------------------------------------------------------- *)
   16.71 +(* discriminator functional                                                *)
   16.72 +
   16.73 +dnat_when_def	"dnat_when == (LAM f1 f2 n.when[LAM x.f1][f2][dnat_rep[n]])"
   16.74 +
   16.75 +
   16.76 +(* ----------------------------------------------------------------------- *)
   16.77 +(* discriminators and selectors                                            *)
   16.78 +
   16.79 +is_dzero_def	"is_dzero == dnat_when[TT][LAM x.FF]"
   16.80 +is_dsucc_def	"is_dsucc == dnat_when[FF][LAM x.TT]"
   16.81 +dpred_def	"dpred == dnat_when[UU][LAM x.x]"
   16.82 +
   16.83 +
   16.84 +(* ----------------------------------------------------------------------- *)
   16.85 +(* the taker for dnats                                                   *)
   16.86 +
   16.87 +dnat_take_def "dnat_take == (%n.iterate(n,dnat_copy,UU))"
   16.88 +
   16.89 +(* ----------------------------------------------------------------------- *)
   16.90 +(* definition of bisimulation is determined by domain equation             *)
   16.91 +(* simplification and rewriting for abstract constants yields def below    *)
   16.92 +
   16.93 +dnat_bisim_def "dnat_bisim ==\
   16.94 +\(%R.!s1 s2.\
   16.95 +\ 	R(s1,s2) -->\
   16.96 +\  ((s1=UU & s2=UU) |(s1=dzero & s2=dzero) |\
   16.97 +\  (? s11 s21. s11~=UU & s21~=UU & s1=dsucc[s11] &\
   16.98 +\		 s2 = dsucc[s21] & R(s11,s21))))"
   16.99 +
  16.100 +end
  16.101 +
  16.102 +
  16.103 +
  16.104 +
    17.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    17.2 +++ b/src/HOLCF/Dnat2.ML	Wed Jan 19 17:35:01 1994 +0100
    17.3 @@ -0,0 +1,52 @@
    17.4 +(*  Title: 	HOLCF/dnat2.ML
    17.5 +    ID:         $Id$
    17.6 +    Author: 	Franz Regensburger
    17.7 +    Copyright   1993 Technische Universitaet Muenchen
    17.8 +
    17.9 +Lemmas for theory Dnat2.thy
   17.10 +*)
   17.11 +
   17.12 +open Dnat2;
   17.13 +
   17.14 +
   17.15 +(* ------------------------------------------------------------------------- *)
   17.16 +(* expand fixed point properties                                             *)
   17.17 +(* ------------------------------------------------------------------------- *)
   17.18 +
   17.19 +val iterator_def2 = fix_prover Dnat2.thy iterator_def 
   17.20 +	"iterator = (LAM n f x. dnat_when[x][LAM m.f[iterator[m][f][x]]][n])";
   17.21 +
   17.22 +(* ------------------------------------------------------------------------- *)
   17.23 +(* recursive  properties                                                     *)
   17.24 +(* ------------------------------------------------------------------------- *)
   17.25 +
   17.26 +val iterator1 = prove_goal Dnat2.thy "iterator[UU][f][x] = UU"
   17.27 + (fn prems =>
   17.28 +	[
   17.29 +	(rtac (iterator_def2 RS ssubst) 1),
   17.30 +	(simp_tac (HOLCF_ss addsimps dnat_when) 1)
   17.31 +	]);
   17.32 +
   17.33 +val iterator2 = prove_goal Dnat2.thy "iterator[dzero][f][x] = x"
   17.34 + (fn prems =>
   17.35 +	[
   17.36 +	(rtac (iterator_def2 RS ssubst) 1),
   17.37 +	(simp_tac (HOLCF_ss addsimps dnat_when) 1)
   17.38 +	]);
   17.39 +
   17.40 +val iterator3 = prove_goal Dnat2.thy 
   17.41 +"n~=UU ==> iterator[dsucc[n]][f][x] = f[iterator[n][f][x]]"
   17.42 + (fn prems =>
   17.43 +	[
   17.44 +	(cut_facts_tac prems 1),
   17.45 +	(rtac trans 1),
   17.46 +	(rtac (iterator_def2 RS ssubst) 1),
   17.47 +	(asm_simp_tac (HOLCF_ss addsimps dnat_rews) 1),
   17.48 +	(rtac refl 1)
   17.49 +	]);
   17.50 +
   17.51 +val dnat2_rews = 
   17.52 +	[iterator1, iterator2, iterator3];
   17.53 +
   17.54 +
   17.55 +
    18.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    18.2 +++ b/src/HOLCF/Dnat2.thy	Wed Jan 19 17:35:01 1994 +0100
    18.3 @@ -0,0 +1,32 @@
    18.4 +(*  Title: 	HOLCF/dnat2.thy
    18.5 +    ID:         $Id$
    18.6 +    Author: 	Franz Regensburger
    18.7 +    Copyright   1993 Technische Universitaet Muenchen
    18.8 +
    18.9 +Additional constants for dnat
   18.10 +
   18.11 +*)
   18.12 +
   18.13 +Dnat2 = Dnat +
   18.14 +
   18.15 +consts
   18.16 +
   18.17 +iterator	:: "dnat -> ('a -> 'a) -> 'a -> 'a"
   18.18 +
   18.19 +
   18.20 +rules
   18.21 +
   18.22 +iterator_def	"iterator = fix[LAM h n f x.\
   18.23 +\	dnat_when[x][LAM m.f[h[m][f][x]]][n]]"
   18.24 +
   18.25 +
   18.26 +end
   18.27 +
   18.28 +
   18.29 +(*
   18.30 +
   18.31 +		iterator[UU][f][x] = UU
   18.32 +		iterator[dzero][f][x] = x
   18.33 +      n~=UU --> iterator[dsucc[n]][f][x] = f[iterator[n][f][x]]
   18.34 +*)
   18.35 +
    19.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    19.2 +++ b/src/HOLCF/Fix.ML	Wed Jan 19 17:35:01 1994 +0100
    19.3 @@ -0,0 +1,1140 @@
    19.4 +(*  Title: 	HOLCF/fix.ML
    19.5 +    ID:         $Id$
    19.6 +    Author: 	Franz Regensburger
    19.7 +    Copyright   1993  Technische Universitaet Muenchen
    19.8 +
    19.9 +Lemmas for fix.thy 
   19.10 +*)
   19.11 +
   19.12 +open Fix;
   19.13 +
   19.14 +(* ------------------------------------------------------------------------ *)
   19.15 +(* derive inductive properties of iterate from primitive recursion          *)
   19.16 +(* ------------------------------------------------------------------------ *)
   19.17 +
   19.18 +val iterate_0 = prove_goal Fix.thy "iterate(0,F,x) = x"
   19.19 + (fn prems =>
   19.20 +	[
   19.21 +	(resolve_tac (nat_recs iterate_def) 1)
   19.22 +	]);
   19.23 +
   19.24 +val iterate_Suc = prove_goal Fix.thy "iterate(Suc(n),F,x) = F[iterate(n,F,x)]"
   19.25 + (fn prems =>
   19.26 +	[
   19.27 +	(resolve_tac (nat_recs iterate_def) 1)
   19.28 +	]);
   19.29 +
   19.30 +val iterate_ss = Cfun_ss addsimps [iterate_0,iterate_Suc];
   19.31 +
   19.32 +val iterate_Suc2 = prove_goal Fix.thy "iterate(Suc(n),F,x) = iterate(n,F,F[x])"
   19.33 + (fn prems =>
   19.34 +	[
   19.35 +	(nat_ind_tac "n" 1),
   19.36 +	(simp_tac iterate_ss 1),
   19.37 +	(asm_simp_tac iterate_ss 1)
   19.38 +	]);
   19.39 +
   19.40 +(* ------------------------------------------------------------------------ *)
   19.41 +(* the sequence of function itertaions is a chain                           *)
   19.42 +(* This property is essential since monotonicity of iterate makes no sense  *)
   19.43 +(* ------------------------------------------------------------------------ *)
   19.44 +
   19.45 +val is_chain_iterate2 = prove_goalw Fix.thy [is_chain] 
   19.46 +	" x << F[x] ==> is_chain(%i.iterate(i,F,x))"
   19.47 + (fn prems =>
   19.48 +	[
   19.49 +	(cut_facts_tac prems 1),
   19.50 +	(strip_tac 1),
   19.51 +	(simp_tac iterate_ss 1),
   19.52 +	(nat_ind_tac "i" 1),
   19.53 +	(asm_simp_tac iterate_ss 1),
   19.54 +	(asm_simp_tac iterate_ss 1),
   19.55 +	(etac monofun_cfun_arg 1)
   19.56 +	]);
   19.57 +
   19.58 +
   19.59 +val is_chain_iterate = prove_goal Fix.thy  
   19.60 +	"is_chain(%i.iterate(i,F,UU))"
   19.61 + (fn prems =>
   19.62 +	[
   19.63 +	(rtac is_chain_iterate2 1),
   19.64 +	(rtac minimal 1)
   19.65 +	]);
   19.66 +
   19.67 +
   19.68 +(* ------------------------------------------------------------------------ *)
   19.69 +(* Kleene's fixed point theorems for continuous functions in pointed        *)
   19.70 +(* omega cpo's                                                              *)
   19.71 +(* ------------------------------------------------------------------------ *)
   19.72 +
   19.73 +
   19.74 +val Ifix_eq = prove_goalw Fix.thy  [Ifix_def] "Ifix(F)=F[Ifix(F)]"
   19.75 + (fn prems =>
   19.76 +	[
   19.77 +	(rtac (contlub_cfun_arg RS ssubst) 1),
   19.78 +	(rtac is_chain_iterate 1),
   19.79 +	(rtac antisym_less 1),
   19.80 +	(rtac lub_mono 1),
   19.81 +	(rtac is_chain_iterate 1),
   19.82 +	(rtac ch2ch_fappR 1),
   19.83 +	(rtac is_chain_iterate 1),
   19.84 +	(rtac allI 1),
   19.85 +	(rtac (iterate_Suc RS subst) 1),
   19.86 +	(rtac (is_chain_iterate RS is_chainE RS spec) 1),
   19.87 +	(rtac is_lub_thelub 1),
   19.88 +	(rtac ch2ch_fappR 1),
   19.89 +	(rtac is_chain_iterate 1),
   19.90 +	(rtac ub_rangeI 1),
   19.91 +	(rtac allI 1),
   19.92 +	(rtac (iterate_Suc RS subst) 1),
   19.93 +	(rtac is_ub_thelub 1),
   19.94 +	(rtac is_chain_iterate 1)
   19.95 +	]);
   19.96 +
   19.97 +
   19.98 +val Ifix_least = prove_goalw Fix.thy [Ifix_def] "F[x]=x ==> Ifix(F) << x"
   19.99 + (fn prems =>
  19.100 +	[
  19.101 +	(cut_facts_tac prems 1),
  19.102 +	(rtac is_lub_thelub 1),
  19.103 +	(rtac is_chain_iterate 1),
  19.104 +	(rtac ub_rangeI 1),
  19.105 +	(strip_tac 1),
  19.106 +	(nat_ind_tac "i" 1),
  19.107 +	(asm_simp_tac iterate_ss 1),
  19.108 +	(asm_simp_tac iterate_ss 1),
  19.109 +	(res_inst_tac [("t","x")] subst 1),
  19.110 +	(atac 1),
  19.111 +	(etac monofun_cfun_arg 1)
  19.112 +	]);
  19.113 +
  19.114 +
  19.115 +(* ------------------------------------------------------------------------ *)
  19.116 +(* monotonicity and continuity of iterate                                   *)
  19.117 +(* ------------------------------------------------------------------------ *)
  19.118 +
  19.119 +val monofun_iterate = prove_goalw Fix.thy  [monofun] "monofun(iterate(i))"
  19.120 + (fn prems =>
  19.121 +	[
  19.122 +	(strip_tac 1),
  19.123 +	(nat_ind_tac "i" 1),
  19.124 +	(asm_simp_tac iterate_ss 1),
  19.125 +	(asm_simp_tac iterate_ss 1),
  19.126 +	(rtac (less_fun RS iffD2) 1),
  19.127 +	(rtac allI 1),
  19.128 +	(rtac monofun_cfun 1),
  19.129 +	(atac 1),
  19.130 +	(rtac (less_fun RS iffD1 RS spec) 1),
  19.131 +	(atac 1)
  19.132 +	]);
  19.133 +
  19.134 +(* ------------------------------------------------------------------------ *)
  19.135 +(* the following lemma uses contlub_cfun which itself is based on a         *)
  19.136 +(* diagonalisation lemma for continuous functions with two arguments.       *)
  19.137 +(* In this special case it is the application function fapp                 *)
  19.138 +(* ------------------------------------------------------------------------ *)
  19.139 +
  19.140 +val contlub_iterate = prove_goalw Fix.thy  [contlub] "contlub(iterate(i))"
  19.141 + (fn prems =>
  19.142 +	[
  19.143 +	(strip_tac 1),
  19.144 +	(nat_ind_tac "i" 1),
  19.145 +	(asm_simp_tac iterate_ss 1),
  19.146 +	(rtac (lub_const RS thelubI RS sym) 1),
  19.147 +	(asm_simp_tac iterate_ss 1),
  19.148 +	(rtac ext 1),
  19.149 +	(rtac (thelub_fun RS ssubst) 1),
  19.150 +	(rtac is_chainI 1),
  19.151 +	(rtac allI 1),
  19.152 +	(rtac (less_fun RS iffD2) 1),
  19.153 +	(rtac allI 1),
  19.154 +	(rtac (is_chainE RS spec) 1),
  19.155 +	(rtac (monofun_fapp1 RS ch2ch_MF2LR) 1),
  19.156 +	(rtac allI 1),
  19.157 +	(rtac monofun_fapp2 1),
  19.158 +	(atac 1),
  19.159 +	(rtac ch2ch_fun 1),
  19.160 +	(rtac (monofun_iterate RS ch2ch_monofun) 1),
  19.161 +	(atac 1),
  19.162 +	(rtac (thelub_fun RS ssubst) 1),
  19.163 +	(rtac (monofun_iterate RS ch2ch_monofun) 1),
  19.164 +	(atac 1),
  19.165 +	(rtac contlub_cfun  1),
  19.166 +	(atac 1),
  19.167 +	(etac (monofun_iterate RS ch2ch_monofun RS ch2ch_fun) 1)
  19.168 +	]);
  19.169 +
  19.170 +
  19.171 +val contX_iterate = prove_goal Fix.thy "contX(iterate(i))"
  19.172 + (fn prems =>
  19.173 +	[
  19.174 +	(rtac monocontlub2contX 1),
  19.175 +	(rtac monofun_iterate 1),
  19.176 +	(rtac contlub_iterate 1)
  19.177 +	]);
  19.178 +
  19.179 +(* ------------------------------------------------------------------------ *)
  19.180 +(* a lemma about continuity of iterate in its third argument                *)
  19.181 +(* ------------------------------------------------------------------------ *)
  19.182 +
  19.183 +val monofun_iterate2 = prove_goal Fix.thy "monofun(iterate(n,F))"
  19.184 + (fn prems =>
  19.185 +	[
  19.186 +	(rtac monofunI 1),
  19.187 +	(strip_tac 1),
  19.188 +	(nat_ind_tac "n" 1),
  19.189 +	(asm_simp_tac iterate_ss 1),
  19.190 +	(asm_simp_tac iterate_ss 1),
  19.191 +	(etac monofun_cfun_arg 1)
  19.192 +	]);
  19.193 +
  19.194 +val contlub_iterate2 = prove_goal Fix.thy "contlub(iterate(n,F))"
  19.195 + (fn prems =>
  19.196 +	[
  19.197 +	(rtac contlubI 1),
  19.198 +	(strip_tac 1),
  19.199 +	(nat_ind_tac "n" 1),
  19.200 +	(simp_tac iterate_ss 1),
  19.201 +	(simp_tac iterate_ss 1),
  19.202 +	(res_inst_tac [("t","iterate(n1, F, lub(range(%u. Y(u))))"),
  19.203 +	("s","lub(range(%i. iterate(n1, F, Y(i))))")] ssubst 1),
  19.204 +	(atac 1),
  19.205 +	(rtac contlub_cfun_arg 1),
  19.206 +	(etac (monofun_iterate2 RS ch2ch_monofun) 1)
  19.207 +	]);
  19.208 +
  19.209 +val contX_iterate2 = prove_goal Fix.thy "contX(iterate(n,F))"
  19.210 + (fn prems =>
  19.211 +	[
  19.212 +	(rtac monocontlub2contX 1),
  19.213 +	(rtac monofun_iterate2 1),
  19.214 +	(rtac contlub_iterate2 1)
  19.215 +	]);
  19.216 +
  19.217 +(* ------------------------------------------------------------------------ *)
  19.218 +(* monotonicity and continuity of Ifix                                      *)
  19.219 +(* ------------------------------------------------------------------------ *)
  19.220 +
  19.221 +val monofun_Ifix = prove_goalw Fix.thy  [monofun,Ifix_def] "monofun(Ifix)"
  19.222 + (fn prems =>
  19.223 +	[
  19.224 +	(strip_tac 1),
  19.225 +	(rtac lub_mono 1),
  19.226 +	(rtac is_chain_iterate 1),
  19.227 +	(rtac is_chain_iterate 1),
  19.228 +	(rtac allI 1),
  19.229 +	(rtac (less_fun RS iffD1 RS spec) 1),
  19.230 +	(etac (monofun_iterate RS monofunE RS spec RS spec RS mp) 1)
  19.231 +	]);
  19.232 +
  19.233 +
  19.234 +(* ------------------------------------------------------------------------ *)
  19.235 +(* since iterate is not monotone in its first argument, special lemmas must *)
  19.236 +(* be derived for lubs in this argument                                     *)
  19.237 +(* ------------------------------------------------------------------------ *)
  19.238 +
  19.239 +val is_chain_iterate_lub = prove_goal Fix.thy   
  19.240 +"is_chain(Y) ==> is_chain(%i. lub(range(%ia. iterate(ia,Y(i),UU))))"
  19.241 + (fn prems =>
  19.242 +	[
  19.243 +	(cut_facts_tac prems 1),
  19.244 +	(rtac is_chainI 1),
  19.245 +	(strip_tac 1),
  19.246 +	(rtac lub_mono 1),
  19.247 +	(rtac is_chain_iterate 1),
  19.248 +	(rtac is_chain_iterate 1),
  19.249 +	(strip_tac 1),
  19.250 +	(etac (monofun_iterate RS ch2ch_monofun RS ch2ch_fun RS is_chainE 
  19.251 +         RS spec) 1)
  19.252 +	]);
  19.253 +
  19.254 +(* ------------------------------------------------------------------------ *)
  19.255 +(* this exchange lemma is analog to the one for monotone functions          *)
  19.256 +(* observe that monotonicity is not really needed. The propagation of       *)
  19.257 +(* chains is the essential argument which is usually derived from monot.    *)
  19.258 +(* ------------------------------------------------------------------------ *)
  19.259 +
  19.260 +val contlub_Ifix_lemma1 = prove_goal Fix.thy 
  19.261 +"is_chain(Y) ==> iterate(n,lub(range(Y)),y) = lub(range(%i. iterate(n,Y(i),y)))"
  19.262 + (fn prems =>
  19.263 +	[
  19.264 +	(cut_facts_tac prems 1),
  19.265 +	(rtac (thelub_fun RS subst) 1),
  19.266 +	(rtac (monofun_iterate RS ch2ch_monofun) 1),
  19.267 +	(atac 1),
  19.268 +	(rtac fun_cong 1),
  19.269 +	(rtac (contlub_iterate RS contlubE RS spec RS mp RS ssubst) 1),
  19.270 +	(atac 1),
  19.271 +	(rtac refl 1)
  19.272 +	]);
  19.273 +
  19.274 +
  19.275 +val ex_lub_iterate = prove_goal Fix.thy  "is_chain(Y) ==>\
  19.276 +\         lub(range(%i. lub(range(%ia. iterate(i,Y(ia),UU))))) =\
  19.277 +\         lub(range(%i. lub(range(%ia. iterate(ia,Y(i),UU)))))"
  19.278 + (fn prems =>
  19.279 +	[
  19.280 +	(cut_facts_tac prems 1),
  19.281 +	(rtac antisym_less 1),
  19.282 +	(rtac is_lub_thelub 1),
  19.283 +	(rtac (contlub_Ifix_lemma1 RS ext RS subst) 1),
  19.284 +	(atac 1),
  19.285 +	(rtac is_chain_iterate 1),
  19.286 +	(rtac ub_rangeI 1),
  19.287 +	(strip_tac 1),
  19.288 +	(rtac lub_mono 1),
  19.289 +	(etac (monofun_iterate RS ch2ch_monofun RS ch2ch_fun) 1),
  19.290 +	(etac is_chain_iterate_lub 1),
  19.291 +	(strip_tac 1),
  19.292 +	(rtac is_ub_thelub 1),
  19.293 +	(rtac is_chain_iterate 1),
  19.294 +	(rtac is_lub_thelub 1),
  19.295 +	(etac is_chain_iterate_lub 1),
  19.296 +	(rtac ub_rangeI 1),
  19.297 +	(strip_tac 1),
  19.298 +	(rtac lub_mono 1),
  19.299 +	(rtac is_chain_iterate 1),
  19.300 +	(rtac (contlub_Ifix_lemma1 RS ext RS subst) 1),
  19.301 +	(atac 1),
  19.302 +	(rtac is_chain_iterate 1),
  19.303 +	(strip_tac 1),
  19.304 +	(rtac is_ub_thelub 1),
  19.305 +	(etac (monofun_iterate RS ch2ch_monofun RS ch2ch_fun) 1)
  19.306 +	]);
  19.307 +
  19.308 +
  19.309 +val contlub_Ifix = prove_goalw Fix.thy  [contlub,Ifix_def] "contlub(Ifix)"
  19.310 + (fn prems =>
  19.311 +	[
  19.312 +	(strip_tac 1),
  19.313 +	(rtac (contlub_Ifix_lemma1 RS ext RS ssubst) 1),
  19.314 +	(atac 1),
  19.315 +	(etac ex_lub_iterate 1)
  19.316 +	]);
  19.317 +
  19.318 +
  19.319 +val contX_Ifix = prove_goal Fix.thy "contX(Ifix)"
  19.320 + (fn prems =>
  19.321 +	[
  19.322 +	(rtac monocontlub2contX 1),
  19.323 +	(rtac monofun_Ifix 1),
  19.324 +	(rtac contlub_Ifix 1)
  19.325 +	]);
  19.326 +
  19.327 +(* ------------------------------------------------------------------------ *)
  19.328 +(* propagate properties of Ifix to its continuous counterpart               *)
  19.329 +(* ------------------------------------------------------------------------ *)
  19.330 +
  19.331 +val fix_eq = prove_goalw Fix.thy  [fix_def] "fix[F]=F[fix[F]]"
  19.332 + (fn prems =>
  19.333 +	[
  19.334 +	(asm_simp_tac (Cfun_ss addsimps [contX_Ifix]) 1),
  19.335 +	(rtac Ifix_eq 1)
  19.336 +	]);
  19.337 +
  19.338 +val fix_least = prove_goalw Fix.thy [fix_def] "F[x]=x ==> fix[F] << x"
  19.339 + (fn prems =>
  19.340 +	[
  19.341 +	(cut_facts_tac prems 1),
  19.342 +	(asm_simp_tac (Cfun_ss addsimps [contX_Ifix]) 1),
  19.343 +	(etac Ifix_least 1)
  19.344 +	]);
  19.345 +
  19.346 +
  19.347 +val fix_eq2 = prove_goal Fix.thy "f == fix[F] ==> f = F[f]"
  19.348 + (fn prems =>
  19.349 +	[
  19.350 +	(rewrite_goals_tac prems),
  19.351 +	(rtac fix_eq 1)
  19.352 +	]);
  19.353 +
  19.354 +val fix_eq3 = prove_goal Fix.thy "f == fix[F] ==> f[x] = F[f][x]"
  19.355 + (fn prems =>
  19.356 +	[
  19.357 +	(rtac trans 1),
  19.358 +	(rtac ((hd prems) RS fix_eq2 RS cfun_fun_cong) 1),
  19.359 +	(rtac refl 1)
  19.360 +	]);
  19.361 +
  19.362 +fun fix_tac3 thm i  = ((rtac trans i) THEN (rtac (thm RS fix_eq3) i)); 
  19.363 +
  19.364 +val fix_eq4 = prove_goal Fix.thy "f = fix[F] ==> f = F[f]"
  19.365 + (fn prems =>
  19.366 +	[
  19.367 +	(cut_facts_tac prems 1),
  19.368 +	(hyp_subst_tac 1),
  19.369 +	(rtac fix_eq 1)
  19.370 +	]);
  19.371 +
  19.372 +val fix_eq5 = prove_goal Fix.thy "f = fix[F] ==> f[x] = F[f][x]"
  19.373 + (fn prems =>
  19.374 +	[
  19.375 +	(rtac trans 1),
  19.376 +	(rtac ((hd prems) RS fix_eq4 RS cfun_fun_cong) 1),
  19.377 +	(rtac refl 1)
  19.378 +	]);
  19.379 +
  19.380 +fun fix_tac5 thm i  = ((rtac trans i) THEN (rtac (thm RS fix_eq5) i)); 
  19.381 +
  19.382 +fun fix_prover thy fixdef thm = prove_goal thy thm
  19.383 + (fn prems =>
  19.384 +        [
  19.385 +        (rtac trans 1),
  19.386 +        (rtac (fixdef RS fix_eq4) 1),
  19.387 +        (rtac trans 1),
  19.388 +        (rtac beta_cfun 1),
  19.389 +        (contX_tacR 1),
  19.390 +        (rtac refl 1)
  19.391 +        ]);
  19.392 +
  19.393 +
  19.394 +(* ------------------------------------------------------------------------ *)
  19.395 +(* better access to definitions                                             *)
  19.396 +(* ------------------------------------------------------------------------ *)
  19.397 +
  19.398 +
  19.399 +val Ifix_def2 = prove_goal Fix.thy "Ifix=(%x. lub(range(%i. iterate(i,x,UU))))"
  19.400 + (fn prems =>
  19.401 +	[
  19.402 +	(rtac ext 1),
  19.403 +	(rewrite_goals_tac [Ifix_def]),
  19.404 +	(rtac refl 1)
  19.405 +	]);
  19.406 +
  19.407 +(* ------------------------------------------------------------------------ *)
  19.408 +(* direct connection between fix and iteration without Ifix                 *)
  19.409 +(* ------------------------------------------------------------------------ *)
  19.410 +
  19.411 +val fix_def2 = prove_goalw Fix.thy [fix_def]
  19.412 + "fix[F] = lub(range(%i. iterate(i,F,UU)))"
  19.413 + (fn prems =>
  19.414 +	[
  19.415 +	(fold_goals_tac [Ifix_def]),
  19.416 +	(asm_simp_tac (Cfun_ss addsimps [contX_Ifix]) 1)
  19.417 +	]);
  19.418 +
  19.419 +
  19.420 +(* ------------------------------------------------------------------------ *)
  19.421 +(* Lemmas about admissibility and fixed point induction                     *)
  19.422 +(* ------------------------------------------------------------------------ *)
  19.423 +
  19.424 +(* ------------------------------------------------------------------------ *)
  19.425 +(* access to definitions                                                    *)
  19.426 +(* ------------------------------------------------------------------------ *)
  19.427 +
  19.428 +val adm_def2 = prove_goalw Fix.thy [adm_def]
  19.429 +	"adm(P) = (!Y. is_chain(Y) --> (!i.P(Y(i))) --> P(lub(range(Y))))"
  19.430 + (fn prems =>
  19.431 +	[
  19.432 +	(rtac refl 1)
  19.433 +	]);
  19.434 +
  19.435 +val admw_def2 = prove_goalw Fix.thy [admw_def]
  19.436 +	"admw(P) = (!F.((!n.P(iterate(n,F,UU)))-->\
  19.437 +\			 P(lub(range(%i.iterate(i,F,UU))))))"
  19.438 + (fn prems =>
  19.439 +	[
  19.440 +	(rtac refl 1)
  19.441 +	]);
  19.442 +
  19.443 +(* ------------------------------------------------------------------------ *)
  19.444 +(* an admissible formula is also weak admissible                            *)
  19.445 +(* ------------------------------------------------------------------------ *)
  19.446 +
  19.447 +val adm_impl_admw = prove_goalw  Fix.thy [admw_def] "adm(P)==>admw(P)"
  19.448 + (fn prems =>
  19.449 +	[
  19.450 +	(cut_facts_tac prems 1),
  19.451 +	(strip_tac 1),
  19.452 +	(rtac (adm_def2 RS iffD1 RS spec RS mp RS mp) 1),
  19.453 +	(atac 1),
  19.454 +	(rtac is_chain_iterate 1),
  19.455 +	(atac 1)
  19.456 +	]);
  19.457 +
  19.458 +(* ------------------------------------------------------------------------ *)
  19.459 +(* fixed point induction                                                    *)
  19.460 +(* ------------------------------------------------------------------------ *)
  19.461 +
  19.462 +val fix_ind = prove_goal  Fix.thy  
  19.463 +"[| adm(P);P(UU);!!x. P(x) ==> P(F[x])|] ==> P(fix[F])"
  19.464 + (fn prems =>
  19.465 +	[
  19.466 +	(cut_facts_tac prems 1),
  19.467 +	(rtac (fix_def2 RS ssubst) 1),
  19.468 +	(rtac (adm_def2 RS iffD1 RS spec RS mp RS mp) 1),
  19.469 +	(atac 1),
  19.470 +	(rtac is_chain_iterate 1),
  19.471 +	(rtac allI 1),
  19.472 +	(nat_ind_tac "i" 1),
  19.473 +	(rtac (iterate_0 RS ssubst) 1),
  19.474 +	(atac 1),
  19.475 +	(rtac (iterate_Suc RS ssubst) 1),
  19.476 +	(resolve_tac prems 1),
  19.477 +	(atac 1)
  19.478 +	]);
  19.479 +
  19.480 +(* ------------------------------------------------------------------------ *)
  19.481 +(* computational induction for weak admissible formulae                     *)
  19.482 +(* ------------------------------------------------------------------------ *)
  19.483 +
  19.484 +val wfix_ind = prove_goal  Fix.thy  
  19.485 +"[| admw(P); !n. P(iterate(n,F,UU))|] ==> P(fix[F])"
  19.486 + (fn prems =>
  19.487 +	[
  19.488 +	(cut_facts_tac prems 1),
  19.489 +	(rtac (fix_def2 RS ssubst) 1),
  19.490 +	(rtac (admw_def2 RS iffD1 RS spec RS mp) 1),
  19.491 +	(atac 1),
  19.492 +	(rtac allI 1),
  19.493 +	(etac spec 1)
  19.494 +	]);
  19.495 +
  19.496 +(* ------------------------------------------------------------------------ *)
  19.497 +(* for chain-finite (easy) types every formula is admissible                *)
  19.498 +(* ------------------------------------------------------------------------ *)
  19.499 +
  19.500 +val adm_max_in_chain = prove_goalw  Fix.thy  [adm_def]
  19.501 +"!Y. is_chain(Y::nat=>'a) --> (? n.max_in_chain(n,Y)) ==> adm(P::'a=>bool)"
  19.502 + (fn prems =>
  19.503 +	[
  19.504 +	(cut_facts_tac prems 1),
  19.505 +	(strip_tac 1),
  19.506 +	(rtac exE 1),
  19.507 +	(rtac mp 1),
  19.508 +	(etac spec 1),
  19.509 +	(atac 1),
  19.510 +	(rtac (lub_finch1 RS thelubI RS ssubst) 1),
  19.511 +	(atac 1),
  19.512 +	(atac 1),
  19.513 +	(etac spec 1)
  19.514 +	]);
  19.515 +
  19.516 +
  19.517 +val adm_chain_finite = prove_goalw  Fix.thy  [chain_finite_def]
  19.518 +	"chain_finite(x::'a) ==> adm(P::'a=>bool)"
  19.519 + (fn prems =>
  19.520 +	[
  19.521 +	(cut_facts_tac prems 1),
  19.522 +	(etac adm_max_in_chain 1)
  19.523 +	]);
  19.524 +
  19.525 +(* ------------------------------------------------------------------------ *)
  19.526 +(* flat types are chain_finite                                              *)
  19.527 +(* ------------------------------------------------------------------------ *)
  19.528 +
  19.529 +val flat_imp_chain_finite = prove_goalw  Fix.thy  [flat_def,chain_finite_def]
  19.530 +	"flat(x::'a)==>chain_finite(x::'a)"
  19.531 + (fn prems =>
  19.532 +	[
  19.533 +	(rewrite_goals_tac [max_in_chain_def]),
  19.534 +	(cut_facts_tac prems 1),
  19.535 +	(strip_tac 1),
  19.536 +	(res_inst_tac [("Q","!i.Y(i)=UU")] classical2 1),
  19.537 +	(res_inst_tac [("x","0")] exI 1),
  19.538 +	(strip_tac 1),
  19.539 +	(rtac trans 1),
  19.540 +	(etac spec 1),
  19.541 +	(rtac sym 1),
  19.542 +	(etac spec 1),
  19.543 +	(rtac (chain_mono2 RS exE) 1),
  19.544 +	(fast_tac HOL_cs 1),
  19.545 +	(atac 1),
  19.546 +	(res_inst_tac [("x","Suc(x)")] exI 1),
  19.547 +	(strip_tac 1),
  19.548 +	(rtac disjE 1),
  19.549 +	(atac 3),
  19.550 +	(rtac mp 1),
  19.551 +	(dtac spec 1),
  19.552 +	(etac spec 1),
  19.553 +	(etac (le_imp_less_or_eq RS disjE) 1),
  19.554 +	(etac (chain_mono RS mp) 1),
  19.555 +	(atac 1),
  19.556 +	(hyp_subst_tac 1),
  19.557 +	(rtac refl_less 1),
  19.558 +	(res_inst_tac [("P","Y(Suc(x)) = UU")] notE 1),
  19.559 +	(atac 2),
  19.560 +	(rtac mp 1),
  19.561 +	(etac spec 1),
  19.562 +	(asm_simp_tac nat_ss 1)
  19.563 +	]);
  19.564 +
  19.565 +
  19.566 +val adm_flat = flat_imp_chain_finite RS adm_chain_finite;
  19.567 +(* flat(?x::?'a) ==> adm(?P::?'a => bool) *)
  19.568 +
  19.569 +val flat_void = prove_goalw Fix.thy [flat_def] "flat(UU::void)"
  19.570 + (fn prems =>
  19.571 +	[
  19.572 +	(strip_tac 1),
  19.573 +	(rtac disjI1 1),
  19.574 +	(rtac unique_void2 1)
  19.575 +	]);
  19.576 +
  19.577 +(* ------------------------------------------------------------------------ *)
  19.578 +(* continuous isomorphisms are strict                                       *)
  19.579 +(* a prove for embedding projection pairs is similar                        *)
  19.580 +(* ------------------------------------------------------------------------ *)
  19.581 +
  19.582 +val iso_strict = prove_goal  Fix.thy  
  19.583 +"!!f g.[|!y.f[g[y]]=(y::'b) ; !x.g[f[x]]=(x::'a) |] \
  19.584 +\ ==> f[UU]=UU & g[UU]=UU"
  19.585 + (fn prems =>
  19.586 +	[
  19.587 +	(rtac conjI 1),
  19.588 +	(rtac UU_I 1),
  19.589 +	(res_inst_tac [("s","f[g[UU::'b]]"),("t","UU::'b")] subst 1),
  19.590 +	(etac spec 1),
  19.591 +	(rtac (minimal RS monofun_cfun_arg) 1),
  19.592 +	(rtac UU_I 1),
  19.593 +	(res_inst_tac [("s","g[f[UU::'a]]"),("t","UU::'a")] subst 1),
  19.594 +	(etac spec 1),
  19.595 +	(rtac (minimal RS monofun_cfun_arg) 1)
  19.596 +	]);
  19.597 +
  19.598 +
  19.599 +val isorep_defined = prove_goal Fix.thy 
  19.600 +	"[|!x.rep[abs[x]]=x;!y.abs[rep[y]]=y;z~=UU|] ==> rep[z]~=UU"
  19.601 + (fn prems =>
  19.602 +	[
  19.603 +	(cut_facts_tac prems 1),
  19.604 +	(etac swap 1),
  19.605 +	(dtac notnotD 1),
  19.606 +	(dres_inst_tac [("f","abs")] cfun_arg_cong 1),
  19.607 +	(etac box_equals 1),
  19.608 +	(fast_tac HOL_cs 1),
  19.609 +	(etac (iso_strict RS conjunct1) 1),
  19.610 +	(atac 1)
  19.611 +	]);
  19.612 +
  19.613 +val isoabs_defined = prove_goal Fix.thy 
  19.614 +	"[|!x.rep[abs[x]]=x;!y.abs[rep[y]]=y;z~=UU|] ==> abs[z]~=UU"
  19.615 + (fn prems =>
  19.616 +	[
  19.617 +	(cut_facts_tac prems 1),
  19.618 +	(etac swap 1),
  19.619 +	(dtac notnotD 1),
  19.620 +	(dres_inst_tac [("f","rep")] cfun_arg_cong 1),
  19.621 +	(etac box_equals 1),
  19.622 +	(fast_tac HOL_cs 1),
  19.623 +	(etac (iso_strict RS conjunct2) 1),
  19.624 +	(atac 1)
  19.625 +	]);
  19.626 +
  19.627 +(* ------------------------------------------------------------------------ *)
  19.628 +(* propagation of flatness and chainfiniteness by continuous isomorphisms   *)
  19.629 +(* ------------------------------------------------------------------------ *)
  19.630 +
  19.631 +val chfin2chfin = prove_goalw  Fix.thy  [chain_finite_def]
  19.632 +"!!f g.[|chain_finite(x::'a); !y.f[g[y]]=(y::'b) ; !x.g[f[x]]=(x::'a) |] \
  19.633 +\ ==> chain_finite(y::'b)"
  19.634 + (fn prems =>
  19.635 +	[
  19.636 +	(rewrite_goals_tac [max_in_chain_def]),
  19.637 +	(strip_tac 1),
  19.638 +	(rtac exE 1),
  19.639 +	(res_inst_tac [("P","is_chain(%i.g[Y(i)])")] mp 1),
  19.640 +	(etac spec 1),
  19.641 +	(etac ch2ch_fappR 1),
  19.642 +	(rtac exI 1),
  19.643 +	(strip_tac 1),
  19.644 +	(res_inst_tac [("s","f[g[Y(x)]]"),("t","Y(x)")] subst 1),
  19.645 +	(etac spec 1),
  19.646 +	(res_inst_tac [("s","f[g[Y(j)]]"),("t","Y(j)")] subst 1),
  19.647 +	(etac spec 1),
  19.648 +	(rtac cfun_arg_cong 1),
  19.649 +	(rtac mp 1),
  19.650 +	(etac spec 1),
  19.651 +	(atac 1)
  19.652 +	]);
  19.653 +
  19.654 +val flat2flat = prove_goalw  Fix.thy  [flat_def]
  19.655 +"!!f g.[|flat(x::'a); !y.f[g[y]]=(y::'b) ; !x.g[f[x]]=(x::'a) |] \
  19.656 +\ ==> flat(y::'b)"
  19.657 + (fn prems =>
  19.658 +	[
  19.659 +	(strip_tac 1),
  19.660 +	(rtac disjE 1),
  19.661 +	(res_inst_tac [("P","g[x]<<g[y]")] mp 1),
  19.662 +	(etac monofun_cfun_arg 2),
  19.663 +	(dtac spec 1),
  19.664 +	(etac spec 1),
  19.665 +	(rtac disjI1 1),
  19.666 +	(rtac trans 1),
  19.667 +	(res_inst_tac [("s","f[g[x]]"),("t","x")] subst 1),
  19.668 +	(etac spec 1),
  19.669 +	(etac cfun_arg_cong 1),
  19.670 +	(rtac (iso_strict RS conjunct1) 1),
  19.671 +	(atac 1),
  19.672 +	(atac 1),
  19.673 +	(rtac disjI2 1),
  19.674 +	(res_inst_tac [("s","f[g[x]]"),("t","x")] subst 1),
  19.675 +	(etac spec 1),
  19.676 +	(res_inst_tac [("s","f[g[y]]"),("t","y")] subst 1),
  19.677 +	(etac spec 1),
  19.678 +	(etac cfun_arg_cong 1)
  19.679 +	]);
  19.680 +
  19.681 +(* ------------------------------------------------------------------------ *)
  19.682 +(* admissibility of special formulae and propagation                        *)
  19.683 +(* ------------------------------------------------------------------------ *)
  19.684 +
  19.685 +val adm_less = prove_goalw  Fix.thy [adm_def]
  19.686 +	"[|contX(u);contX(v)|]==> adm(%x.u(x)<<v(x))"
  19.687 + (fn prems =>
  19.688 +	[
  19.689 +	(cut_facts_tac prems 1),
  19.690 +	(strip_tac 1),
  19.691 +	(etac (contX2contlub RS contlubE RS spec RS mp RS ssubst) 1),
  19.692 +	(atac 1),
  19.693 +	(etac (contX2contlub RS contlubE RS spec RS mp RS ssubst) 1),
  19.694 +	(atac 1),
  19.695 +	(rtac lub_mono 1),
  19.696 +	(cut_facts_tac prems 1),
  19.697 +	(etac (contX2mono RS ch2ch_monofun) 1),
  19.698 +	(atac 1),
  19.699 +	(cut_facts_tac prems 1),
  19.700 +	(etac (contX2mono RS ch2ch_monofun) 1),
  19.701 +	(atac 1),
  19.702 +	(atac 1)
  19.703 +	]);
  19.704 +
  19.705 +val adm_conj = prove_goal  Fix.thy  
  19.706 +	"[| adm(P); adm(Q) |] ==> adm(%x.P(x)&Q(x))"
  19.707 + (fn prems =>
  19.708 +	[
  19.709 +	(cut_facts_tac prems 1),
  19.710 +	(rtac (adm_def2 RS iffD2) 1),
  19.711 +	(strip_tac 1),
  19.712 +	(rtac conjI 1),
  19.713 +	(rtac (adm_def2 RS iffD1 RS spec RS mp RS mp) 1),
  19.714 +	(atac 1),
  19.715 +	(atac 1),
  19.716 +	(fast_tac HOL_cs 1),
  19.717 +	(rtac (adm_def2 RS iffD1 RS spec RS mp RS mp) 1),
  19.718 +	(atac 1),
  19.719 +	(atac 1),
  19.720 +	(fast_tac HOL_cs 1)
  19.721 +	]);
  19.722 +
  19.723 +val adm_cong = prove_goal  Fix.thy  
  19.724 +	"(!x. P(x) = Q(x)) ==> adm(P)=adm(Q)"
  19.725 + (fn prems =>
  19.726 +	[
  19.727 +	(cut_facts_tac prems 1),
  19.728 +	(res_inst_tac [("s","P"),("t","Q")] subst 1),
  19.729 +	(rtac refl 2),
  19.730 +	(rtac ext 1),
  19.731 +	(etac spec 1)
  19.732 +	]);
  19.733 +
  19.734 +val adm_not_free = prove_goalw  Fix.thy [adm_def] "adm(%x.t)"
  19.735 + (fn prems =>
  19.736 +	[
  19.737 +	(fast_tac HOL_cs 1)
  19.738 +	]);
  19.739 +
  19.740 +val adm_not_less = prove_goalw  Fix.thy [adm_def]
  19.741 +	"contX(t) ==> adm(%x.~ t(x) << u)"
  19.742 + (fn prems =>
  19.743 +	[
  19.744 +	(cut_facts_tac prems 1),
  19.745 +	(strip_tac 1),
  19.746 +	(rtac contrapos 1),
  19.747 +	(etac spec 1),
  19.748 +	(rtac trans_less 1),
  19.749 +	(atac 2),
  19.750 +	(etac (contX2mono RS monofun_fun_arg) 1),
  19.751 +	(rtac is_ub_thelub 1),
  19.752 +	(atac 1)
  19.753 +	]);
  19.754 +
  19.755 +val adm_all = prove_goal  Fix.thy  
  19.756 +	" !y.adm(P(y)) ==> adm(%x.!y.P(y,x))"
  19.757 + (fn prems =>
  19.758 +	[
  19.759 +	(cut_facts_tac prems 1),
  19.760 +	(rtac (adm_def2 RS iffD2) 1),
  19.761 +	(strip_tac 1),
  19.762 +	(rtac (adm_def2 RS iffD1 RS spec RS mp RS mp) 1),
  19.763 +	(etac spec 1),
  19.764 +	(atac 1),
  19.765 +	(rtac allI 1),
  19.766 +	(dtac spec 1),
  19.767 +	(etac spec 1)
  19.768 +	]);
  19.769 +
  19.770 +val adm_subst = prove_goal  Fix.thy  
  19.771 +	"[|contX(t); adm(P)|] ==> adm(%x.P(t(x)))"
  19.772 + (fn prems =>
  19.773 +	[
  19.774 +	(cut_facts_tac prems 1),
  19.775 +	(rtac (adm_def2 RS iffD2) 1),
  19.776 +	(strip_tac 1),
  19.777 +	(rtac (contX2contlub RS contlubE RS spec RS mp RS ssubst) 1),
  19.778 +	(atac 1),
  19.779 +	(atac 1),
  19.780 +	(rtac (adm_def2 RS iffD1 RS spec RS mp RS mp) 1),
  19.781 +	(atac 1),
  19.782 +	(rtac (contX2mono RS ch2ch_monofun) 1),
  19.783 +	(atac 1),
  19.784 +	(atac 1),
  19.785 +	(atac 1)
  19.786 +	]);
  19.787 +
  19.788 +val adm_UU_not_less = prove_goal  Fix.thy "adm(%x.~ UU << t(x))"
  19.789 + (fn prems =>
  19.790 +	[
  19.791 +	(res_inst_tac [("P2","%x.False")] (adm_cong RS iffD1) 1),
  19.792 +	(asm_simp_tac Cfun_ss 1),
  19.793 +	(rtac adm_not_free 1)
  19.794 +	]);
  19.795 +
  19.796 +val adm_not_UU = prove_goalw  Fix.thy [adm_def] 
  19.797 +	"contX(t)==> adm(%x.~ t(x) = UU)"
  19.798 + (fn prems =>
  19.799 +	[
  19.800 +	(cut_facts_tac prems 1),
  19.801 +	(strip_tac 1),
  19.802 +	(rtac contrapos 1),
  19.803 +	(etac spec 1),
  19.804 +	(rtac (chain_UU_I RS spec) 1),
  19.805 +	(rtac (contX2mono RS ch2ch_monofun) 1),
  19.806 +	(atac 1),
  19.807 +	(atac 1),
  19.808 +	(rtac (contX2contlub RS contlubE RS spec RS mp RS subst) 1),
  19.809 +	(atac 1),
  19.810 +	(atac 1),
  19.811 +	(atac 1)
  19.812 +	]);
  19.813 +
  19.814 +val adm_eq = prove_goal  Fix.thy 
  19.815 +	"[|contX(u);contX(v)|]==> adm(%x.u(x)= v(x))"
  19.816 + (fn prems =>
  19.817 +	[
  19.818 +	(rtac (adm_cong RS iffD1) 1),
  19.819 +	(rtac allI 1),
  19.820 +	(rtac iffI 1),
  19.821 +	(rtac antisym_less 1),
  19.822 +	(rtac antisym_less_inverse 3),
  19.823 +	(atac 3),
  19.824 +	(etac conjunct1 1),
  19.825 +	(etac conjunct2 1),
  19.826 +	(rtac adm_conj 1),
  19.827 +	(rtac adm_less 1),
  19.828 +	(resolve_tac prems 1),
  19.829 +	(resolve_tac prems 1),
  19.830 +	(rtac adm_less 1),
  19.831 +	(resolve_tac prems 1),
  19.832 +	(resolve_tac prems 1)
  19.833 +	]);
  19.834 +
  19.835 +
  19.836 +(* ------------------------------------------------------------------------ *)
  19.837 +(* admissibility for disjunction is hard to prove. It takes 10 Lemmas       *)
  19.838 +(* ------------------------------------------------------------------------ *)
  19.839 +
  19.840 +val adm_disj_lemma1 = prove_goal  Pcpo.thy 
  19.841 +"[| is_chain(Y); !n.P(Y(n))|Q(Y(n))|]\
  19.842 +\ ==> (? i.!j. i<j --> Q(Y(j))) | (!i.? j.i<j & P(Y(j)))"
  19.843 + (fn prems =>
  19.844 +	[
  19.845 +	(cut_facts_tac prems 1),
  19.846 +	(fast_tac HOL_cs 1)
  19.847 +	]);
  19.848 +
  19.849 +val adm_disj_lemma2 = prove_goal  Fix.thy  
  19.850 +"[| adm(Q); ? X.is_chain(X) & (!n.Q(X(n))) &\
  19.851 +\   lub(range(Y))=lub(range(X))|] ==> Q(lub(range(Y)))"
  19.852 + (fn prems =>
  19.853 +	[
  19.854 +	(cut_facts_tac prems 1),
  19.855 +	(etac exE 1),
  19.856 +	(etac conjE 1),
  19.857 +	(etac conjE 1),
  19.858 +	(res_inst_tac [("s","lub(range(X))"),("t","lub(range(Y))")] ssubst 1),
  19.859 +	(atac 1),
  19.860 +	(rtac (adm_def2 RS iffD1 RS spec RS mp RS mp) 1),
  19.861 +	(atac 1),
  19.862 +	(atac 1),
  19.863 +	(atac 1)
  19.864 +	]);
  19.865 +
  19.866 +val adm_disj_lemma3 = prove_goal  Fix.thy
  19.867 +"[| is_chain(Y); ! j. i < j --> Q(Y(j)) |] ==>\
  19.868 +\         is_chain(%m. if(m < Suc(i),Y(Suc(i)),Y(m)))"
  19.869 + (fn prems =>
  19.870 +	[
  19.871 +	(cut_facts_tac prems 1),
  19.872 +	(rtac is_chainI 1),
  19.873 +	(rtac allI 1),
  19.874 +	(res_inst_tac [("m","i"),("n","ia")] nat_less_cases 1),
  19.875 +	(res_inst_tac [("s","False"),("t","ia < Suc(i)")] ssubst 1),
  19.876 +	(rtac iffI 1),
  19.877 +	(etac FalseE 2),
  19.878 +	(rtac notE 1),
  19.879 +	(rtac (not_less_eq RS iffD2) 1),
  19.880 +	(atac 1),
  19.881 +	(atac 1),
  19.882 +	(res_inst_tac [("s","False"),("t","Suc(ia) < Suc(i)")] ssubst 1),
  19.883 +	(asm_simp_tac nat_ss  1),
  19.884 +	(rtac iffI 1),
  19.885 +	(etac FalseE 2),
  19.886 +	(rtac notE 1),
  19.887 +	(etac (less_not_sym RS mp) 1),	
  19.888 +	(atac 1),
  19.889 +	(asm_simp_tac Cfun_ss  1),
  19.890 +	(etac (is_chainE RS spec) 1),
  19.891 +	(hyp_subst_tac 1),
  19.892 +	(asm_simp_tac nat_ss 1),
  19.893 +	(rtac refl_less 1),
  19.894 +	(asm_simp_tac nat_ss 1),
  19.895 +	(rtac refl_less 1)
  19.896 +	]);
  19.897 +
  19.898 +val adm_disj_lemma4 = prove_goal  Fix.thy
  19.899 +"[| ! j. i < j --> Q(Y(j)) |] ==>\
  19.900 +\	 ! n. Q(if(n < Suc(i),Y(Suc(i)),Y(n)))"
  19.901 + (fn prems =>
  19.902 +	[
  19.903 +	(cut_facts_tac prems 1),
  19.904 +	(rtac allI 1),
  19.905 +	(res_inst_tac [("m","n"),("n","Suc(i)")] nat_less_cases 1),
  19.906 +	(res_inst_tac[("s","Y(Suc(i))"),("t","if(n<Suc(i),Y(Suc(i)),Y(n))")]
  19.907 +		ssubst 1),
  19.908 +	(asm_simp_tac nat_ss 1),
  19.909 +	(etac allE 1),
  19.910 +	(rtac mp 1),
  19.911 +	(atac 1),
  19.912 +	(asm_simp_tac nat_ss 1),
  19.913 +	(res_inst_tac[("s","Y(n)"),("t","if(n<Suc(i),Y(Suc(i)),Y(n))")] 
  19.914 +		ssubst 1),
  19.915 +	(asm_simp_tac nat_ss 1),
  19.916 +	(hyp_subst_tac 1),
  19.917 +	(dtac spec 1),
  19.918 +	(rtac mp 1),
  19.919 +	(atac 1),
  19.920 +	(asm_simp_tac nat_ss 1),
  19.921 +	(res_inst_tac [("s","Y(n)"),("t","if(n < Suc(i),Y(Suc(i)),Y(n))")] 
  19.922 +		ssubst 1),
  19.923 +	(res_inst_tac [("s","False"),("t","n < Suc(i)")] ssubst 1),
  19.924 +	(rtac iffI 1),
  19.925 +	(etac FalseE 2),
  19.926 +	(rtac notE 1),
  19.927 +	(etac (less_not_sym RS mp) 1),	
  19.928 +	(atac 1),
  19.929 +	(asm_simp_tac nat_ss 1),
  19.930 +	(dtac spec 1),
  19.931 +	(rtac mp 1),
  19.932 +	(atac 1),
  19.933 +	(etac Suc_lessD 1)
  19.934 +	]);
  19.935 +
  19.936 +val adm_disj_lemma5 = prove_goal  Fix.thy
  19.937 +"[| is_chain(Y::nat=>'a); ! j. i < j --> Q(Y(j)) |] ==>\
  19.938 +\         lub(range(Y)) = lub(range(%m. if(m < Suc(i),Y(Suc(i)),Y(m))))"
  19.939 + (fn prems =>
  19.940 +	[
  19.941 +	(cut_facts_tac prems 1),
  19.942 +	(rtac lub_equal2 1),
  19.943 +	(atac 2),
  19.944 +	(rtac adm_disj_lemma3 2),
  19.945 +	(atac 2),
  19.946 +	(atac 2),
  19.947 +	(res_inst_tac [("x","i")] exI 1),
  19.948 +	(strip_tac 1),
  19.949 +	(res_inst_tac [("s","False"),("t","ia < Suc(i)")] ssubst 1),
  19.950 +	(rtac iffI 1),
  19.951 +	(etac FalseE 2),
  19.952 +	(rtac notE 1),
  19.953 +	(rtac (not_less_eq RS iffD2) 1),
  19.954 +	(atac 1),
  19.955 +	(atac 1),
  19.956 +	(rtac (if_False RS ssubst) 1),
  19.957 +	(rtac refl 1)
  19.958 +	]);
  19.959 +
  19.960 +val adm_disj_lemma6 = prove_goal  Fix.thy
  19.961 +"[| is_chain(Y::nat=>'a); ? i. ! j. i < j --> Q(Y(j)) |] ==>\
  19.962 +\         ? X. is_chain(X) & (! n. Q(X(n))) & lub(range(Y)) = lub(range(X))"
  19.963 + (fn prems =>
  19.964 +	[
  19.965 +	(cut_facts_tac prems 1),
  19.966 +	(etac exE 1),
  19.967 +	(res_inst_tac [("x","%m.if(m< Suc(i),Y(Suc(i)),Y(m))")] exI 1),
  19.968 +	(rtac conjI 1),
  19.969 +	(rtac adm_disj_lemma3 1),
  19.970 +	(atac 1),
  19.971 +	(atac 1),
  19.972 +	(rtac conjI 1),
  19.973 +	(rtac adm_disj_lemma4 1),
  19.974 +	(atac 1),
  19.975 +	(rtac adm_disj_lemma5 1),
  19.976 +	(atac 1),
  19.977 +	(atac 1)
  19.978 +	]);
  19.979 +
  19.980 +
  19.981 +val adm_disj_lemma7 = prove_goal  Fix.thy 
  19.982 +"[| is_chain(Y::nat=>'a); ! i. ? j. i < j & P(Y(j))  |] ==>\
  19.983 +\         is_chain(%m. Y(theleast(%j. m<j & P(Y(j)))))"
  19.984 + (fn prems =>
  19.985 +	[
  19.986 +	(cut_facts_tac prems 1),
  19.987 +	(rtac is_chainI 1),
  19.988 +	(rtac allI 1),
  19.989 +	(rtac chain_mono3 1),
  19.990 +	(atac 1),
  19.991 +	(rtac theleast2 1),
  19.992 +	(rtac conjI 1),
  19.993 +	(rtac Suc_lessD 1),
  19.994 +	(etac allE 1),
  19.995 +	(etac exE 1),
  19.996 +	(rtac (theleast1 RS conjunct1) 1),
  19.997 +	(atac 1),
  19.998 +	(etac allE 1),
  19.999 +	(etac exE 1),
 19.1000 +	(rtac (theleast1 RS conjunct2) 1),
 19.1001 +	(atac 1)
 19.1002 +	]);
 19.1003 +
 19.1004 +val adm_disj_lemma8 = prove_goal  Fix.thy 
 19.1005 +"[| ! i. ? j. i < j & P(Y(j)) |] ==> ! m. P(Y(theleast(%j. m<j & P(Y(j)))))"
 19.1006 + (fn prems =>
 19.1007 +	[
 19.1008 +	(cut_facts_tac prems 1),
 19.1009 +	(strip_tac 1),
 19.1010 +	(etac allE 1),
 19.1011 +	(etac exE 1),
 19.1012 +	(etac (theleast1 RS conjunct2) 1)
 19.1013 +	]);
 19.1014 +
 19.1015 +val adm_disj_lemma9 = prove_goal  Fix.thy
 19.1016 +"[| is_chain(Y::nat=>'a); ! i. ? j. i < j & P(Y(j)) |] ==>\
 19.1017 +\         lub(range(Y)) = lub(range(%m. Y(theleast(%j. m<j & P(Y(j))))))"
 19.1018 + (fn prems =>
 19.1019 +	[
 19.1020 +	(cut_facts_tac prems 1),
 19.1021 +	(rtac antisym_less 1),
 19.1022 +	(rtac lub_mono 1),
 19.1023 +	(atac 1),
 19.1024 +	(rtac adm_disj_lemma7 1),
 19.1025 +	(atac 1),
 19.1026 +	(atac 1),
 19.1027 +	(strip_tac 1),
 19.1028 +	(rtac (chain_mono RS mp) 1),
 19.1029 +	(atac 1),
 19.1030 +	(etac allE 1),
 19.1031 +	(etac exE 1),
 19.1032 +	(rtac (theleast1 RS conjunct1) 1),
 19.1033 +	(atac 1),
 19.1034 +	(rtac lub_mono3 1),
 19.1035 +	(rtac adm_disj_lemma7 1),
 19.1036 +	(atac 1),
 19.1037 +	(atac 1),
 19.1038 +	(atac 1),
 19.1039 +	(strip_tac 1),
 19.1040 +	(rtac exI 1),
 19.1041 +	(rtac (chain_mono RS mp) 1),
 19.1042 +	(atac 1),
 19.1043 +	(rtac lessI 1)
 19.1044 +	]);
 19.1045 +
 19.1046 +val adm_disj_lemma10 = prove_goal  Fix.thy
 19.1047 +"[| is_chain(Y::nat=>'a); ! i. ? j. i < j & P(Y(j)) |] ==>\
 19.1048 +\         ? X. is_chain(X) & (! n. P(X(n))) & lub(range(Y)) = lub(range(X))"
 19.1049 + (fn prems =>
 19.1050 +	[
 19.1051 +	(cut_facts_tac prems 1),
 19.1052 +	(res_inst_tac [("x","%m. Y(theleast(%j. m<j & P(Y(j))))")] exI 1),
 19.1053 +	(rtac conjI 1),
 19.1054 +	(rtac adm_disj_lemma7 1),
 19.1055 +	(atac 1),
 19.1056 +	(atac 1),
 19.1057 +	(rtac conjI 1),
 19.1058 +	(rtac adm_disj_lemma8 1),
 19.1059 +	(atac 1),
 19.1060 +	(rtac adm_disj_lemma9 1),
 19.1061 +	(atac 1),
 19.1062 +	(atac 1)
 19.1063 +	]);
 19.1064 +
 19.1065 +val adm_disj = prove_goal  Fix.thy  
 19.1066 +	"[| adm(P); adm(Q) |] ==> adm(%x.P(x)|Q(x))"
 19.1067 + (fn prems =>
 19.1068 +	[
 19.1069 +	(cut_facts_tac prems 1),
 19.1070 +	(rtac (adm_def2 RS iffD2) 1),
 19.1071 +	(strip_tac 1),
 19.1072 +	(rtac (adm_disj_lemma1 RS disjE) 1),
 19.1073 +	(atac 1),
 19.1074 +	(atac 1),
 19.1075 +	(rtac disjI2 1),
 19.1076 +	(rtac adm_disj_lemma2 1),
 19.1077 +	(atac 1),
 19.1078 +	(rtac adm_disj_lemma6 1),
 19.1079 +	(atac 1),
 19.1080 +	(atac 1),
 19.1081 +	(rtac disjI1 1),
 19.1082 +	(rtac adm_disj_lemma2 1),
 19.1083 +	(atac 1),
 19.1084 +	(rtac adm_disj_lemma10 1),
 19.1085 +	(atac 1),
 19.1086 +	(atac 1)
 19.1087 +	]);
 19.1088 +
 19.1089 +val adm_impl = prove_goal  Fix.thy  
 19.1090 +	"[| adm(%x.~P(x)); adm(Q) |] ==> adm(%x.P(x)-->Q(x))"
 19.1091 + (fn prems =>
 19.1092 +	[
 19.1093 +	(cut_facts_tac prems 1),
 19.1094 +	(res_inst_tac [("P2","%x.~P(x)|Q(x)")] (adm_cong RS iffD1) 1),
 19.1095 +	(fast_tac HOL_cs 1),
 19.1096 +	(rtac adm_disj 1),
 19.1097 +	(atac 1),
 19.1098 +	(atac 1)
 19.1099 +	]);
 19.1100 +
 19.1101 +
 19.1102 +val adm_all2 = (allI RS adm_all);
 19.1103 +
 19.1104 +val adm_thms = [adm_impl,adm_disj,adm_eq,adm_not_UU,adm_UU_not_less,
 19.1105 +	adm_all2,adm_not_less,adm_not_free,adm_conj,adm_less
 19.1106 +	];
 19.1107 +
 19.1108 +(* ------------------------------------------------------------------------- *)
 19.1109 +(* a result about functions with flat codomain                               *)
 19.1110 +(* ------------------------------------------------------------------------- *)
 19.1111 +
 19.1112 +val flat_codom = prove_goalw Fix.thy [flat_def]
 19.1113 +"[|flat(y::'b);f[x::'a]=(c::'b)|] ==> f[UU::'a]=UU::'b | (!z.f[z::'a]=c)"
 19.1114 + (fn prems =>
 19.1115 +	[
 19.1116 +	(cut_facts_tac prems 1),
 19.1117 +	(res_inst_tac [("Q","f[x::'a]=UU::'b")] classical2 1),
 19.1118 +	(rtac disjI1 1),
 19.1119 +	(rtac UU_I 1),
 19.1120 +	(res_inst_tac [("s","f[x]"),("t","UU::'b")] subst 1),
 19.1121 +	(atac 1),
 19.1122 +	(rtac (minimal RS monofun_cfun_arg) 1),
 19.1123 +	(res_inst_tac [("Q","f[UU::'a]=UU::'b")] classical2 1),
 19.1124 +	(etac disjI1 1),
 19.1125 +	(rtac disjI2 1),
 19.1126 +	(rtac allI 1),
 19.1127 +	(res_inst_tac [("s","f[x]"),("t","c")] subst 1),
 19.1128 +	(atac 1),
 19.1129 +	(res_inst_tac [("a","f[UU::'a]")] (refl RS box_equals) 1),
 19.1130 +	(etac allE 1),(etac allE 1),
 19.1131 +	(dtac mp 1),
 19.1132 +	(res_inst_tac [("fo5","f")] (minimal RS monofun_cfun_arg) 1),
 19.1133 +	(etac disjE 1),
 19.1134 +	(contr_tac 1),
 19.1135 +	(atac 1),
 19.1136 +	(etac allE 1),
 19.1137 +	(etac allE 1),
 19.1138 +	(dtac mp 1),
 19.1139 +	(res_inst_tac [("fo5","f")] (minimal RS monofun_cfun_arg) 1),
 19.1140 +	(etac disjE 1),
 19.1141 +	(contr_tac 1),
 19.1142 +	(atac 1)
 19.1143 +	]);
    20.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    20.2 +++ b/src/HOLCF/Fix.thy	Wed Jan 19 17:35:01 1994 +0100
    20.3 @@ -0,0 +1,42 @@
    20.4 +(*  Title: 	HOLCF/fix.thy
    20.5 +    ID:         $Id$
    20.6 +    Author: 	Franz Regensburger
    20.7 +    Copyright   1993  Technische Universitaet Muenchen
    20.8 +
    20.9 +
   20.10 +definitions for fixed point operator and admissibility
   20.11 +
   20.12 +*)
   20.13 +
   20.14 +Fix = Cfun3 +
   20.15 +
   20.16 +consts
   20.17 +
   20.18 +iterate :: "nat=>('a->'a)=>'a=>'a"
   20.19 +Ifix    :: "('a->'a)=>'a"
   20.20 +fix     :: "('a->'a)->'a"
   20.21 +adm          :: "('a=>bool)=>bool"
   20.22 +admw         :: "('a=>bool)=>bool"
   20.23 +chain_finite :: "'a=>bool"
   20.24 +flat         :: "'a=>bool"
   20.25 +
   20.26 +rules
   20.27 +
   20.28 +iterate_def   "iterate(n,F,c) == nat_rec(n,c,%n x.F[x])"
   20.29 +Ifix_def      "Ifix(F) == lub(range(%i.iterate(i,F,UU)))"
   20.30 +fix_def       "fix == (LAM f. Ifix(f))"
   20.31 +
   20.32 +adm_def       "adm(P) == !Y. is_chain(Y) --> \
   20.33 +\                        (!i.P(Y(i))) --> P(lub(range(Y)))"
   20.34 +
   20.35 +admw_def      "admw(P)== (!F.((!n.P(iterate(n,F,UU)))-->\
   20.36 +\			 P(lub(range(%i.iterate(i,F,UU))))))" 
   20.37 +
   20.38 +chain_finite_def  "chain_finite(x::'a)==\
   20.39 +\                        !Y. is_chain(Y::nat=>'a) --> (? n.max_in_chain(n,Y))"
   20.40 +
   20.41 +flat_def          "flat(x::'a) ==\
   20.42 +\                        ! x y. x::'a << y --> (x = UU) | (x=y)"
   20.43 +
   20.44 +end
   20.45 +
    21.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    21.2 +++ b/src/HOLCF/Fun1.ML	Wed Jan 19 17:35:01 1994 +0100
    21.3 @@ -0,0 +1,49 @@
    21.4 +(*  Title: 	HOLCF/fun1.ML
    21.5 +    ID:         $Id$
    21.6 +    Author: 	Franz Regensburger
    21.7 +    Copyright   1993  Technische Universitaet Muenchen
    21.8 +
    21.9 +Lemmas for fun1.thy 
   21.10 +*)
   21.11 +
   21.12 +open Fun1;
   21.13 +
   21.14 +(* ------------------------------------------------------------------------ *)
   21.15 +(* less_fun is a partial order on 'a => 'b                                  *)
   21.16 +(* ------------------------------------------------------------------------ *)
   21.17 +
   21.18 +val refl_less_fun = prove_goalw Fun1.thy [less_fun_def] "less_fun(f,f)"
   21.19 +(fn prems =>
   21.20 +	[
   21.21 +	(fast_tac (HOL_cs addSIs [refl_less]) 1)
   21.22 +	]);
   21.23 +
   21.24 +val antisym_less_fun = prove_goalw Fun1.thy [less_fun_def] 
   21.25 +	"[|less_fun(f1,f2); less_fun(f2,f1)|] ==> f1 = f2"
   21.26 +(fn prems =>
   21.27 +	[
   21.28 +	(cut_facts_tac prems 1),
   21.29 +	(rtac (expand_fun_eq RS ssubst) 1),
   21.30 +	(fast_tac (HOL_cs addSIs [antisym_less]) 1)
   21.31 +	]);
   21.32 +
   21.33 +val trans_less_fun = prove_goalw Fun1.thy [less_fun_def] 
   21.34 +	"[|less_fun(f1,f2); less_fun(f2,f3)|] ==> less_fun(f1,f3)"
   21.35 +(fn prems =>
   21.36 +	[
   21.37 +	(cut_facts_tac prems 1),
   21.38 +	(strip_tac 1),
   21.39 +	(rtac trans_less 1),
   21.40 +	(etac allE 1),
   21.41 +	(atac 1),
   21.42 +	((etac allE 1) THEN (atac 1))
   21.43 +	]);
   21.44 +
   21.45 +(* 
   21.46 + -------------------------------------------------------------------------- 
   21.47 +   Since less_fun :: "['a::term=>'b::po,'a::term=>'b::po] => bool" the
   21.48 +   lemmas refl_less_fun, antisym_less_fun, trans_less_fun justify
   21.49 +   the class arity fun::(term,po)po !!
   21.50 + -------------------------------------------------------------------------- 
   21.51 +*)
   21.52 +
    22.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    22.2 +++ b/src/HOLCF/Fun1.thy	Wed Jan 19 17:35:01 1994 +0100
    22.3 @@ -0,0 +1,30 @@
    22.4 +(*  Title: 	HOLCF/fun1.thy
    22.5 +    ID:         $Id$
    22.6 +    Author: 	Franz Regensburger
    22.7 +    Copyright   1993  Technische Universitaet Muenchen
    22.8 +
    22.9 +
   22.10 +Definition of the partial ordering for the type of all functions => (fun)
   22.11 +
   22.12 +REMARK: The ordering on 'a => 'b is only defined if 'b is in class po !!
   22.13 +
   22.14 +*)
   22.15 +
   22.16 +Fun1 = Pcpo +
   22.17 +
   22.18 +(* default class is still term *)
   22.19 +
   22.20 +consts
   22.21 +  less_fun	:: "['a=>'b::po,'a=>'b] => bool"	
   22.22 +
   22.23 +rules
   22.24 +   (* definition of the ordering less_fun            *)
   22.25 +   (* in fun1.ML it is proved that less_fun is a po *)
   22.26 +   
   22.27 +  less_fun_def "less_fun(f1,f2) == ! x. f1(x) << f2(x)"  
   22.28 +
   22.29 +end
   22.30 +
   22.31 +
   22.32 +
   22.33 +
    23.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    23.2 +++ b/src/HOLCF/Fun2.ML	Wed Jan 19 17:35:01 1994 +0100
    23.3 @@ -0,0 +1,106 @@
    23.4 +(*  Title: 	HOLCF/fun2.ML
    23.5 +    ID:         $Id$
    23.6 +    Author: 	Franz Regensburger
    23.7 +    Copyright   1993 Technische Universitaet Muenchen
    23.8 +
    23.9 +Lemmas for fun2.thy 
   23.10 +*)
   23.11 +
   23.12 +open Fun2;
   23.13 +
   23.14 +(* ------------------------------------------------------------------------ *)
   23.15 +(* Type 'a::term => 'b::pcpo is pointed                                     *)
   23.16 +(* ------------------------------------------------------------------------ *)
   23.17 +
   23.18 +val minimal_fun = prove_goalw  Fun2.thy [UU_fun_def] "UU_fun << f"
   23.19 +(fn prems =>
   23.20 +	[
   23.21 +	(rtac (inst_fun_po RS ssubst) 1),
   23.22 +	(rewrite_goals_tac [less_fun_def]),
   23.23 +	(fast_tac (HOL_cs addSIs [minimal]) 1)
   23.24 +	]);
   23.25 +
   23.26 +(* ------------------------------------------------------------------------ *)
   23.27 +(* make the symbol << accessible for type fun                               *)
   23.28 +(* ------------------------------------------------------------------------ *)
   23.29 +
   23.30 +val less_fun = prove_goal  Fun2.thy  "(f1 << f2) = (! x. f1(x) << f2(x))"
   23.31 +(fn prems =>
   23.32 +	[
   23.33 +	(rtac (inst_fun_po RS ssubst) 1),
   23.34 +	(fold_goals_tac [less_fun_def]),
   23.35 +	(rtac refl 1)
   23.36 +	]);
   23.37 +
   23.38 +(* ------------------------------------------------------------------------ *)
   23.39 +(* chains of functions yield chains in the po range                         *)
   23.40 +(* ------------------------------------------------------------------------ *)
   23.41 +
   23.42 +val ch2ch_fun = prove_goal  Fun2.thy 
   23.43 +	"is_chain(S::nat=>('a::term => 'b::po)) ==> is_chain(% i.S(i)(x))"
   23.44 +(fn prems =>
   23.45 +	[
   23.46 +	(cut_facts_tac prems 1),
   23.47 +	(rewrite_goals_tac [is_chain]),
   23.48 +	(rtac allI 1),
   23.49 +	(rtac spec 1),
   23.50 +	(rtac (less_fun RS subst) 1),
   23.51 +	(etac allE 1),
   23.52 +	(atac 1)
   23.53 +	]);
   23.54 +
   23.55 +(* ------------------------------------------------------------------------ *)
   23.56 +(* upper bounds of function chains yield upper bound in the po range        *)
   23.57 +(* ------------------------------------------------------------------------ *)
   23.58 +
   23.59 +val ub2ub_fun = prove_goal Fun2.thy 
   23.60 +   " range(S::nat=>('a::term => 'b::po)) <| u ==> range(%i. S(i,x)) <| u(x)"
   23.61 +(fn prems =>
   23.62 +	[
   23.63 +	(cut_facts_tac prems 1),
   23.64 +	(rtac ub_rangeI 1),
   23.65 +	(rtac allI 1),
   23.66 +	(rtac allE 1),
   23.67 +	(rtac (less_fun RS subst) 1),
   23.68 +	(etac (ub_rangeE RS spec) 1),
   23.69 +	(atac 1)
   23.70 +	]);
   23.71 +
   23.72 +(* ------------------------------------------------------------------------ *)
   23.73 +(* Type 'a::term => 'b::pcpo is chain complete                              *)
   23.74 +(* ------------------------------------------------------------------------ *)
   23.75 +
   23.76 +val lub_fun = prove_goal  Fun2.thy
   23.77 +	"is_chain(S::nat=>('a::term => 'b::pcpo)) ==> \
   23.78 +\        range(S) <<| (% x.lub(range(% i.S(i)(x))))"
   23.79 +(fn prems =>
   23.80 +	[
   23.81 +	(cut_facts_tac prems 1),
   23.82 +	(rtac is_lubI 1),
   23.83 +	(rtac conjI 1),
   23.84 +	(rtac ub_rangeI 1),
   23.85 +	(rtac allI 1),
   23.86 +	(rtac (less_fun RS ssubst) 1),
   23.87 +	(rtac allI 1),
   23.88 +	(rtac is_ub_thelub 1),
   23.89 +	(etac ch2ch_fun 1),
   23.90 +	(strip_tac 1),
   23.91 +	(rtac (less_fun RS ssubst) 1),
   23.92 +	(rtac allI 1),
   23.93 +	(rtac is_lub_thelub 1),
   23.94 +	(etac ch2ch_fun 1),
   23.95 +	(etac ub2ub_fun 1)
   23.96 +	]);
   23.97 +
   23.98 +val thelub_fun = (lub_fun RS thelubI);
   23.99 +(* is_chain(?S1) ==> lub(range(?S1)) = (%x. lub(range(%i. ?S1(i,x)))) *)
  23.100 +
  23.101 +val cpo_fun = prove_goal  Fun2.thy
  23.102 +	"is_chain(S::nat=>('a::term => 'b::pcpo)) ==> ? x. range(S) <<| x"
  23.103 +(fn prems =>
  23.104 +	[
  23.105 +	(cut_facts_tac prems 1),
  23.106 +	(rtac exI 1),
  23.107 +	(etac lub_fun 1)
  23.108 +	]);
  23.109 +
    24.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    24.2 +++ b/src/HOLCF/Fun2.thy	Wed Jan 19 17:35:01 1994 +0100
    24.3 @@ -0,0 +1,40 @@
    24.4 +(*  Title: 	HOLCF/fun2.thy
    24.5 +    ID:         $Id$
    24.6 +    Author: 	Franz Regensburger
    24.7 +    Copyright   1993 Technische Universitaet Muenchen
    24.8 +
    24.9 +Class Instance =>::(term,po)po
   24.10 +Definiton of least element
   24.11 +*)
   24.12 +
   24.13 +Fun2 = Fun1 + 
   24.14 +
   24.15 +(* default class is still term !*)
   24.16 +
   24.17 +(* Witness for the above arity axiom is fun1.ML *)
   24.18 +
   24.19 +arities fun :: (term,po)po
   24.20 +
   24.21 +consts	
   24.22 +	UU_fun  :: "'a::term => 'b::pcpo"
   24.23 +
   24.24 +rules
   24.25 +
   24.26 +(* instance of << for type ['a::term => 'b::po]  *)
   24.27 +
   24.28 +inst_fun_po	"(op <<)::['a=>'b::po,'a=>'b::po ]=>bool = less_fun"
   24.29 +
   24.30 +(* definitions *)
   24.31 +(* The least element in type 'a::term => 'b::pcpo *)
   24.32 +
   24.33 +UU_fun_def	"UU_fun == (% x.UU)"
   24.34 +
   24.35 +end
   24.36 +
   24.37 +
   24.38 +
   24.39 +
   24.40 +
   24.41 +
   24.42 +
   24.43 +
    25.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    25.2 +++ b/src/HOLCF/Fun3.ML	Wed Jan 19 17:35:01 1994 +0100
    25.3 @@ -0,0 +1,7 @@
    25.4 +(*  Title: 	HOLCF/fun3.ML
    25.5 +    ID:         $Id$
    25.6 +    Author: 	Franz Regensburger
    25.7 +    Copyright   1993 Technische Universitaet Muenchen
    25.8 +*)
    25.9 +
   25.10 +open Fun3;
    26.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    26.2 +++ b/src/HOLCF/Fun3.thy	Wed Jan 19 17:35:01 1994 +0100
    26.3 @@ -0,0 +1,23 @@
    26.4 +(*  Title: 	HOLCF/fun3.thy
    26.5 +    ID:         $Id$
    26.6 +    Author: 	Franz Regensburger
    26.7 +    Copyright   1993 Technische Universitaet Muenchen
    26.8 +
    26.9 +Class instance of  => (fun) for class pcpo
   26.10 +
   26.11 +*)
   26.12 +
   26.13 +Fun3 = Fun2 +
   26.14 +
   26.15 +(* default class is still term *)
   26.16 +
   26.17 +arities fun  :: (term,pcpo)pcpo		(* Witness fun2.ML *)
   26.18 +
   26.19 +rules 
   26.20 +
   26.21 +inst_fun_pcpo	"UU::'a=>'b::pcpo = UU_fun"
   26.22 +
   26.23 +end
   26.24 +
   26.25 +
   26.26 +
    27.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    27.2 +++ b/src/HOLCF/HOLCF.ML	Wed Jan 19 17:35:01 1994 +0100
    27.3 @@ -0,0 +1,20 @@
    27.4 +(*  Title: 	HOLCF/HOLCF.ML
    27.5 +    ID:         $Id$
    27.6 +    Author: 	Franz Regensburger
    27.7 +    Copyright   1993 Technische Universitaet Muenchen
    27.8 +*)
    27.9 +
   27.10 +open HOLCF;
   27.11 +
   27.12 +val HOLCF_ss = ccc1_ss 
   27.13 +		addsimps one_when 
   27.14 +		addsimps dist_less_one
   27.15 +		addsimps dist_eq_one 
   27.16 +		addsimps dist_less_tr
   27.17 +		addsimps dist_eq_tr
   27.18 +		addsimps tr_when
   27.19 +		addsimps andalso_thms
   27.20 +		addsimps orelse_thms
   27.21 +		addsimps ifte_thms;
   27.22 +
   27.23 +
    28.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    28.2 +++ b/src/HOLCF/HOLCF.thy	Wed Jan 19 17:35:01 1994 +0100
    28.3 @@ -0,0 +1,13 @@
    28.4 +(*  Title: 	HOLCF/HOLCF.thy
    28.5 +    ID:         $Id$
    28.6 +    Author: 	Franz Regensburger
    28.7 +    Copyright   1993 Technische Universitaet Muenchen
    28.8 +
    28.9 +
   28.10 +Top theory for HOLCF system
   28.11 +
   28.12 +*)
   28.13 +
   28.14 +HOLCF = Tr2 
   28.15 +
   28.16 +
    29.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    29.2 +++ b/src/HOLCF/Holcfb.ML	Wed Jan 19 17:35:01 1994 +0100
    29.3 @@ -0,0 +1,152 @@
    29.4 +(*  Title: 	HOLCF/holcfb.ML
    29.5 +    ID:         $Id$
    29.6 +    Author: 	Franz Regensburger
    29.7 +    Copyright   1993  Technische Universitaet Muenchen
    29.8 +
    29.9 +Lemmas for Holcfb.thy 
   29.10 +*)
   29.11 +
   29.12 +open Holcfb;
   29.13 +
   29.14 +(* ------------------------------------------------------------------------ *)
   29.15 +(* <::nat=>nat=>bool is well-founded                                        *)
   29.16 +(* ------------------------------------------------------------------------ *)
   29.17 +
   29.18 +val well_founded_nat = prove_goal  Nat.thy 
   29.19 +	"!P. P(x::nat) --> (? y. P(y) & (! x. P(x) --> y <= x))"
   29.20 + (fn prems =>
   29.21 +	[
   29.22 +	(res_inst_tac [("n","x")] less_induct 1),
   29.23 +	(strip_tac 1),
   29.24 +	(res_inst_tac [("Q","? k.k<n & P(k)")] (excluded_middle RS disjE) 1),
   29.25 +	(etac exE 2),
   29.26 +	(etac conjE 2),
   29.27 +	(rtac mp 2),
   29.28 +	(etac allE 2),
   29.29 +	(etac impE 2),
   29.30 +	(atac 2),
   29.31 +	(etac spec 2),
   29.32 +	(atac 2),
   29.33 +	(res_inst_tac [("x","n")] exI 1),
   29.34 +	(rtac conjI 1),
   29.35 +	(atac 1),
   29.36 +	(strip_tac 1),
   29.37 +	(rtac leI  1),
   29.38 +	(fast_tac HOL_cs 1)
   29.39 +	]);
   29.40 +
   29.41 +
   29.42 +(* ------------------------------------------------------------------------ *)
   29.43 +(* Lemmas for selecting the least element in a nonempty set                 *)
   29.44 +(* ------------------------------------------------------------------------ *)
   29.45 +
   29.46 +val theleast = prove_goalw  Holcfb.thy [theleast_def] 
   29.47 +"P(x) ==> P(theleast(P)) & (!x.P(x)--> theleast(P) <= x)"
   29.48 + (fn prems =>
   29.49 +	[
   29.50 +	(cut_facts_tac prems 1),
   29.51 +	(rtac (well_founded_nat RS spec RS mp RS exE) 1),
   29.52 +	(atac 1),
   29.53 +	(rtac selectI 1),
   29.54 +	(atac 1)
   29.55 +	]);
   29.56 +
   29.57 +val theleast1= theleast RS conjunct1;
   29.58 +(* ?P1(?x1) ==> ?P1(theleast(?P1)) *)
   29.59 +
   29.60 +val theleast2 = prove_goal  Holcfb.thy  "P(x) ==> theleast(P) <= x"
   29.61 + (fn prems =>
   29.62 +	[
   29.63 +	(rtac (theleast RS conjunct2 RS spec RS mp) 1),
   29.64 +	(resolve_tac prems 1),
   29.65 +	(resolve_tac prems 1)
   29.66 +	]);
   29.67 +
   29.68 +
   29.69 +(* ------------------------------------------------------------------------ *)
   29.70 +(* Some lemmas in HOL.thy                                                   *)
   29.71 +(* ------------------------------------------------------------------------ *)
   29.72 +
   29.73 +
   29.74 +val de_morgan1 = prove_goal HOL.thy "(~a & ~b)=(~(a | b))"
   29.75 +(fn prems =>
   29.76 +	[
   29.77 +	(rtac iffI 1),
   29.78 +	(fast_tac HOL_cs 1),
   29.79 +	(fast_tac HOL_cs 1)
   29.80 +	]);
   29.81 +
   29.82 +val de_morgan2 = prove_goal HOL.thy "(~a | ~b)=(~(a & b))"
   29.83 +(fn prems =>
   29.84 +	[
   29.85 +	(rtac iffI 1),
   29.86 +	(fast_tac HOL_cs 1),
   29.87 +	(fast_tac HOL_cs 1)
   29.88 +	]);
   29.89 +
   29.90 +
   29.91 +val notall2ex = prove_goal HOL.thy "(~ (!x.P(x))) = (? x.~P(x))"
   29.92 +(fn prems =>
   29.93 +	[
   29.94 +	(rtac iffI 1),
   29.95 +	(fast_tac HOL_cs 1),
   29.96 +	(fast_tac HOL_cs 1)
   29.97 +	]);
   29.98 +
   29.99 +val notex2all = prove_goal HOL.thy "(~ (? x.P(x))) = (!x.~P(x))"
  29.100 +(fn prems =>
  29.101 +	[
  29.102 +	(rtac iffI 1),
  29.103 +	(fast_tac HOL_cs 1),
  29.104 +	(fast_tac HOL_cs 1)
  29.105 +	]);
  29.106 +
  29.107 +
  29.108 +val selectI2 = prove_goal HOL.thy "(? x. P(x)) ==> P(@ x.P(x))"
  29.109 +(fn prems =>
  29.110 +	[
  29.111 +	(cut_facts_tac prems 1),
  29.112 +	(etac exE 1),
  29.113 +	(etac selectI 1)
  29.114 +	]);
  29.115 +
  29.116 +val selectE = prove_goal HOL.thy "P(@ x.P(x)) ==> (? x. P(x))"
  29.117 +(fn prems =>
  29.118 +	[
  29.119 +	(cut_facts_tac prems 1),
  29.120 +	(etac exI 1)
  29.121 +	]);
  29.122 +
  29.123 +val select_eq_Ex = prove_goal HOL.thy "(P(@ x.P(x))) =  (? x. P(x))"
  29.124 +(fn prems =>
  29.125 +	[
  29.126 +	(rtac (iff RS mp  RS mp) 1),
  29.127 +	(strip_tac 1),
  29.128 +	(etac selectE 1),
  29.129 +	(strip_tac 1),
  29.130 +	(etac selectI2 1)
  29.131 +	]);
  29.132 +
  29.133 +
  29.134 +val notnotI = prove_goal HOL.thy "P ==> ~~P"
  29.135 +(fn prems =>
  29.136 +	[
  29.137 +	(cut_facts_tac prems 1),
  29.138 +	(fast_tac HOL_cs 1)
  29.139 +	]);
  29.140 +
  29.141 +
  29.142 +val classical2 = prove_goal HOL.thy "[|Q ==> R; ~Q ==> R|]==>R"
  29.143 + (fn prems =>
  29.144 +	[
  29.145 +	(rtac disjE 1),
  29.146 +	(rtac excluded_middle 1),
  29.147 +	(eresolve_tac prems 1),
  29.148 +	(eresolve_tac prems 1)
  29.149 +	]);
  29.150 +
  29.151 +
  29.152 +
  29.153 +val classical3 = (notE RS notI);
  29.154 +(* [| ?P ==> ~ ?P1; ?P ==> ?P1 |] ==> ~ ?P *)
  29.155 +
    30.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    30.2 +++ b/src/HOLCF/Holcfb.thy	Wed Jan 19 17:35:01 1994 +0100
    30.3 @@ -0,0 +1,25 @@
    30.4 +(*  Title: 	HOLCF/holcfb.thy
    30.5 +    ID:         $Id$
    30.6 +    Author: 	Franz Regensburger
    30.7 +    Copyright   1993  Technische Universitaet Muenchen
    30.8 +
    30.9 +Basic definitions for the embedding of LCF into HOL.
   30.10 +
   30.11 +*)
   30.12 +
   30.13 +Holcfb = Nat + 
   30.14 +
   30.15 +consts
   30.16 +
   30.17 +theleast     :: "(nat=>bool)=>nat"
   30.18 +
   30.19 +rules
   30.20 +
   30.21 +theleast_def    "theleast(P) == (@z.(P(z) & (!n.P(n)-->z<=n)))"
   30.22 +
   30.23 +end
   30.24 +
   30.25 +
   30.26 +
   30.27 +
   30.28 +
    31.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    31.2 +++ b/src/HOLCF/Lift1.ML	Wed Jan 19 17:35:01 1994 +0100
    31.3 @@ -0,0 +1,188 @@
    31.4 +(*  Title: 	HOLCF/lift1.ML
    31.5 +    ID:         $Id$
    31.6 +    Author: 	Franz Regensburger
    31.7 +    Copyright   1993  Technische Universitaet Muenchen
    31.8 +*)
    31.9 +
   31.10 +open Lift1;
   31.11 +
   31.12 +val Exh_Lift = prove_goalw Lift1.thy [UU_lift_def,Iup_def ]
   31.13 +	"z = UU_lift | (? x. z = Iup(x))"
   31.14 + (fn prems =>
   31.15 +	[
   31.16 +	(rtac (Rep_Lift_inverse RS subst) 1),
   31.17 +	(res_inst_tac [("s","Rep_Lift(z)")] sumE 1),
   31.18 +	(rtac disjI1 1),
   31.19 +	(res_inst_tac [("f","Abs_Lift")] arg_cong 1),
   31.20 +	(rtac (unique_void2 RS subst) 1),
   31.21 +	(atac 1),
   31.22 +	(rtac disjI2 1),
   31.23 +	(rtac exI 1),
   31.24 +	(res_inst_tac [("f","Abs_Lift")] arg_cong 1),
   31.25 +	(atac 1)
   31.26 +	]);
   31.27 +
   31.28 +val inj_Abs_Lift = prove_goal Lift1.thy "inj(Abs_Lift)"
   31.29 + (fn prems =>
   31.30 +	[
   31.31 +	(rtac inj_inverseI 1),
   31.32 +	(rtac Abs_Lift_inverse 1)
   31.33 +	]);
   31.34 +
   31.35 +val inj_Rep_Lift = prove_goal Lift1.thy "inj(Rep_Lift)"
   31.36 + (fn prems =>
   31.37 +	[
   31.38 +	(rtac inj_inverseI 1),
   31.39 +	(rtac Rep_Lift_inverse 1)
   31.40 +	]);
   31.41 +
   31.42 +val inject_Iup = prove_goalw Lift1.thy [Iup_def] "Iup(x)=Iup(y) ==> x=y"
   31.43 + (fn prems =>
   31.44 +	[
   31.45 +	(cut_facts_tac prems 1),
   31.46 +	(rtac (inj_Inr RS injD) 1),
   31.47 +	(rtac (inj_Abs_Lift RS injD) 1),
   31.48 +	(atac 1)
   31.49 +	]);
   31.50 +
   31.51 +val defined_Iup=prove_goalw Lift1.thy [Iup_def,UU_lift_def] "~ Iup(x)=UU_lift"
   31.52 + (fn prems =>
   31.53 +	[
   31.54 +	(rtac notI 1),
   31.55 +	(rtac notE 1),
   31.56 +	(rtac Inl_not_Inr 1),
   31.57 +	(rtac sym 1),
   31.58 +	(etac (inj_Abs_Lift RS  injD) 1)
   31.59 +	]);
   31.60 +
   31.61 +
   31.62 +val liftE = prove_goal  Lift1.thy
   31.63 +	"[| p=UU_lift ==> Q; !!x. p=Iup(x)==>Q|] ==>Q"
   31.64 + (fn prems =>
   31.65 +	[
   31.66 +	(rtac (Exh_Lift RS disjE) 1),
   31.67 +	(eresolve_tac prems 1),
   31.68 +	(etac exE 1),
   31.69 +	(eresolve_tac prems 1)
   31.70 +	]);
   31.71 +
   31.72 +val Ilift1 = prove_goalw  Lift1.thy [Ilift_def,UU_lift_def]
   31.73 +	"Ilift(f)(UU_lift)=UU"
   31.74 + (fn prems =>
   31.75 +	[
   31.76 +	(rtac (Abs_Lift_inverse RS ssubst) 1),
   31.77 +	(rtac (case_Inl RS ssubst) 1),
   31.78 +	(rtac refl 1)
   31.79 +	]);
   31.80 +
   31.81 +val Ilift2 = prove_goalw  Lift1.thy [Ilift_def,Iup_def]
   31.82 +	"Ilift(f)(Iup(x))=f[x]"
   31.83 + (fn prems =>
   31.84 +	[
   31.85 +	(rtac (Abs_Lift_inverse RS ssubst) 1),
   31.86 +	(rtac (case_Inr RS ssubst) 1),
   31.87 +	(rtac refl 1)
   31.88 +	]);
   31.89 +
   31.90 +val Lift_ss = Cfun_ss addsimps [Ilift1,Ilift2];
   31.91 +
   31.92 +val less_lift1a = prove_goalw  Lift1.thy [less_lift_def,UU_lift_def]
   31.93 +	"less_lift(UU_lift)(z)"
   31.94 + (fn prems =>
   31.95 +	[
   31.96 +	(rtac (Abs_Lift_inverse RS ssubst) 1),
   31.97 +	(rtac (case_Inl RS ssubst) 1),
   31.98 +	(rtac TrueI 1)
   31.99 +	]);
  31.100 +
  31.101 +val less_lift1b = prove_goalw  Lift1.thy [Iup_def,less_lift_def,UU_lift_def]
  31.102 +	"~less_lift(Iup(x),UU_lift)"
  31.103 + (fn prems =>
  31.104 +	[
  31.105 +	(rtac notI 1),
  31.106 +	(rtac iffD1 1),
  31.107 +	(atac 2),
  31.108 +	(rtac (Abs_Lift_inverse RS ssubst) 1),
  31.109 +	(rtac (Abs_Lift_inverse RS ssubst) 1),
  31.110 +	(rtac (case_Inr RS ssubst) 1),
  31.111 +	(rtac (case_Inl RS ssubst) 1),
  31.112 +	(rtac refl 1)
  31.113 +	]);
  31.114 +
  31.115 +val less_lift1c = prove_goalw  Lift1.thy [Iup_def,less_lift_def,UU_lift_def]
  31.116 +	"less_lift(Iup(x),Iup(y))=(x<<y)"
  31.117 + (fn prems =>
  31.118 +	[
  31.119 +	(rtac (Abs_Lift_inverse RS ssubst) 1),
  31.120 +	(rtac (Abs_Lift_inverse RS ssubst) 1),
  31.121 +	(rtac (case_Inr RS ssubst) 1),
  31.122 +	(rtac (case_Inr RS ssubst) 1),
  31.123 +	(rtac refl 1)
  31.124 +	]);
  31.125 +
  31.126 +
  31.127 +val refl_less_lift = prove_goal  Lift1.thy "less_lift(p,p)"
  31.128 + (fn prems =>
  31.129 +	[
  31.130 +	(res_inst_tac [("p","p")] liftE 1),
  31.131 +	(hyp_subst_tac 1),
  31.132 +	(rtac less_lift1a 1),
  31.133 +	(hyp_subst_tac 1),
  31.134 +	(rtac (less_lift1c RS iffD2) 1),
  31.135 +	(rtac refl_less 1)
  31.136 +	]);
  31.137 +
  31.138 +val antisym_less_lift = prove_goal  Lift1.thy 
  31.139 +	"[|less_lift(p1,p2);less_lift(p2,p1)|] ==> p1=p2"
  31.140 + (fn prems =>
  31.141 +	[
  31.142 +	(cut_facts_tac prems 1),
  31.143 +	(res_inst_tac [("p","p1")] liftE 1),
  31.144 +	(hyp_subst_tac 1),
  31.145 +	(res_inst_tac [("p","p2")] liftE 1),
  31.146 +	(hyp_subst_tac 1),
  31.147 +	(rtac refl 1),
  31.148 +	(hyp_subst_tac 1),
  31.149 +	(res_inst_tac [("P","less_lift(Iup(x),UU_lift)")] notE 1),
  31.150 +	(rtac less_lift1b 1),
  31.151 +	(atac 1),
  31.152 +	(hyp_subst_tac 1),
  31.153 +	(res_inst_tac [("p","p2")] liftE 1),
  31.154 +	(hyp_subst_tac 1),
  31.155 +	(res_inst_tac [("P","less_lift(Iup(x),UU_lift)")] notE 1),
  31.156 +	(rtac less_lift1b 1),
  31.157 +	(atac 1),
  31.158 +	(hyp_subst_tac 1),
  31.159 +	(rtac arg_cong 1),
  31.160 +	(rtac antisym_less 1),
  31.161 +	(etac (less_lift1c RS iffD1) 1),
  31.162 +	(etac (less_lift1c RS iffD1) 1)
  31.163 +	]);
  31.164 +
  31.165 +val trans_less_lift = prove_goal  Lift1.thy 
  31.166 +	"[|less_lift(p1,p2);less_lift(p2,p3)|] ==> less_lift(p1,p3)"
  31.167 + (fn prems =>
  31.168 +	[
  31.169 +	(cut_facts_tac prems 1),
  31.170 +	(res_inst_tac [("p","p1")] liftE 1),
  31.171 +	(hyp_subst_tac 1),
  31.172 +	(rtac less_lift1a 1),
  31.173 +	(hyp_subst_tac 1),
  31.174 +	(res_inst_tac [("p","p2")] liftE 1),
  31.175 +	(hyp_subst_tac 1),
  31.176 +	(rtac notE 1),
  31.177 +	(rtac less_lift1b 1),
  31.178 +	(atac 1),
  31.179 +	(hyp_subst_tac 1),
  31.180 +	(res_inst_tac [("p","p3")] liftE 1),
  31.181 +	(hyp_subst_tac 1),
  31.182 +	(rtac notE 1),
  31.183 +	(rtac less_lift1b 1),
  31.184 +	(atac 1),
  31.185 +	(hyp_subst_tac 1),
  31.186 +	(rtac (less_lift1c RS iffD2) 1),
  31.187 +	(rtac trans_less 1),
  31.188 +	(etac (less_lift1c RS iffD1) 1),
  31.189 +	(etac (less_lift1c RS iffD1) 1)
  31.190 +	]);
  31.191 +
    32.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    32.2 +++ b/src/HOLCF/Lift1.thy	Wed Jan 19 17:35:01 1994 +0100
    32.3 @@ -0,0 +1,55 @@
    32.4 +(*  Title: 	HOLCF/lift1.thy
    32.5 +    ID:         $Id$
    32.6 +    Author: 	Franz Regensburger
    32.7 +    Copyright   1993  Technische Universitaet Muenchen
    32.8 +
    32.9 +
   32.10 +Lifting
   32.11 +
   32.12 +*)
   32.13 +
   32.14 +Lift1 = Cfun3 +
   32.15 +
   32.16 +(* new type for lifting *)
   32.17 +
   32.18 +types "u" 1
   32.19 +
   32.20 +arities "u" :: (pcpo)term	
   32.21 +
   32.22 +consts
   32.23 +
   32.24 +  Rep_Lift	:: "('a)u => (void + 'a)"
   32.25 +  Abs_Lift	:: "(void + 'a) => ('a)u"
   32.26 +
   32.27 +  Iup           :: "'a => ('a)u"
   32.28 +  UU_lift       :: "('a)u"
   32.29 +  Ilift         :: "('a->'b)=>('a)u => 'b"
   32.30 +  less_lift     :: "('a)u => ('a)u => bool"
   32.31 +
   32.32 +rules
   32.33 +
   32.34 +  (*faking a type definition... *)
   32.35 +  (* ('a)u is isomorphic to void + 'a  *)
   32.36 +
   32.37 +  Rep_Lift_inverse	"Abs_Lift(Rep_Lift(p)) = p"	
   32.38 +  Abs_Lift_inverse	"Rep_Lift(Abs_Lift(p)) = p"
   32.39 +
   32.40 +   (*defining the abstract constants*)
   32.41 +
   32.42 +  UU_lift_def   "UU_lift == Abs_Lift(Inl(UU))"
   32.43 +  Iup_def       "Iup(x)  == Abs_Lift(Inr(x))"
   32.44 +
   32.45 +  Ilift_def     "Ilift(f)(x)==\
   32.46 +\                case  (Rep_Lift(x)) (%y.UU) (%z.f[z])"
   32.47 + 
   32.48 +  less_lift_def "less_lift(x1)(x2) == \
   32.49 +\          (case (Rep_Lift(x1))\
   32.50 +\                (% y1.True)\
   32.51 +\                (% y2.case (Rep_Lift(x2))\
   32.52 +\                           (% z1.False)\
   32.53 +\                           (% z2.y2<<z2)))"
   32.54 +
   32.55 +end
   32.56 +
   32.57 +
   32.58 +
    33.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    33.2 +++ b/src/HOLCF/Lift2.ML	Wed Jan 19 17:35:01 1994 +0100
    33.3 @@ -0,0 +1,182 @@
    33.4 +(*  Title: 	HOLCF/lift2.ML
    33.5 +    ID:         $Id$
    33.6 +    Author: 	Franz Regensburger
    33.7 +    Copyright   1993 Technische Universitaet Muenchen
    33.8 +
    33.9 +Lemmas for lift2.thy 
   33.10 +*)
   33.11 +
   33.12 +open Lift2;
   33.13 +
   33.14 +(* -------------------------------------------------------------------------*)
   33.15 +(* type ('a)u is pointed                                                    *)
   33.16 +(* ------------------------------------------------------------------------ *)
   33.17 +
   33.18 +val minimal_lift = prove_goal Lift2.thy "UU_lift << z"
   33.19 + (fn prems =>
   33.20 +	[
   33.21 +	(rtac (inst_lift_po RS ssubst) 1),
   33.22 +	(rtac less_lift1a 1)
   33.23 +	]);
   33.24 +
   33.25 +(* -------------------------------------------------------------------------*)
   33.26 +(* access to less_lift in class po                                          *)
   33.27 +(* ------------------------------------------------------------------------ *)
   33.28 +
   33.29 +val less_lift2b = prove_goal Lift2.thy "~ Iup(x) << UU_lift"
   33.30 + (fn prems =>
   33.31 +	[
   33.32 +	(rtac (inst_lift_po RS ssubst) 1),
   33.33 +	(rtac less_lift1b 1)
   33.34 +	]);
   33.35 +
   33.36 +val less_lift2c = prove_goal Lift2.thy "(Iup(x)<<Iup(y)) = (x<<y)"
   33.37 + (fn prems =>
   33.38 +	[
   33.39 +	(rtac (inst_lift_po RS ssubst) 1),
   33.40 +	(rtac less_lift1c 1)
   33.41 +	]);
   33.42 +
   33.43 +(* ------------------------------------------------------------------------ *)
   33.44 +(* Iup and Ilift are monotone                                               *)
   33.45 +(* ------------------------------------------------------------------------ *)
   33.46 +
   33.47 +val monofun_Iup = prove_goalw Lift2.thy [monofun] "monofun(Iup)"
   33.48 + (fn prems =>
   33.49 +	[
   33.50 +	(strip_tac 1),
   33.51 +	(etac (less_lift2c RS iffD2) 1)
   33.52 +	]);
   33.53 +
   33.54 +val monofun_Ilift1 = prove_goalw Lift2.thy [monofun] "monofun(Ilift)"
   33.55 + (fn prems =>
   33.56 +	[
   33.57 +	(strip_tac 1),
   33.58 +	(rtac (less_fun RS iffD2) 1),
   33.59 +	(strip_tac 1),
   33.60 +	(res_inst_tac [("p","xa")] liftE 1),
   33.61 +	(asm_simp_tac Lift_ss 1),
   33.62 +	(asm_simp_tac Lift_ss 1),
   33.63 +	(etac monofun_cfun_fun 1)
   33.64 +	]);
   33.65 +
   33.66 +val monofun_Ilift2 = prove_goalw Lift2.thy [monofun] "monofun(Ilift(f))"
   33.67 + (fn prems =>
   33.68 +	[
   33.69 +	(strip_tac 1),
   33.70 +	(res_inst_tac [("p","x")] liftE 1),
   33.71 +	(asm_simp_tac Lift_ss 1),
   33.72 +	(asm_simp_tac Lift_ss 1),
   33.73 +	(res_inst_tac [("p","y")] liftE 1),
   33.74 +	(hyp_subst_tac 1),
   33.75 +	(hyp_subst_tac 1),
   33.76 +	(rtac notE 1),
   33.77 +	(rtac less_lift2b 1),
   33.78 +	(atac 1),
   33.79 +	(asm_simp_tac Lift_ss 1),
   33.80 +	(rtac monofun_cfun_arg 1),
   33.81 +	(hyp_subst_tac 1),
   33.82 +	(hyp_subst_tac 1),
   33.83 +	(etac (less_lift2c  RS iffD1) 1)
   33.84 +	]);
   33.85 +
   33.86 +(* ------------------------------------------------------------------------ *)
   33.87 +(* Some kind of surjectivity lemma                                          *)
   33.88 +(* ------------------------------------------------------------------------ *)
   33.89 +
   33.90 +
   33.91 +val lift_lemma1 = prove_goal Lift2.thy  "z=Iup(x) ==> Iup(Ilift(LAM x.x)(z)) = z"
   33.92 + (fn prems =>
   33.93 +	[
   33.94 +	(cut_facts_tac prems 1),
   33.95 +	(asm_simp_tac Lift_ss 1)
   33.96 +	]);
   33.97 +
   33.98 +(* ------------------------------------------------------------------------ *)
   33.99 +(* ('a)u is a cpo                                                           *)
  33.100 +(* ------------------------------------------------------------------------ *)
  33.101 +
  33.102 +val lub_lift1a = prove_goal Lift2.thy 
  33.103 +"[|is_chain(Y);? i x.Y(i)=Iup(x)|] ==>\
  33.104 +\ range(Y) <<| Iup(lub(range(%i.(Ilift (LAM x.x) (Y(i))))))"
  33.105 + (fn prems =>
  33.106 +	[
  33.107 +	(cut_facts_tac prems 1),
  33.108 +	(rtac is_lubI 1),
  33.109 +	(rtac conjI 1),
  33.110 +	(rtac ub_rangeI 1),
  33.111 +	(rtac allI 1),
  33.112 +	(res_inst_tac [("p","Y(i)")] liftE 1),
  33.113 +	(res_inst_tac [("s","UU_lift"),("t","Y(i)")] subst 1),
  33.114 +	(etac sym 1),
  33.115 +	(rtac minimal_lift 1),
  33.116 +	(res_inst_tac [("t","Y(i)")] (lift_lemma1 RS subst) 1),
  33.117 +	(atac 1),
  33.118 +	(rtac (less_lift2c RS iffD2) 1),
  33.119 +	(rtac is_ub_thelub 1),
  33.120 +	(etac (monofun_Ilift2 RS ch2ch_monofun) 1),
  33.121 +	(strip_tac 1),
  33.122 +	(res_inst_tac [("p","u")] liftE 1),
  33.123 +	(etac exE 1),
  33.124 +	(etac exE 1),
  33.125 +	(res_inst_tac [("P","Y(i)<<UU_lift")] notE 1),
  33.126 +	(res_inst_tac [("s","Iup(x)"),("t","Y(i)")] ssubst 1),
  33.127 +	(atac 1),
  33.128 +	(rtac less_lift2b 1),
  33.129 +	(hyp_subst_tac 1),
  33.130 +	(etac (ub_rangeE RS spec) 1),
  33.131 +	(res_inst_tac [("t","u")] (lift_lemma1 RS subst) 1),
  33.132 +	(atac 1),
  33.133 +	(rtac (less_lift2c RS iffD2) 1),
  33.134 +	(rtac is_lub_thelub 1),
  33.135 +	(etac (monofun_Ilift2 RS ch2ch_monofun) 1),
  33.136 +	(etac (monofun_Ilift2 RS ub2ub_monofun) 1)
  33.137 +	]);
  33.138 +
  33.139 +val lub_lift1b = prove_goal Lift2.thy 
  33.140 +"[|is_chain(Y);!i x.~Y(i)=Iup(x)|] ==>\
  33.141 +\ range(Y) <<| UU_lift"
  33.142 + (fn prems =>
  33.143 +	[
  33.144 +	(cut_facts_tac prems 1),
  33.145 +	(rtac is_lubI 1),
  33.146 +	(rtac conjI 1),
  33.147 +	(rtac ub_rangeI 1),
  33.148 +	(rtac allI 1),
  33.149 +	(res_inst_tac [("p","Y(i)")] liftE 1),
  33.150 +	(res_inst_tac [("s","UU_lift"),("t","Y(i)")] ssubst 1),
  33.151 +	(atac 1),
  33.152 +	(rtac refl_less 1),
  33.153 +	(rtac notE 1),
  33.154 +	(dtac spec 1),
  33.155 +	(dtac spec 1),
  33.156 +	(atac 1),
  33.157 +	(atac 1),
  33.158 +	(strip_tac 1),
  33.159 +	(rtac minimal_lift 1)
  33.160 +	]);
  33.161 +
  33.162 +val thelub_lift1a = lub_lift1a RS thelubI;
  33.163 +(* [| is_chain(?Y1); ? i x. ?Y1(i) = Iup(x) |] ==>                *)
  33.164 +(* lub(range(?Y1)) = Iup(lub(range(%i. Ilift(LAM x. x,?Y1(i)))))  *)
  33.165 +
  33.166 +val thelub_lift1b = lub_lift1b RS thelubI;
  33.167 +(* [| is_chain(?Y1); ! i x. ~ ?Y1(i) = Iup(x) |] ==>              *)
  33.168 +(*                                     lub(range(?Y1)) = UU_lift  *)
  33.169 +
  33.170 +
  33.171 +val cpo_lift = prove_goal Lift2.thy 
  33.172 +	"is_chain(Y::nat=>('a)u) ==> ? x.range(Y) <<|x"
  33.173 + (fn prems =>
  33.174 +	[
  33.175 +	(cut_facts_tac prems 1),
  33.176 +	(rtac disjE 1),
  33.177 +	(rtac exI 2),
  33.178 +	(etac lub_lift1a 2),
  33.179 +	(atac 2),
  33.180 +	(rtac exI 2),
  33.181 +	(etac lub_lift1b 2),
  33.182 +	(atac 2),
  33.183 +	(fast_tac HOL_cs 1)
  33.184 +	]);
  33.185 +
    34.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    34.2 +++ b/src/HOLCF/Lift2.thy	Wed Jan 19 17:35:01 1994 +0100
    34.3 @@ -0,0 +1,25 @@
    34.4 +(*  Title: 	HOLCF/lift2.thy
    34.5 +    ID:         $Id$
    34.6 +    Author: 	Franz Regensburger
    34.7 +    Copyright   1993 Technische Universitaet Muenchen
    34.8 +
    34.9 +Class Instance u::(pcpo)po
   34.10 +
   34.11 +*)
   34.12 +
   34.13 +Lift2 = Lift1 + 
   34.14 +
   34.15 +(* Witness for the above arity axiom is lift1.ML *)
   34.16 +
   34.17 +arities "u" :: (pcpo)po
   34.18 +
   34.19 +rules
   34.20 +
   34.21 +(* instance of << for type ('a)u  *)
   34.22 +
   34.23 +inst_lift_po	"(op <<)::[('a)u,('a)u]=>bool = less_lift"
   34.24 +
   34.25 +end
   34.26 +
   34.27 +
   34.28 +
    35.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    35.2 +++ b/src/HOLCF/Lift3.ML	Wed Jan 19 17:35:01 1994 +0100
    35.3 @@ -0,0 +1,349 @@
    35.4 +(*  Title: 	HOLCF/lift3.ML
    35.5 +    ID:         $Id$
    35.6 +    Author: 	Franz Regensburger
    35.7 +    Copyright   1993 Technische Universitaet Muenchen
    35.8 +
    35.9 +Lemmas for lift3.thy
   35.10 +*)
   35.11 +
   35.12 +open Lift3;
   35.13 +
   35.14 +(* -------------------------------------------------------------------------*)
   35.15 +(* some lemmas restated for class pcpo                                      *)
   35.16 +(* ------------------------------------------------------------------------ *)
   35.17 +
   35.18 +val less_lift3b = prove_goal Lift3.thy "~ Iup(x) << UU"
   35.19 + (fn prems =>
   35.20 +	[
   35.21 +	(rtac (inst_lift_pcpo RS ssubst) 1),
   35.22 +	(rtac less_lift2b 1)
   35.23 +	]);
   35.24 +
   35.25 +val defined_Iup2 = prove_goal Lift3.thy "~ Iup(x) = UU"
   35.26 + (fn prems =>
   35.27 +	[
   35.28 +	(rtac (inst_lift_pcpo RS ssubst) 1),
   35.29 +	(rtac defined_Iup 1)
   35.30 +	]);
   35.31 +
   35.32 +(* ------------------------------------------------------------------------ *)
   35.33 +(* continuity for Iup                                                       *)
   35.34 +(* ------------------------------------------------------------------------ *)
   35.35 +
   35.36 +val contlub_Iup = prove_goal Lift3.thy "contlub(Iup)"
   35.37 + (fn prems =>
   35.38 +	[
   35.39 +	(rtac contlubI 1),
   35.40 +	(strip_tac 1),
   35.41 +	(rtac trans 1),
   35.42 +	(rtac (thelub_lift1a RS sym) 2),
   35.43 +	(fast_tac HOL_cs 3),
   35.44 +	(etac (monofun_Iup RS ch2ch_monofun) 2),
   35.45 +	(res_inst_tac [("f","Iup")] arg_cong  1),
   35.46 +	(rtac lub_equal 1),
   35.47 +	(atac 1),
   35.48 +	(rtac (monofun_Ilift2 RS ch2ch_monofun) 1),
   35.49 +	(etac (monofun_Iup RS ch2ch_monofun) 1),
   35.50 +	(asm_simp_tac Lift_ss 1)
   35.51 +	]);
   35.52 +
   35.53 +val contX_Iup = prove_goal Lift3.thy "contX(Iup)"
   35.54 + (fn prems =>
   35.55 +	[
   35.56 +	(rtac monocontlub2contX 1),
   35.57 +	(rtac monofun_Iup 1),
   35.58 +	(rtac contlub_Iup 1)
   35.59 +	]);
   35.60 +
   35.61 +
   35.62 +(* ------------------------------------------------------------------------ *)
   35.63 +(* continuity for Ilift                                                     *)
   35.64 +(* ------------------------------------------------------------------------ *)
   35.65 +
   35.66 +val contlub_Ilift1 = prove_goal Lift3.thy "contlub(Ilift)"
   35.67 + (fn prems =>
   35.68 +	[
   35.69 +	(rtac contlubI 1),
   35.70 +	(strip_tac 1),
   35.71 +	(rtac trans 1),
   35.72 +	(rtac (thelub_fun RS sym) 2),
   35.73 +	(etac (monofun_Ilift1 RS ch2ch_monofun) 2),
   35.74 +	(rtac ext 1),
   35.75 +	(res_inst_tac [("p","x")] liftE 1),
   35.76 +	(asm_simp_tac Lift_ss 1),
   35.77 +	(rtac (lub_const RS thelubI RS sym) 1),
   35.78 +	(asm_simp_tac Lift_ss 1),
   35.79 +	(etac contlub_cfun_fun 1)
   35.80 +	]);
   35.81 +
   35.82 +
   35.83 +val contlub_Ilift2 = prove_goal Lift3.thy "contlub(Ilift(f))"
   35.84 + (fn prems =>
   35.85 +	[
   35.86 +	(rtac contlubI 1),
   35.87 +	(strip_tac 1),
   35.88 +	(rtac disjE 1),
   35.89 +	(rtac (thelub_lift1a RS ssubst) 2),
   35.90 +	(atac 2),
   35.91 +	(atac 2),
   35.92 +	(asm_simp_tac Lift_ss 2),
   35.93 +	(rtac (thelub_lift1b RS ssubst) 3),
   35.94 +	(atac 3),
   35.95 +	(atac 3),
   35.96 +	(fast_tac HOL_cs 1),
   35.97 +	(asm_simp_tac Lift_ss 2),
   35.98 +	(rtac (chain_UU_I_inverse RS sym) 2),
   35.99 +	(rtac allI 2),
  35.100 +	(res_inst_tac [("p","Y(i)")] liftE 2),
  35.101 +	(asm_simp_tac Lift_ss 2),
  35.102 +	(rtac notE 2),
  35.103 +	(dtac spec 2),
  35.104 +	(etac spec 2),
  35.105 +	(atac 2),
  35.106 +	(rtac (contlub_cfun_arg RS ssubst) 1),
  35.107 +	(etac (monofun_Ilift2 RS ch2ch_monofun) 1),
  35.108 +	(rtac lub_equal2 1),
  35.109 +	(rtac (monofun_fapp2 RS ch2ch_monofun) 2),
  35.110 +	(etac (monofun_Ilift2 RS ch2ch_monofun) 2),
  35.111 +	(etac (monofun_Ilift2 RS ch2ch_monofun) 2),
  35.112 +	(rtac (chain_mono2 RS exE) 1),
  35.113 +	(atac 2),
  35.114 +	(etac exE 1),
  35.115 +	(etac exE 1),
  35.116 +	(rtac exI 1),
  35.117 +	(res_inst_tac [("s","Iup(x)"),("t","Y(i)")] ssubst 1),
  35.118 +	(atac 1),
  35.119 +	(rtac defined_Iup2 1),
  35.120 +	(rtac exI 1),
  35.121 +	(strip_tac 1),
  35.122 +	(res_inst_tac [("p","Y(i)")] liftE 1),
  35.123 +	(asm_simp_tac Lift_ss 2),
  35.124 +	(res_inst_tac [("P","Y(i) = UU")] notE 1),
  35.125 +	(fast_tac HOL_cs 1),
  35.126 +	(rtac (inst_lift_pcpo RS ssubst) 1),
  35.127 +	(atac 1)
  35.128 +	]);
  35.129 +
  35.130 +val contX_Ilift1 = prove_goal Lift3.thy "contX(Ilift)"
  35.131 + (fn prems =>
  35.132 +	[
  35.133 +	(rtac monocontlub2contX 1),
  35.134 +	(rtac monofun_Ilift1 1),
  35.135 +	(rtac contlub_Ilift1 1)
  35.136 +	]);
  35.137 +
  35.138 +val contX_Ilift2 = prove_goal Lift3.thy "contX(Ilift(f))"
  35.139 + (fn prems =>
  35.140 +	[
  35.141 +	(rtac monocontlub2contX 1),
  35.142 +	(rtac monofun_Ilift2 1),
  35.143 +	(rtac contlub_Ilift2 1)
  35.144 +	]);
  35.145 +
  35.146 +
  35.147 +(* ------------------------------------------------------------------------ *)
  35.148 +(* continuous versions of lemmas for ('a)u                                  *)
  35.149 +(* ------------------------------------------------------------------------ *)
  35.150 +
  35.151 +val Exh_Lift1 = prove_goalw Lift3.thy [up_def] "z = UU | (? x. z = up[x])"
  35.152 + (fn prems =>
  35.153 +	[
  35.154 +	(simp_tac (Lift_ss addsimps [contX_Iup]) 1),
  35.155 +	(rtac (inst_lift_pcpo RS ssubst) 1),
  35.156 +	(rtac Exh_Lift 1)
  35.157 +	]);
  35.158 +
  35.159 +val inject_up = prove_goalw Lift3.thy [up_def] "up[x]=up[y] ==> x=y"
  35.160 + (fn prems =>
  35.161 +	[
  35.162 +	(cut_facts_tac prems 1),
  35.163 +	(rtac inject_Iup 1),
  35.164 +	(etac box_equals 1),
  35.165 +	(simp_tac (Lift_ss addsimps [contX_Iup]) 1),
  35.166 +	(simp_tac (Lift_ss addsimps [contX_Iup]) 1)
  35.167 +	]);
  35.168 +
  35.169 +val defined_up = prove_goalw Lift3.thy [up_def] "~ up[x]=UU"
  35.170 + (fn prems =>
  35.171 +	[
  35.172 +	(simp_tac (Lift_ss addsimps [contX_Iup]) 1),
  35.173 +	(rtac defined_Iup2 1)
  35.174 +	]);
  35.175 +
  35.176 +val liftE1 = prove_goalw Lift3.thy [up_def] 
  35.177 +	"[| p=UU ==> Q; !!x. p=up[x]==>Q|] ==>Q"
  35.178 + (fn prems =>
  35.179 +	[
  35.180 +	(rtac liftE 1),
  35.181 +	(resolve_tac prems 1),
  35.182 +	(etac (inst_lift_pcpo RS ssubst) 1),
  35.183 +	(resolve_tac (tl prems) 1),
  35.184 +	(asm_simp_tac (Lift_ss addsimps [contX_Iup]) 1)
  35.185 +	]);
  35.186 +
  35.187 +
  35.188 +val lift1 = prove_goalw Lift3.thy [up_def,lift_def] "lift[f][UU]=UU"
  35.189 + (fn prems =>
  35.190 +	[
  35.191 +	(rtac (inst_lift_pcpo RS ssubst) 1),
  35.192 +	(rtac (beta_cfun RS ssubst) 1),
  35.193 +	(REPEAT (resolve_tac (contX_lemmas @ [contX_Iup,contX_Ilift1,
  35.194 +		contX_Ilift2,contX2contX_CF1L]) 1)),
  35.195 +	(rtac (beta_cfun RS ssubst) 1),
  35.196 +	(REPEAT (resolve_tac (contX_lemmas @ [contX_Iup,contX_Ilift1,
  35.197 +		contX_Ilift2,contX2contX_CF1L]) 1)),
  35.198 +	(simp_tac (Lift_ss addsimps [contX_Iup,contX_Ilift1,contX_Ilift2]) 1)
  35.199 +	]);
  35.200 +
  35.201 +val lift2 = prove_goalw Lift3.thy [up_def,lift_def] "lift[f][up[x]]=f[x]"
  35.202 + (fn prems =>
  35.203 +	[
  35.204 +	(rtac (beta_cfun RS ssubst) 1),
  35.205 +	(rtac contX_Iup 1),
  35.206 +	(rtac (beta_cfun RS ssubst) 1),
  35.207 +	(REPEAT (resolve_tac (contX_lemmas @ [contX_Iup,contX_Ilift1,
  35.208 +		contX_Ilift2,contX2contX_CF1L]) 1)),
  35.209 +	(rtac (beta_cfun RS ssubst) 1),
  35.210 +	(rtac contX_Ilift2 1),
  35.211 +	(simp_tac (Lift_ss addsimps [contX_Iup,contX_Ilift1,contX_Ilift2]) 1)
  35.212 +	]);
  35.213 +
  35.214 +val less_lift4b = prove_goalw Lift3.thy [up_def,lift_def] "~ up[x] << UU"
  35.215 + (fn prems =>
  35.216 +	[
  35.217 +	(simp_tac (Lift_ss addsimps [contX_Iup]) 1),
  35.218 +	(rtac less_lift3b 1)
  35.219 +	]);
  35.220 +
  35.221 +val less_lift4c = prove_goalw Lift3.thy [up_def,lift_def]
  35.222 +	 "(up[x]<<up[y]) = (x<<y)"
  35.223 + (fn prems =>
  35.224 +	[
  35.225 +	(simp_tac (Lift_ss addsimps [contX_Iup]) 1),
  35.226 +	(rtac less_lift2c 1)
  35.227 +	]);
  35.228 +
  35.229 +val thelub_lift2a = prove_goalw Lift3.thy [up_def,lift_def] 
  35.230 +"[| is_chain(Y); ? i x. Y(i) = up[x] |] ==>\
  35.231 +\      lub(range(Y)) = up[lub(range(%i. lift[LAM x. x][Y(i)]))]"
  35.232 + (fn prems =>
  35.233 +	[
  35.234 +	(cut_facts_tac prems 1),
  35.235 +	(rtac (beta_cfun RS ssubst) 1),
  35.236 +	(REPEAT (resolve_tac (contX_lemmas @ [contX_Iup,contX_Ilift1,
  35.237 +		contX_Ilift2,contX2contX_CF1L]) 1)),
  35.238 +	(rtac (beta_cfun RS ssubst) 1),
  35.239 +	(REPEAT (resolve_tac (contX_lemmas @ [contX_Iup,contX_Ilift1,
  35.240 +		contX_Ilift2,contX2contX_CF1L]) 1)),
  35.241 +
  35.242 +	(rtac (beta_cfun RS ext RS ssubst) 1),
  35.243 +	(REPEAT (resolve_tac (contX_lemmas @ [contX_Iup,contX_Ilift1,
  35.244 +		contX_Ilift2,contX2contX_CF1L]) 1)),
  35.245 +	(rtac thelub_lift1a 1),
  35.246 +	(atac 1),
  35.247 +	(etac exE 1),
  35.248 +	(etac exE 1),
  35.249 +	(rtac exI 1),
  35.250 +	(rtac exI 1),
  35.251 +	(etac box_equals 1),
  35.252 +	(rtac refl 1),
  35.253 +	(simp_tac (Lift_ss addsimps [contX_Iup]) 1)
  35.254 +	]);
  35.255 +
  35.256 +
  35.257 +
  35.258 +val thelub_lift2b = prove_goalw Lift3.thy [up_def,lift_def] 
  35.259 +"[| is_chain(Y); ! i x. ~ Y(i) = up[x] |] ==> lub(range(Y)) = UU"
  35.260 + (fn prems =>
  35.261 +	[
  35.262 +	(cut_facts_tac prems 1),
  35.263 +	(rtac (inst_lift_pcpo RS ssubst) 1),
  35.264 +	(rtac thelub_lift1b 1),
  35.265 +	(atac 1),
  35.266 +	(strip_tac 1),
  35.267 +	(dtac spec 1),
  35.268 +	(dtac spec 1),
  35.269 +	(rtac swap 1),
  35.270 +	(atac 1),
  35.271 +	(dtac notnotD 1),
  35.272 +	(etac box_equals 1),
  35.273 +	(rtac refl 1),
  35.274 +	(simp_tac (Lift_ss addsimps [contX_Iup]) 1)
  35.275 +	]);
  35.276 +
  35.277 +
  35.278 +val lift_lemma2 = prove_goal Lift3.thy  " (? x.z = up[x]) = (~z=UU)"
  35.279 + (fn prems =>
  35.280 +	[
  35.281 +	(rtac iffI 1),
  35.282 +	(etac exE 1),
  35.283 +	(hyp_subst_tac 1),
  35.284 +	(rtac defined_up 1),
  35.285 +	(res_inst_tac [("p","z")] liftE1 1),
  35.286 +	(etac notE 1),
  35.287 +	(atac 1),
  35.288 +	(etac exI 1)
  35.289 +	]);
  35.290 +
  35.291 +
  35.292 +val thelub_lift2a_rev = prove_goal Lift3.thy  
  35.293 +"[| is_chain(Y); lub(range(Y)) = up[x] |] ==> ? i x. Y(i) = up[x]"
  35.294 + (fn prems =>
  35.295 +	[
  35.296 +	(cut_facts_tac prems 1),
  35.297 +	(rtac exE 1),
  35.298 +	(rtac chain_UU_I_inverse2 1),
  35.299 +	(rtac (lift_lemma2 RS iffD1) 1),
  35.300 +	(etac exI 1),
  35.301 +	(rtac exI 1),
  35.302 +	(rtac (lift_lemma2 RS iffD2) 1),
  35.303 +	(atac 1)
  35.304 +	]);
  35.305 +
  35.306 +val thelub_lift2b_rev = prove_goal Lift3.thy  
  35.307 +"[| is_chain(Y); lub(range(Y)) = UU |] ==> ! i x. ~ Y(i) = up[x]"
  35.308 + (fn prems =>
  35.309 +	[
  35.310 +	(cut_facts_tac prems 1),
  35.311 +	(rtac allI 1),
  35.312 +	(rtac (notex2all RS iffD1) 1),
  35.313 +	(rtac contrapos 1),
  35.314 +	(etac (lift_lemma2 RS iffD1) 2),
  35.315 +	(rtac notnotI 1),
  35.316 +	(rtac (chain_UU_I RS spec) 1),
  35.317 +	(atac 1),
  35.318 +	(atac 1)
  35.319 +	]);
  35.320 +
  35.321 +
  35.322 +val thelub_lift3 = prove_goal Lift3.thy  
  35.323 +"is_chain(Y) ==> lub(range(Y)) = UU |\
  35.324 +\                lub(range(Y)) = up[lub(range(%i. lift[LAM x. x][Y(i)]))]"
  35.325 + (fn prems =>
  35.326 +	[
  35.327 +	(cut_facts_tac prems 1),
  35.328 +	(rtac disjE 1),
  35.329 +	(rtac disjI1 2),
  35.330 +	(rtac thelub_lift2b 2),
  35.331 +	(atac 2),
  35.332 +	(atac 2),
  35.333 +	(rtac disjI2 2),
  35.334 +	(rtac thelub_lift2a 2),
  35.335 +	(atac 2),
  35.336 +	(atac 2),
  35.337 +	(fast_tac HOL_cs 1)
  35.338 +	]);
  35.339 +
  35.340 +val lift3 = prove_goal Lift3.thy "lift[up][x]=x"
  35.341 + (fn prems =>
  35.342 +	[
  35.343 +	(res_inst_tac [("p","x")] liftE1 1),
  35.344 +	(asm_simp_tac (Cfun_ss addsimps [lift1,lift2]) 1),
  35.345 +	(asm_simp_tac (Cfun_ss addsimps [lift1,lift2]) 1)
  35.346 +	]);
  35.347 +
  35.348 +(* ------------------------------------------------------------------------ *)
  35.349 +(* install simplifier for ('a)u                                             *)
  35.350 +(* ------------------------------------------------------------------------ *)
  35.351 +
  35.352 +val lift_rews = [lift1,lift2,defined_up];
    36.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    36.2 +++ b/src/HOLCF/Lift3.thy	Wed Jan 19 17:35:01 1994 +0100
    36.3 @@ -0,0 +1,29 @@
    36.4 +(*  Title: 	HOLCF/lift3.thy
    36.5 +    ID:         $Id$
    36.6 +    Author: 	Franz Regensburger
    36.7 +    Copyright   1993 Technische Universitaet Muenchen
    36.8 +
    36.9 +
   36.10 +Class instance of  ('a)u for class pcpo
   36.11 +
   36.12 +*)
   36.13 +
   36.14 +Lift3 = Lift2 +
   36.15 +
   36.16 +arities "u" :: (pcpo)pcpo			(* Witness lift2.ML *)
   36.17 +
   36.18 +consts  
   36.19 +	up	     :: "'a -> ('a)u" 
   36.20 +	lift         :: "('a->'c)-> ('a)u -> 'c"
   36.21 +
   36.22 +rules 
   36.23 +
   36.24 +inst_lift_pcpo	"UU::('a)u = UU_lift"
   36.25 +
   36.26 +up_def		"up     == (LAM x.Iup(x))"
   36.27 +lift_def	"lift   == (LAM f p.Ilift(f)(p))"
   36.28 +
   36.29 +end
   36.30 +
   36.31 +
   36.32 +
    37.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    37.2 +++ b/src/HOLCF/Makefile	Wed Jan 19 17:35:01 1994 +0100
    37.3 @@ -0,0 +1,49 @@
    37.4 +############################################################################
    37.5 +#                                                                          #
    37.6 +#                   Makefile for Isabelle (HOLCF)                          #
    37.7 +#                                                                          #
    37.8 +############################################################################
    37.9 +
   37.10 +#To make the system, cd to this directory and type  
   37.11 +#	make -f Makefile 
   37.12 +
   37.13 +#Environment variable ISABELLECOMP specifies the compiler.
   37.14 +#Environment variable ISABELLEBIN specifies the destination directory.
   37.15 +#For Poly/ML, ISABELLEBIN must begin with a /
   37.16 +
   37.17 +#Makes HOL Isabelle if this file is ABSENT -- but not 
   37.18 +#if it is out of date, since this Makefile does not know its dependencies!
   37.19 +
   37.20 +BIN = $(ISABELLEBIN)
   37.21 +COMP = $(ISABELLECOMP)
   37.22 +FILES = ROOT.ML void.thy void.ML porder.thy porder.ML pcpo.thy \
   37.23 +	pcpo.ML fun1.thy fun1.ML fun2.thy fun2.ML fun3.thy fun3.ML \
   37.24 +	cfun1.thy cfun1.ML cfun2.thy cfun2.ML cfun3.thy cfun3.ML \
   37.25 +	cinfix.ML\
   37.26 +	sprod0.thy sprod0.ML sprod1.thy sprod1.ML sprod2.thy sprod2.ML\
   37.27 +	sprod3.thy sprod3.ML
   37.28 +
   37.29 +EX_FILES = ex/coind.thy ex/coind.ML \
   37.30 +           ex/hoare.thy ex/hoare.ML ex/loop.thy ex/loop.ML
   37.31 +
   37.32 +$(BIN)/HOLCF:   $(BIN)/HOL  $(FILES) 
   37.33 +	case "$(COMP)" in \
   37.34 +	poly*)  echo 'make_database"$(BIN)/HOLCF"; quit();'  \
   37.35 +		     | $(COMP) $(BIN)/HOL ;\
   37.36 +		echo 'use"ROOT";' | $(COMP) $(BIN)/HOLCF ;;\
   37.37 +	sml*)	echo 'use"ROOT.ML"; xML"$(BIN)/HOLCF" banner;' | $(BIN)/HOL ;;\
   37.38 +	*)	echo Bad value for ISABELLECOMP;;\
   37.39 +	esac
   37.40 +
   37.41 +$(BIN)/HOL:
   37.42 +	cd ../HOL;  $(MAKE)
   37.43 +
   37.44 +test:   ex/ROOT.ML  $(BIN)/HOLCF  $(EX_FILES) 
   37.45 +	case "$(COMP)" in \
   37.46 +	poly*)	echo 'use"ex/ROOT.ML"; quit();' | $(COMP) $(BIN)/HOLCF ;;\
   37.47 +	sml*)	echo 'use"ex/ROOT.ML"' | $(BIN)/HOLCF;;\
   37.48 +	*)	echo Bad value for ISABELLECOMP;;\
   37.49 +	esac
   37.50 +
   37.51 +.PRECIOUS:  $(BIN)/HOL  $(BIN)/HOLCF 
   37.52 +
    38.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    38.2 +++ b/src/HOLCF/One.ML	Wed Jan 19 17:35:01 1994 +0100
    38.3 @@ -0,0 +1,96 @@
    38.4 +(*  Title: 	HOLCF/one.thy
    38.5 +    ID:         $Id$
    38.6 +    Author: 	Franz Regensburger
    38.7 +    Copyright   1993 Technische Universitaet Muenchen
    38.8 +
    38.9 +Lemmas for one.thy 
   38.10 +*)
   38.11 +
   38.12 +open One;
   38.13 +
   38.14 +(* ------------------------------------------------------------------------ *)
   38.15 +(* Exhaustion and Elimination for type one                                  *)
   38.16 +(* ------------------------------------------------------------------------ *)
   38.17 +
   38.18 +val Exh_one = prove_goalw One.thy [one_def] "z=UU | z = one"
   38.19 + (fn prems =>
   38.20 +	[
   38.21 +	(res_inst_tac [("p","rep_one[z]")] liftE1 1),
   38.22 +	(rtac disjI1 1),
   38.23 +	(rtac ((abs_one_iso RS allI) RS ((rep_one_iso RS allI) RS iso_strict )
   38.24 +		RS conjunct2 RS subst) 1),
   38.25 +	(rtac (abs_one_iso RS subst) 1),
   38.26 +	(etac cfun_arg_cong 1),
   38.27 +	(rtac disjI2 1),
   38.28 +	(rtac (abs_one_iso RS subst) 1),
   38.29 +	(rtac cfun_arg_cong 1),
   38.30 +	(rtac (unique_void2 RS subst) 1),
   38.31 +	(atac 1)
   38.32 +	]);
   38.33 +
   38.34 +val oneE = prove_goal One.thy
   38.35 +	"[| p=UU ==> Q; p = one ==>Q|] ==>Q"
   38.36 + (fn prems =>
   38.37 +	[
   38.38 +	(rtac (Exh_one RS disjE) 1),
   38.39 +	(eresolve_tac prems 1),
   38.40 +	(eresolve_tac prems 1)
   38.41 +	]);
   38.42 +
   38.43 +(* ------------------------------------------------------------------------ *)
   38.44 +(* distinctness for type one : stored in a list                             *)
   38.45 +(* ------------------------------------------------------------------------ *)
   38.46 +
   38.47 +val dist_less_one = [
   38.48 +prove_goalw One.thy [one_def] "~one << UU"
   38.49 + (fn prems =>
   38.50 +	[
   38.51 +	(rtac classical3 1),
   38.52 +	(rtac less_lift4b 1),
   38.53 +	(rtac (rep_one_iso RS subst) 1),
   38.54 +	(rtac (rep_one_iso RS subst) 1),
   38.55 +	(rtac monofun_cfun_arg 1),
   38.56 +	(etac ((abs_one_iso RS allI) RS ((rep_one_iso RS allI) RS iso_strict ) 
   38.57 +		RS conjunct2 RS ssubst) 1)
   38.58 +	])
   38.59 +];
   38.60 +
   38.61 +val  dist_eq_one = [prove_goal One.thy "~one=UU"
   38.62 + (fn prems =>
   38.63 +	[
   38.64 +	(rtac not_less2not_eq 1),
   38.65 +	(resolve_tac dist_less_one 1)
   38.66 +	])];
   38.67 +
   38.68 +val dist_eq_one = dist_eq_one @ (map (fn thm => (thm RS not_sym)) dist_eq_one);
   38.69 +
   38.70 +(* ------------------------------------------------------------------------ *)
   38.71 +(* one is flat                                                              *)
   38.72 +(* ------------------------------------------------------------------------ *)
   38.73 +
   38.74 +val prems = goalw One.thy [flat_def] "flat(one)";
   38.75 +by (rtac allI 1);
   38.76 +by (rtac allI 1);
   38.77 +by (res_inst_tac [("p","x")] oneE 1);
   38.78 +by (asm_simp_tac ccc1_ss  1);
   38.79 +by (res_inst_tac [("p","y")] oneE 1);
   38.80 +by (asm_simp_tac (ccc1_ss addsimps dist_less_one) 1);
   38.81 +by (asm_simp_tac ccc1_ss  1);
   38.82 +val flat_one = result();
   38.83 +
   38.84 +
   38.85 +(* ------------------------------------------------------------------------ *)
   38.86 +(* properties of one_when                                                   *)
   38.87 +(* here I tried a generic prove procedure                                   *)
   38.88 +(* ------------------------------------------------------------------------ *)
   38.89 +
   38.90 +fun prover s =  prove_goalw One.thy [one_when_def,one_def] s
   38.91 + (fn prems =>
   38.92 +	[
   38.93 +	(simp_tac (ccc1_ss addsimps [(rep_one_iso ),
   38.94 +	(abs_one_iso RS allI) RS ((rep_one_iso RS allI) 
   38.95 +	RS iso_strict) RS conjunct1] )1)
   38.96 +	]);
   38.97 +
   38.98 +val one_when = map prover ["one_when[x][UU] = UU","one_when[x][one] = x"];
   38.99 +
    39.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    39.2 +++ b/src/HOLCF/One.thy	Wed Jan 19 17:35:01 1994 +0100
    39.3 @@ -0,0 +1,53 @@
    39.4 +(*  Title: 	HOLCF/one.thy
    39.5 +    ID:         $Id$
    39.6 +    Author: 	Franz Regensburger
    39.7 +    Copyright   1993 Technische Universitaet Muenchen
    39.8 +
    39.9 +Introduve atomic type one = (void)u
   39.10 +
   39.11 +This is the first type that is introduced using a domain isomorphism.
   39.12 +The type axiom 
   39.13 +
   39.14 +	arities one :: pcpo
   39.15 +
   39.16 +and the continuity of the Isomorphisms are taken for granted. Since the
   39.17 +type is not recursive, it could be easily introduced in a purely conservative
   39.18 +style as it was used for the types sprod, ssum, lift. The definition of the 
   39.19 +ordering is canonical using abstraction and representation, but this would take
   39.20 +again a lot of internal constants. It can easily be seen that the axioms below
   39.21 +are consistent.
   39.22 +
   39.23 +The partial ordering on type one is implicitly defined via the
   39.24 +isomorphism axioms and the continuity of abs_one and rep_one.
   39.25 +
   39.26 +We could also introduce the function less_one with definition
   39.27 +
   39.28 +less_one(x,y) = rep_one[x] << rep_one[y]
   39.29 +
   39.30 +
   39.31 +*)
   39.32 +
   39.33 +One = ccc1+
   39.34 +
   39.35 +types one 0
   39.36 +arities one :: pcpo
   39.37 +
   39.38 +consts
   39.39 +	abs_one		:: "(void)u -> one"
   39.40 +	rep_one		:: "one -> (void)u"
   39.41 +	one 		:: "one"
   39.42 +	one_when 	:: "'c -> one -> 'c"
   39.43 +
   39.44 +rules
   39.45 +  abs_one_iso	"abs_one[rep_one[u]] = u"
   39.46 +  rep_one_iso  "rep_one[abs_one[x]] = x"
   39.47 +
   39.48 +  one_def	"one == abs_one[up[UU]]"
   39.49 +  one_when_def "one_when == (LAM c u.lift[LAM x.c][rep_one[u]])"
   39.50 +
   39.51 +end
   39.52 +
   39.53 +
   39.54 +
   39.55 +
   39.56 +
    40.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    40.2 +++ b/src/HOLCF/Pcpo.ML	Wed Jan 19 17:35:01 1994 +0100
    40.3 @@ -0,0 +1,272 @@
    40.4 +(*  Title: 	HOLCF/pcpo.ML
    40.5 +    ID:         $Id$
    40.6 +    Author: 	Franz Regensburger
    40.7 +    Copyright   1993 Technische Universitaet Muenchen
    40.8 +
    40.9 +Lemmas for pcpo.thy
   40.10 +*)
   40.11 + 
   40.12 +open Pcpo;
   40.13 +
   40.14 +(* ------------------------------------------------------------------------ *)
   40.15 +(* in pcpo's everthing equal to THE lub has lub properties for every chain  *)
   40.16 +(* ------------------------------------------------------------------------ *)
   40.17 +
   40.18 +val thelubE = prove_goal  Pcpo.thy 
   40.19 +	"[| is_chain(S);lub(range(S)) = l::'a::pcpo|] ==> range(S) <<| l "
   40.20 +(fn prems =>
   40.21 +	[
   40.22 +	(cut_facts_tac prems 1), 
   40.23 +	(hyp_subst_tac 1),
   40.24 +	(rtac lubI 1),
   40.25 +	(etac cpo 1)
   40.26 +	]);
   40.27 +
   40.28 +(* ------------------------------------------------------------------------ *)
   40.29 +(* Properties of the lub                                                    *)
   40.30 +(* ------------------------------------------------------------------------ *)
   40.31 +
   40.32 +
   40.33 +val is_ub_thelub = (cpo RS lubI RS is_ub_lub);
   40.34 +(* is_chain(?S1) ==> ?S1(?x) << lub(range(?S1))                             *)
   40.35 +
   40.36 +val is_lub_thelub = (cpo RS lubI RS is_lub_lub);
   40.37 +(* [| is_chain(?S5); range(?S5) <| ?x1 |] ==> lub(range(?S5)) << ?x1        *)
   40.38 +
   40.39 +
   40.40 +(* ------------------------------------------------------------------------ *)
   40.41 +(* the << relation between two chains is preserved by their lubs            *)
   40.42 +(* ------------------------------------------------------------------------ *)
   40.43 +
   40.44 +val lub_mono = prove_goal Pcpo.thy 
   40.45 +	"[|is_chain(C1::(nat=>'a::pcpo));is_chain(C2); ! k. C1(k) << C2(k)|]\
   40.46 +\           ==> lub(range(C1)) << lub(range(C2))"
   40.47 +(fn prems =>
   40.48 +	[
   40.49 +	(cut_facts_tac prems 1),
   40.50 +	(etac is_lub_thelub 1),
   40.51 +	(rtac ub_rangeI 1),
   40.52 +	(rtac allI 1),
   40.53 +	(rtac trans_less 1),
   40.54 +	(etac spec 1),
   40.55 +	(etac is_ub_thelub 1)
   40.56 +	]);
   40.57 +
   40.58 +(* ------------------------------------------------------------------------ *)
   40.59 +(* the = relation between two chains is preserved by their lubs            *)
   40.60 +(* ------------------------------------------------------------------------ *)
   40.61 +
   40.62 +val lub_equal = prove_goal Pcpo.thy
   40.63 +"[| is_chain(C1::(nat=>'a::pcpo));is_chain(C2);!k.C1(k)=C2(k)|]\
   40.64 +\	==> lub(range(C1))=lub(range(C2))"
   40.65 +(fn prems =>
   40.66 +	[
   40.67 +	(cut_facts_tac prems 1),
   40.68 +	(rtac antisym_less 1),
   40.69 +	(rtac lub_mono 1),
   40.70 +	(atac 1),
   40.71 +	(atac 1),
   40.72 +	(strip_tac 1),
   40.73 +	(rtac (antisym_less_inverse RS conjunct1) 1),
   40.74 +	(etac spec 1),
   40.75 +	(rtac lub_mono 1),
   40.76 +	(atac 1),
   40.77 +	(atac 1),
   40.78 +	(strip_tac 1),
   40.79 +	(rtac (antisym_less_inverse RS conjunct2) 1),
   40.80 +	(etac spec 1)
   40.81 +	]);
   40.82 +
   40.83 +(* ------------------------------------------------------------------------ *)
   40.84 +(* more results about mono and = of lubs of chains                          *)
   40.85 +(* ------------------------------------------------------------------------ *)
   40.86 +
   40.87 +val lub_mono2 = prove_goal Pcpo.thy 
   40.88 +"[|? j.!i. j<i --> X(i::nat)=Y(i);is_chain(X::nat=>'a::pcpo);is_chain(Y)|]\
   40.89 +\ ==> lub(range(X))<<lub(range(Y))"
   40.90 + (fn prems =>
   40.91 +	[
   40.92 +	(rtac  exE 1),
   40.93 +	(resolve_tac prems 1),
   40.94 +	(rtac is_lub_thelub 1),
   40.95 +	(resolve_tac prems 1),
   40.96 +	(rtac ub_rangeI 1),
   40.97 +	(strip_tac 1),
   40.98 +	(res_inst_tac [("Q","x<i")] classical2 1),
   40.99 +	(res_inst_tac [("s","Y(i)"),("t","X(i)")] subst 1),
  40.100 +	(rtac sym 1),
  40.101 +	(fast_tac HOL_cs 1),
  40.102 +	(rtac is_ub_thelub 1),
  40.103 +	(resolve_tac prems 1),
  40.104 +	(res_inst_tac [("y","X(Suc(x))")] trans_less 1),
  40.105 +	(rtac (chain_mono RS mp) 1),
  40.106 +	(resolve_tac prems 1),
  40.107 +	(rtac (not_less_eq RS subst) 1),
  40.108 +	(atac 1),
  40.109 +	(res_inst_tac [("s","Y(Suc(x))"),("t","X(Suc(x))")] subst 1),
  40.110 +	(rtac sym 1),
  40.111 +	(asm_simp_tac nat_ss 1),
  40.112 +	(rtac is_ub_thelub 1),
  40.113 +	(resolve_tac prems 1)
  40.114 +	]);
  40.115 +
  40.116 +val lub_equal2 = prove_goal Pcpo.thy 
  40.117 +"[|? j.!i. j<i --> X(i)=Y(i);is_chain(X::nat=>'a::pcpo);is_chain(Y)|]\
  40.118 +\ ==> lub(range(X))=lub(range(Y))"
  40.119 + (fn prems =>
  40.120 +	[
  40.121 +	(rtac antisym_less 1),
  40.122 +	(rtac lub_mono2 1),
  40.123 +	(REPEAT (resolve_tac prems 1)),
  40.124 +	(cut_facts_tac prems 1),
  40.125 +	(rtac lub_mono2 1),
  40.126 +	(safe_tac HOL_cs),
  40.127 +	(step_tac HOL_cs 1),
  40.128 +	(safe_tac HOL_cs),
  40.129 +	(rtac sym 1),
  40.130 +	(fast_tac HOL_cs 1)
  40.131 +	]);
  40.132 +
  40.133 +val lub_mono3 = prove_goal Pcpo.thy "[|is_chain(Y::nat=>'a::pcpo);is_chain(X);\
  40.134 +\! i. ? j. Y(i)<< X(j)|]==> lub(range(Y))<<lub(range(X))"
  40.135 + (fn prems =>
  40.136 +	[
  40.137 +	(cut_facts_tac prems 1),
  40.138 +	(rtac is_lub_thelub 1),
  40.139 +	(atac 1),
  40.140 +	(rtac ub_rangeI 1),
  40.141 +	(strip_tac 1),
  40.142 +	(etac allE 1),
  40.143 +	(etac exE 1),
  40.144 +	(rtac trans_less 1),
  40.145 +	(rtac is_ub_thelub 2),
  40.146 +	(atac 2),
  40.147 +	(atac 1)
  40.148 +	]);
  40.149 +
  40.150 +(* ------------------------------------------------------------------------ *)
  40.151 +(* usefull lemmas about UU                                                  *)
  40.152 +(* ------------------------------------------------------------------------ *)
  40.153 +
  40.154 +val eq_UU_iff = prove_goal Pcpo.thy "(x=UU)=(x<<UU)"
  40.155 + (fn prems =>
  40.156 +	[
  40.157 +	(rtac iffI 1),
  40.158 +	(hyp_subst_tac 1),
  40.159 +	(rtac refl_less 1),
  40.160 +	(rtac antisym_less 1),
  40.161 +	(atac 1),
  40.162 +	(rtac minimal 1)
  40.163 +	]);
  40.164 +
  40.165 +val UU_I = prove_goal Pcpo.thy "x << UU ==> x = UU"
  40.166 + (fn prems =>
  40.167 +	[
  40.168 +	(rtac (eq_UU_iff RS ssubst) 1),
  40.169 +	(resolve_tac prems 1)
  40.170 +	]);
  40.171 +
  40.172 +val not_less2not_eq = prove_goal Pcpo.thy "~x<<y ==> ~x=y"
  40.173 + (fn prems =>
  40.174 +	[
  40.175 +	(cut_facts_tac prems 1),
  40.176 +	(rtac classical3 1),
  40.177 +	(atac 1),
  40.178 +	(hyp_subst_tac 1),
  40.179 +	(rtac refl_less 1)
  40.180 +	]);
  40.181 +
  40.182 +
  40.183 +val chain_UU_I = prove_goal Pcpo.thy
  40.184 +	"[|is_chain(Y);lub(range(Y))=UU|] ==> ! i.Y(i)=UU"
  40.185 +(fn prems =>
  40.186 +	[
  40.187 +	(cut_facts_tac prems 1),
  40.188 +	(rtac allI 1),
  40.189 +	(rtac antisym_less 1),
  40.190 +	(rtac minimal 2),
  40.191 +	(res_inst_tac [("t","UU")] subst 1),
  40.192 +	(atac 1),
  40.193 +	(etac is_ub_thelub 1)
  40.194 +	]);
  40.195 +
  40.196 +
  40.197 +val chain_UU_I_inverse = prove_goal Pcpo.thy 
  40.198 +	"!i.Y(i::nat)=UU ==> lub(range(Y::(nat=>'a::pcpo)))=UU"
  40.199 +(fn prems =>
  40.200 +	[
  40.201 +	(cut_facts_tac prems 1),
  40.202 +	(rtac lub_chain_maxelem 1),
  40.203 +	(rtac is_chainI 1),
  40.204 +	(rtac allI 1),
  40.205 +	(res_inst_tac [("s","UU"),("t","Y(i)")] subst 1),
  40.206 +	(rtac sym 1),
  40.207 +	(etac spec 1),
  40.208 +	(rtac minimal 1),
  40.209 +	(rtac exI 1),
  40.210 +	(etac spec 1),
  40.211 +	(rtac allI 1),
  40.212 +	(rtac (antisym_less_inverse RS conjunct1) 1),
  40.213 +	(etac spec 1)
  40.214 +	]);
  40.215 +
  40.216 +val chain_UU_I_inverse2 = prove_goal Pcpo.thy 
  40.217 +	"~lub(range(Y::(nat=>'a::pcpo)))=UU ==> ? i.~ Y(i)=UU"
  40.218 + (fn prems =>
  40.219 +	[
  40.220 +	(cut_facts_tac prems 1),
  40.221 +	(rtac (notall2ex RS iffD1) 1),
  40.222 +	(rtac swap 1),
  40.223 +	(rtac chain_UU_I_inverse 2),
  40.224 +	(etac notnotD 2),
  40.225 +	(atac 1)
  40.226 +	]);
  40.227 +
  40.228 +
  40.229 +val notUU_I = prove_goal Pcpo.thy "[| x<<y; ~x=UU |] ==> ~y=UU"
  40.230 +(fn prems =>
  40.231 +	[
  40.232 +	(cut_facts_tac prems 1),
  40.233 +	(etac contrapos 1),
  40.234 +	(rtac UU_I 1),
  40.235 +	(hyp_subst_tac 1),
  40.236 +	(atac 1)
  40.237 +	]);
  40.238 +
  40.239 +
  40.240 +val chain_mono2 = prove_goal Pcpo.thy 
  40.241 +"[|? j.~Y(j)=UU;is_chain(Y::nat=>'a::pcpo)|]\
  40.242 +\ ==> ? j.!i.j<i-->~Y(i)=UU"
  40.243 + (fn prems =>
  40.244 +	[
  40.245 +	(cut_facts_tac prems 1),
  40.246 +	(safe_tac HOL_cs),
  40.247 +	(step_tac HOL_cs 1),
  40.248 +	(strip_tac 1),
  40.249 +	(rtac notUU_I 1),
  40.250 +	(atac 2),
  40.251 +	(etac (chain_mono RS mp) 1),
  40.252 +	(atac 1)
  40.253 +	]);
  40.254 +
  40.255 +
  40.256 +
  40.257 +
  40.258 +(* ------------------------------------------------------------------------ *)
  40.259 +(* uniqueness in void                                                       *)
  40.260 +(* ------------------------------------------------------------------------ *)
  40.261 +
  40.262 +val unique_void2 = prove_goal Pcpo.thy "x::void=UU"
  40.263 + (fn prems =>
  40.264 +	[
  40.265 +	(rtac (inst_void_pcpo RS ssubst) 1),
  40.266 +	(rtac (Rep_Void_inverse RS subst) 1),
  40.267 +	(rtac (Rep_Void_inverse RS subst) 1),
  40.268 +	(rtac arg_cong 1),
  40.269 +	(rtac box_equals 1),
  40.270 +	(rtac refl 1),
  40.271 +	(rtac (unique_void RS sym) 1),
  40.272 +	(rtac (unique_void RS sym) 1)
  40.273 +	]);
  40.274 +
  40.275 +
    41.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    41.2 +++ b/src/HOLCF/Pcpo.thy	Wed Jan 19 17:35:01 1994 +0100
    41.3 @@ -0,0 +1,39 @@
    41.4 +(*  Title: 	HOLCF/pcpo.thy
    41.5 +    ID:         $Id$
    41.6 +    Author: 	Franz Regensburger
    41.7 +    Copyright   1993 Technische Universitaet Muenchen
    41.8 +
    41.9 +Definition of class pcpo (pointed complete partial order)
   41.10 +
   41.11 +The prototype theory for this class is porder.thy 
   41.12 +
   41.13 +*)
   41.14 +
   41.15 +Pcpo = Porder +
   41.16 +
   41.17 +(* Introduction of new class. The witness is type void. *)
   41.18 +
   41.19 +classes pcpo < po
   41.20 +
   41.21 +(* default class is still term *)
   41.22 +(* void is the prototype in pcpo *)
   41.23 +
   41.24 +arities void :: pcpo
   41.25 +
   41.26 +consts	
   41.27 +	UU	::	"'a::pcpo"		(* UU is the least element *)
   41.28 +rules
   41.29 +
   41.30 +(* class axioms: justification is theory Porder *)
   41.31 +
   41.32 +minimal		"UU << x"			(* witness is minimal_void *)
   41.33 +
   41.34 +cpo		"is_chain(S) ==> ? x. range(S) <<| x::('a::pcpo)" 
   41.35 +						(* witness is cpo_void     *)
   41.36 +						(* needs explicit type     *)
   41.37 +
   41.38 +(* instance of UU for the prototype void *)
   41.39 +
   41.40 +inst_void_pcpo	"UU::void = UU_void"
   41.41 +
   41.42 +end 
    42.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    42.2 +++ b/src/HOLCF/Porder.ML	Wed Jan 19 17:35:01 1994 +0100
    42.3 @@ -0,0 +1,427 @@
    42.4 +(*  Title: 	HOLCF/porder.thy
    42.5 +    ID:         $Id$
    42.6 +    Author: 	Franz Regensburger
    42.7 +    Copyright   1993 Technische Universitaet Muenchen
    42.8 +
    42.9 +Lemmas for theory porder.thy 
   42.10 +*)
   42.11 +
   42.12 +open Porder;
   42.13 +
   42.14 +
   42.15 +val box_less = prove_goal Porder.thy 
   42.16 +"[| a << b; c << a; b << d|] ==> c << d"
   42.17 + (fn prems =>
   42.18 +	[
   42.19 +	(cut_facts_tac prems 1),
   42.20 +	(etac trans_less 1),
   42.21 +	(etac trans_less 1),
   42.22 +	(atac 1)
   42.23 +	]);
   42.24 +
   42.25 +(* ------------------------------------------------------------------------ *)
   42.26 +(* lubs are unique                                                          *)
   42.27 +(* ------------------------------------------------------------------------ *)
   42.28 +
   42.29 +val unique_lub  = prove_goalw Porder.thy [is_lub, is_ub] 
   42.30 +	"[| S <<| x ; S <<| y |] ==> x=y"
   42.31 +( fn prems =>
   42.32 +	[
   42.33 +	(cut_facts_tac prems 1),
   42.34 +	(etac conjE 1),
   42.35 +	(etac conjE 1),
   42.36 +	(rtac antisym_less 1),
   42.37 +	(rtac mp 1),((etac allE 1) THEN (atac 1) THEN (atac 1)),
   42.38 +	(rtac mp 1),((etac allE 1) THEN (atac 1) THEN (atac 1))
   42.39 +	]);
   42.40 +
   42.41 +(* ------------------------------------------------------------------------ *)
   42.42 +(* chains are monotone functions                                            *)
   42.43 +(* ------------------------------------------------------------------------ *)
   42.44 +
   42.45 +val chain_mono = prove_goalw Porder.thy [is_chain]
   42.46 +	" is_chain(F) ==> x<y --> F(x)<<F(y)"
   42.47 +( fn prems =>
   42.48 +	[
   42.49 +	(cut_facts_tac prems 1),
   42.50 +	(nat_ind_tac "y" 1),
   42.51 +	(rtac impI 1),
   42.52 +	(etac less_zeroE 1),
   42.53 +	(rtac (less_Suc_eq RS ssubst) 1),
   42.54 +	(strip_tac 1),
   42.55 +	(etac disjE 1),
   42.56 +	(rtac trans_less 1),
   42.57 +	(etac allE 2),
   42.58 +	(atac 2),
   42.59 +	(fast_tac HOL_cs 1),
   42.60 +	(hyp_subst_tac 1),
   42.61 +	(etac allE 1),
   42.62 +	(atac 1)
   42.63 +	]);
   42.64 +
   42.65 +val chain_mono3 = prove_goal  Porder.thy 
   42.66 +	"[| is_chain(F); x <= y |] ==> F(x) << F(y)"
   42.67 + (fn prems =>
   42.68 +	[
   42.69 +	(cut_facts_tac prems 1),
   42.70 +	(rtac (le_imp_less_or_eq RS disjE) 1),
   42.71 +	(atac 1),
   42.72 +	(etac (chain_mono RS mp) 1),
   42.73 +	(atac 1),
   42.74 +	(hyp_subst_tac 1),
   42.75 +	(rtac refl_less 1)
   42.76 +	]);
   42.77 +
   42.78 +(* ------------------------------------------------------------------------ *)
   42.79 +(* Lemma for reasoning by cases on the natural numbers                      *)
   42.80 +(* ------------------------------------------------------------------------ *)
   42.81 +
   42.82 +val nat_less_cases = prove_goal Porder.thy 
   42.83 +	"[| m::nat < n ==> P(n,m); m=n ==> P(n,m);n < m ==> P(n,m)|]==>P(n,m)"
   42.84 +( fn prems =>
   42.85 +	[
   42.86 +	(res_inst_tac [("m1","n"),("n1","m")] (less_linear RS disjE) 1),
   42.87 +	(etac disjE 2),
   42.88 +	(etac (hd (tl (tl prems))) 1),
   42.89 +	(etac (sym RS hd (tl prems)) 1),
   42.90 +	(etac (hd prems) 1)
   42.91 +	]);
   42.92 +
   42.93 +(* ------------------------------------------------------------------------ *)
   42.94 +(* The range of a chain is a totaly ordered     <<                           *)
   42.95 +(* ------------------------------------------------------------------------ *)
   42.96 +
   42.97 +val chain_is_tord = prove_goalw Porder.thy [is_tord]
   42.98 +	"is_chain(F) ==> is_tord(range(F))"
   42.99 +( fn prems =>
  42.100 +	[
  42.101 +	(cut_facts_tac prems 1),
  42.102 +	(rewrite_goals_tac [range_def]),
  42.103 +	(rtac allI 1 ),
  42.104 +	(rtac allI 1 ),
  42.105 +	(rtac (mem_Collect_eq RS ssubst) 1),
  42.106 +	(rtac (mem_Collect_eq RS ssubst) 1),
  42.107 +	(strip_tac 1),
  42.108 +	(etac conjE 1),
  42.109 +	(etac exE 1),
  42.110 +	(etac exE 1),
  42.111 +	(hyp_subst_tac 1),
  42.112 +	(hyp_subst_tac 1),
  42.113 +	(res_inst_tac [("m","xa"),("n","xb")] (nat_less_cases) 1),
  42.114 +	(rtac disjI1 1),
  42.115 +	(rtac (chain_mono RS mp) 1),
  42.116 +	(atac 1),
  42.117 +	(atac 1),
  42.118 +	(rtac disjI1 1),
  42.119 +	(hyp_subst_tac 1),
  42.120 +	(rtac refl_less 1),
  42.121 +	(rtac disjI2 1),
  42.122 +	(rtac (chain_mono RS mp) 1),
  42.123 +	(atac 1),
  42.124 +	(atac 1)
  42.125 +	]);
  42.126 +
  42.127 +
  42.128 +(* ------------------------------------------------------------------------ *)
  42.129 +(* technical lemmas about lub and is_lub, use above results about @         *)
  42.130 +(* ------------------------------------------------------------------------ *)
  42.131 +
  42.132 +val lubI = prove_goal Porder.thy "(? x. M <<| x) ==> M <<| lub(M)"
  42.133 +(fn prems =>
  42.134 +	[
  42.135 +	(cut_facts_tac prems 1),
  42.136 +	(rtac (lub RS ssubst) 1),
  42.137 +	(etac selectI2 1)
  42.138 +	]);
  42.139 +
  42.140 +val lubE = prove_goal Porder.thy " M <<| lub(M) ==>  ? x. M <<| x"
  42.141 +(fn prems =>
  42.142 +	[
  42.143 +	(cut_facts_tac prems 1),
  42.144 +	(etac exI 1)
  42.145 +	]);
  42.146 +
  42.147 +val lub_eq = prove_goal Porder.thy 
  42.148 +	"(? x. M <<| x)  = M <<| lub(M)"
  42.149 +(fn prems => 
  42.150 +	[
  42.151 +	(rtac (lub RS ssubst) 1),
  42.152 +	(rtac (select_eq_Ex RS subst) 1),
  42.153 +	(rtac refl 1)
  42.154 +	]);
  42.155 +
  42.156 +
  42.157 +val thelubI = prove_goal  Porder.thy " M <<| l ==> lub(M) = l"
  42.158 +(fn prems =>
  42.159 +	[
  42.160 +	(cut_facts_tac prems 1), 
  42.161 +	(rtac unique_lub 1),
  42.162 +	(rtac (lub RS ssubst) 1),
  42.163 +	(etac selectI 1),
  42.164 +	(atac 1)
  42.165 +	]);
  42.166 +
  42.167 +
  42.168 +(* ------------------------------------------------------------------------ *)
  42.169 +(* access to some definition as inference rule                              *)
  42.170 +(* ------------------------------------------------------------------------ *)
  42.171 +
  42.172 +val is_lubE = prove_goalw  Porder.thy [is_lub]
  42.173 +	"S <<| x  ==> S <| x & (! u. S <| u  --> x << u)"
  42.174 +(fn prems =>
  42.175 +	[
  42.176 +	(cut_facts_tac prems 1),
  42.177 +	(atac 1)
  42.178 +	]);
  42.179 +
  42.180 +val is_lubI = prove_goalw  Porder.thy [is_lub]
  42.181 +	"S <| x & (! u. S <| u  --> x << u) ==> S <<| x"
  42.182 +(fn prems =>
  42.183 +	[
  42.184 +	(cut_facts_tac prems 1),
  42.185 +	(atac 1)
  42.186 +	]);
  42.187 +
  42.188 +val is_chainE = prove_goalw Porder.thy [is_chain] 
  42.189 + "is_chain(F) ==> ! i. F(i) << F(Suc(i))"
  42.190 +(fn prems =>
  42.191 +	[
  42.192 +	(cut_facts_tac prems 1),
  42.193 +	(atac 1)]);
  42.194 +
  42.195 +val is_chainI = prove_goalw Porder.thy [is_chain] 
  42.196 + "! i. F(i) << F(Suc(i)) ==> is_chain(F) "
  42.197 +(fn prems =>
  42.198 +	[
  42.199 +	(cut_facts_tac prems 1),
  42.200 +	(atac 1)]);
  42.201 +
  42.202 +(* ------------------------------------------------------------------------ *)
  42.203 +(* technical lemmas about (least) upper bounds of chains                    *)
  42.204 +(* ------------------------------------------------------------------------ *)
  42.205 +
  42.206 +val ub_rangeE = prove_goalw  Porder.thy [is_ub]
  42.207 +	"range(S) <| x  ==> ! i. S(i) << x"
  42.208 +(fn prems =>
  42.209 +	[
  42.210 +	(cut_facts_tac prems 1),
  42.211 +	(strip_tac 1),
  42.212 +	(rtac mp 1),
  42.213 +	(etac spec 1),
  42.214 +	(rtac rangeI 1)
  42.215 +	]);
  42.216 +
  42.217 +val ub_rangeI = prove_goalw Porder.thy [is_ub]
  42.218 +	"! i. S(i) << x  ==> range(S) <| x"
  42.219 +(fn prems =>
  42.220 +	[
  42.221 +	(cut_facts_tac prems 1),
  42.222 +	(strip_tac 1),
  42.223 +	(etac rangeE 1),
  42.224 +	(hyp_subst_tac 1),
  42.225 +	(etac spec 1)
  42.226 +	]);
  42.227 +
  42.228 +val is_ub_lub = (is_lubE RS conjunct1 RS ub_rangeE RS spec);
  42.229 +(* range(?S1) <<| ?x1 ==> ?S1(?x) << ?x1                                    *)
  42.230 +
  42.231 +val is_lub_lub = (is_lubE RS conjunct2 RS spec RS mp);
  42.232 +(* [| ?S3 <<| ?x3; ?S3 <| ?x1 |] ==> ?x3 << ?x1                             *)
  42.233 +
  42.234 +(* ------------------------------------------------------------------------ *)
  42.235 +(* Prototype lemmas for class pcpo                                          *)
  42.236 +(* ------------------------------------------------------------------------ *)
  42.237 +
  42.238 +(* ------------------------------------------------------------------------ *)
  42.239 +(* a technical argument about << on void                                    *)
  42.240 +(* ------------------------------------------------------------------------ *)
  42.241 +
  42.242 +val less_void = prove_goal Porder.thy "(u1::void << u2) = (u1 = u2)"
  42.243 +(fn prems =>
  42.244 +	[
  42.245 +	(rtac (inst_void_po RS ssubst) 1),
  42.246 +	(rewrite_goals_tac [less_void_def]),
  42.247 +	(rtac iffI 1),
  42.248 +	(rtac injD 1),
  42.249 +	(atac 2),
  42.250 +	(rtac inj_inverseI 1),
  42.251 +	(rtac Rep_Void_inverse 1),
  42.252 +	(etac arg_cong 1)
  42.253 +	]);
  42.254 +
  42.255 +(* ------------------------------------------------------------------------ *)
  42.256 +(* void is pointed. The least element is UU_void                            *)
  42.257 +(* ------------------------------------------------------------------------ *)
  42.258 +
  42.259 +val minimal_void = prove_goal Porder.thy  	"UU_void << x"
  42.260 +(fn prems =>
  42.261 +	[
  42.262 +	(rtac (inst_void_po RS ssubst) 1),
  42.263 +	(rewrite_goals_tac [less_void_def]),
  42.264 +	(simp_tac (HOL_ss addsimps [unique_void]) 1)
  42.265 +	]);
  42.266 +
  42.267 +(* ------------------------------------------------------------------------ *)
  42.268 +(* UU_void is the trivial lub of all chains in void                         *)
  42.269 +(* ------------------------------------------------------------------------ *)
  42.270 +
  42.271 +val lub_void = prove_goalw  Porder.thy [is_lub] "M <<| UU_void"
  42.272 +(fn prems =>
  42.273 +	[
  42.274 +	(rtac conjI 1),
  42.275 +	(rewrite_goals_tac [is_ub]),
  42.276 +	(strip_tac 1),
  42.277 +	(rtac (inst_void_po RS ssubst) 1),
  42.278 +	(rewrite_goals_tac [less_void_def]),
  42.279 +	(simp_tac (HOL_ss addsimps [unique_void]) 1),
  42.280 +	(strip_tac 1),
  42.281 +	(rtac minimal_void 1)
  42.282 +	]);
  42.283 +
  42.284 +(* ------------------------------------------------------------------------ *)
  42.285 +(* lub(?M) = UU_void                                                        *)
  42.286 +(* ------------------------------------------------------------------------ *)
  42.287 +
  42.288 +val thelub_void = (lub_void RS thelubI);
  42.289 +
  42.290 +(* ------------------------------------------------------------------------ *)
  42.291 +(* void is a cpo wrt. countable chains                                      *)
  42.292 +(* ------------------------------------------------------------------------ *)
  42.293 +
  42.294 +val cpo_void = prove_goal Porder.thy
  42.295 +	"is_chain(S::nat=>void) ==> ? x. range(S) <<| x "
  42.296 +(fn prems =>
  42.297 +	[
  42.298 +	(cut_facts_tac prems 1),
  42.299 +	(res_inst_tac [("x","UU_void")] exI 1),
  42.300 +	(rtac lub_void 1)
  42.301 +	]);
  42.302 +
  42.303 +(* ------------------------------------------------------------------------ *)
  42.304 +(* end of prototype lemmas for class pcpo                                   *)
  42.305 +(* ------------------------------------------------------------------------ *)
  42.306 +
  42.307 +
  42.308 +(* ------------------------------------------------------------------------ *)
  42.309 +(* the reverse law of anti--symmetrie of <<                                 *)
  42.310 +(* ------------------------------------------------------------------------ *)
  42.311 +
  42.312 +val antisym_less_inverse = prove_goal Porder.thy "x=y ==> x << y & y << x"
  42.313 +(fn prems =>
  42.314 +	[
  42.315 +	(cut_facts_tac prems 1),
  42.316 +	(rtac conjI 1),
  42.317 +	((rtac subst 1) THEN (rtac refl_less 2) THEN (atac 1)),
  42.318 +	((rtac subst 1) THEN (rtac refl_less 2) THEN (etac sym 1))
  42.319 +	]);
  42.320 +
  42.321 +(* ------------------------------------------------------------------------ *)
  42.322 +(* results about finite chains                                              *)
  42.323 +(* ------------------------------------------------------------------------ *)
  42.324 +
  42.325 +val lub_finch1 = prove_goalw Porder.thy [max_in_chain_def]
  42.326 +	"[| is_chain(C) ; max_in_chain(i,C)|] ==> range(C) <<| C(i)"
  42.327 +(fn prems =>
  42.328 +	[
  42.329 +	(cut_facts_tac prems 1),
  42.330 +	(rtac is_lubI 1),
  42.331 +	(rtac conjI 1),
  42.332 +	(rtac ub_rangeI 1),
  42.333 +	(rtac allI 1),
  42.334 +	(res_inst_tac [("m","i")] nat_less_cases 1),
  42.335 +	(rtac (antisym_less_inverse RS conjunct2) 1),
  42.336 +	(etac (disjI1 RS less_or_eq_imp_le RS rev_mp) 1),
  42.337 +	(etac spec 1),
  42.338 +	(rtac (antisym_less_inverse RS conjunct2) 1),
  42.339 +	(etac (disjI2 RS less_or_eq_imp_le RS rev_mp) 1),
  42.340 +	(etac spec 1),
  42.341 +	(etac (chain_mono RS mp) 1),
  42.342 +	(atac 1),
  42.343 +	(strip_tac 1),
  42.344 +	(etac (ub_rangeE RS spec) 1)
  42.345 +	]);	
  42.346 +
  42.347 +val lub_finch2 = prove_goalw Porder.thy [finite_chain_def]
  42.348 +	"finite_chain(C) ==> range(C) <<| C(@ i. max_in_chain(i,C))"
  42.349 + (fn prems=>
  42.350 +	[
  42.351 +	(cut_facts_tac prems 1),
  42.352 +	(rtac lub_finch1 1),
  42.353 +	(etac conjunct1 1),
  42.354 +	(rtac selectI2 1),
  42.355 +	(etac conjunct2 1)
  42.356 +	]);
  42.357 +
  42.358 +
  42.359 +val bin_chain = prove_goal Porder.thy "x<<y ==> is_chain(%i. if(i=0,x,y))"
  42.360 + (fn prems =>
  42.361 +	[
  42.362 +	(cut_facts_tac prems 1),
  42.363 +	(rtac is_chainI 1),
  42.364 +	(rtac allI 1),
  42.365 +	(nat_ind_tac "i" 1),
  42.366 +	(asm_simp_tac nat_ss 1),
  42.367 +	(asm_simp_tac nat_ss 1),
  42.368 +	(rtac refl_less 1)
  42.369 +	]);
  42.370 +
  42.371 +val bin_chainmax = prove_goalw Porder.thy [max_in_chain_def,le_def]
  42.372 +	"x<<y ==> max_in_chain(Suc(0),%i. if(i=0,x,y))"
  42.373 +(fn prems =>
  42.374 +	[
  42.375 +	(cut_facts_tac prems 1),
  42.376 +	(rtac allI 1),
  42.377 +	(nat_ind_tac "j" 1),
  42.378 +	(asm_simp_tac nat_ss 1),
  42.379 +	(asm_simp_tac nat_ss 1)
  42.380 +	]);
  42.381 +
  42.382 +val lub_bin_chain = prove_goal Porder.thy 
  42.383 +	"x << y ==> range(%i. if(i = 0,x,y)) <<| y"
  42.384 +(fn prems=>
  42.385 +	[ (cut_facts_tac prems 1),
  42.386 +	(res_inst_tac [("s","if(Suc(0) = 0,x,y)")] subst 1),
  42.387 +	(rtac lub_finch1 2),
  42.388 +	(etac bin_chain 2),
  42.389 +	(etac bin_chainmax 2),
  42.390 +	(simp_tac nat_ss  1)
  42.391 +	]);
  42.392 +
  42.393 +(* ------------------------------------------------------------------------ *)
  42.394 +(* the maximal element in a chain is its lub                                *)
  42.395 +(* ------------------------------------------------------------------------ *)
  42.396 +
  42.397 +val lub_chain_maxelem = prove_goal Porder.thy
  42.398 +"[|is_chain(Y);? i.Y(i)=c;!i.Y(i)<<c|] ==> lub(range(Y)) = c"
  42.399 +(fn prems =>
  42.400 +	[
  42.401 +	(cut_facts_tac prems 1),
  42.402 +	(rtac thelubI 1),
  42.403 +	(rtac is_lubI 1),
  42.404 +	(rtac conjI 1),
  42.405 +	(etac ub_rangeI 1),
  42.406 +	(strip_tac 1),
  42.407 +	(res_inst_tac [("P","%i.Y(i)=c")] exE 1),
  42.408 +	(atac 1),
  42.409 +	(hyp_subst_tac 1),
  42.410 +	(etac (ub_rangeE RS spec) 1)
  42.411 +	]);
  42.412 +
  42.413 +(* ------------------------------------------------------------------------ *)
  42.414 +(* the lub of a constant chain is the constant                              *)
  42.415 +(* ------------------------------------------------------------------------ *)
  42.416 +
  42.417 +val lub_const = prove_goal Porder.thy "range(%x.c) <<| c"
  42.418 + (fn prems =>
  42.419 +	[
  42.420 +	(rtac is_lubI 1),
  42.421 +	(rtac conjI 1),
  42.422 +	(rtac ub_rangeI 1),
  42.423 +	(strip_tac 1),
  42.424 +	(rtac refl_less 1),
  42.425 +	(strip_tac 1),
  42.426 +	(etac (ub_rangeE RS spec) 1)
  42.427 +	]);
  42.428 +
  42.429 +
  42.430 +
    43.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    43.2 +++ b/src/HOLCF/Porder.thy	Wed Jan 19 17:35:01 1994 +0100
    43.3 @@ -0,0 +1,71 @@
    43.4 +(*  Title: 	HOLCF/porder.thy
    43.5 +    ID:         $Id$
    43.6 +    Author: 	Franz Regensburger
    43.7 +    Copyright   1993 Technische Universitaet Muenchen
    43.8 +
    43.9 +Definition of class porder (partial order)
   43.10 +
   43.11 +The prototype theory for this class is void.thy 
   43.12 +
   43.13 +*)
   43.14 +
   43.15 +Porder = Void +
   43.16 +
   43.17 +(* Introduction of new class. The witness is type void. *)
   43.18 +
   43.19 +classes po < term
   43.20 +
   43.21 +(* default type is still term ! *)
   43.22 +(* void is the prototype in po *)
   43.23 +
   43.24 +arities void :: po
   43.25 +
   43.26 +consts	"<<"	::	"['a,'a::po] => bool"	(infixl 55)
   43.27 +
   43.28 +	"<|"	::	"['a set,'a::po] => bool"	(infixl 55)
   43.29 +	"<<|"	::	"['a set,'a::po] => bool"	(infixl 55)
   43.30 +	lub	::	"'a set => 'a::po"
   43.31 +	is_tord	::	"'a::po set => bool"
   43.32 +	is_chain ::	"(nat=>'a::po) => bool"
   43.33 +	max_in_chain :: "[nat,nat=>'a::po]=>bool"
   43.34 +	finite_chain :: "(nat=>'a::po)=>bool"
   43.35 +
   43.36 +rules
   43.37 +
   43.38 +(* class axioms: justification is theory Void *)
   43.39 +
   43.40 +refl_less	"x << x"	
   43.41 +				(* witness refl_less_void    *)
   43.42 +
   43.43 +antisym_less	"[|x<<y ; y<<x |] ==> x = y"	
   43.44 +				(* witness antisym_less_void *)
   43.45 +
   43.46 +trans_less	"[|x<<y ; y<<z |] ==> x<<z"
   43.47 +				(* witness trans_less_void   *)
   43.48 +
   43.49 +(* instance of << for the prototype void *)
   43.50 +
   43.51 +inst_void_po	"(op <<)::[void,void]=>bool = less_void"
   43.52 +
   43.53 +(* class definitions *)
   43.54 +
   43.55 +is_ub		"S  <| x == ! y.y:S --> y<<x"
   43.56 +is_lub		"S <<| x == S <| x & (! u. S <| u  --> x << u)"
   43.57 +
   43.58 +lub		"lub(S) = (@x. S <<| x)"
   43.59 +
   43.60 +(* Arbitrary chains are total orders    *)                  
   43.61 +is_tord		"is_tord(S) == ! x y. x:S & y:S --> (x<<y | y<<x)"
   43.62 +
   43.63 +
   43.64 +(* Here we use countable chains and I prefer to code them as functions! *)
   43.65 +is_chain	"is_chain(F) == (! i.F(i) << F(Suc(i)))"
   43.66 +
   43.67 +
   43.68 +(* finite chains, needed for monotony of continouous functions *)
   43.69 +
   43.70 +max_in_chain_def "max_in_chain(i,C) == ! j. i <= j --> C(i) = C(j)" 
   43.71 +
   43.72 +finite_chain_def "finite_chain(C) == is_chain(C) & (? i. max_in_chain(i,C))"
   43.73 +
   43.74 +end 
    44.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    44.2 +++ b/src/HOLCF/ROOT.ML	Wed Jan 19 17:35:01 1994 +0100
    44.3 @@ -0,0 +1,68 @@
    44.4 +(*  Title:	HOLCF/ROOT
    44.5 +    ID:         $Id$
    44.6 +    Author: 	Franz Regensburger
    44.7 +    Copyright	1993 Technische Universitaet Muenchen
    44.8 +
    44.9 +ROOT file for the conservative extension of HOL by the LCF logic.
   44.10 +Should be executed in subdirectory HOLCF.
   44.11 +*)
   44.12 +
   44.13 +val banner = "Higher-order Logic of Computable Functions";
   44.14 +writeln banner;
   44.15 +print_depth 1;
   44.16 +
   44.17 +structure Readthy = ReadthyFUN (structure ThySyn = ThySyn);
   44.18 +Readthy.loaded_thys := !loaded_thys;
   44.19 +open Readthy;
   44.20 +
   44.21 +use_thy "Holcfb";
   44.22 +use_thy "Void";
   44.23 +use_thy "Porder";
   44.24 +use_thy "Pcpo";
   44.25 +
   44.26 +use_thy "Fun1";
   44.27 +use_thy "Fun2";
   44.28 +use_thy "Fun3";
   44.29 +
   44.30 +use_thy "Cont";
   44.31 +
   44.32 +use_thy "Cfun1";
   44.33 +use_thy "Cfun2";
   44.34 +use_thy "Cfun3";
   44.35 +
   44.36 +use_thy "Cprod1";
   44.37 +use_thy "Cprod2";
   44.38 +use_thy "Cprod3";
   44.39 +
   44.40 +use_thy "Sprod0";
   44.41 +use_thy "Sprod1"; 
   44.42 +use_thy "Sprod2"; 
   44.43 +use_thy "Sprod3"; 
   44.44 +
   44.45 +use_thy "Ssum0";
   44.46 +use_thy "Ssum1";
   44.47 +use_thy "Ssum2";
   44.48 +use_thy "Ssum3";
   44.49 +
   44.50 +use_thy "Lift1";
   44.51 +use_thy "Lift2";
   44.52 +use_thy "Lift3";
   44.53 +
   44.54 +use_thy "Fix";
   44.55 +
   44.56 +use_thy "ccc1";
   44.57 +use_thy "One";
   44.58 +use_thy "Tr1";
   44.59 +use_thy "Tr2";
   44.60 +
   44.61 +use_thy "HOLCF";
   44.62 +
   44.63 +use_thy "Dnat";
   44.64 +use_thy "Dnat2";
   44.65 +use_thy "Stream";
   44.66 +use_thy "Stream2";
   44.67 +
   44.68 +use "../Pure/install_pp.ML";
   44.69 +print_depth 8;  
   44.70 +
   44.71 +val HOLCF_build_completed = ();	(*indicate successful build*)
    45.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    45.2 +++ b/src/HOLCF/Sprod0.ML	Wed Jan 19 17:35:01 1994 +0100
    45.3 @@ -0,0 +1,389 @@
    45.4 +(*  Title: 	HOLCF/sprod0.thy
    45.5 +    ID:         $Id$
    45.6 +    Author: 	Franz Regensburger
    45.7 +    Copyright   1993  Technische Universitaet Muenchen
    45.8 +
    45.9 +Lemmas for theory sprod0.thy
   45.10 +*)
   45.11 +
   45.12 +open Sprod0;
   45.13 +
   45.14 +(* ------------------------------------------------------------------------ *)
   45.15 +(* A non-emptyness result for Sprod                                         *)
   45.16 +(* ------------------------------------------------------------------------ *)
   45.17 +
   45.18 +val SprodI = prove_goalw Sprod0.thy [Sprod_def]
   45.19 +	"Spair_Rep(a,b):Sprod"
   45.20 +(fn prems =>
   45.21 +	[
   45.22 +	(EVERY1 [rtac CollectI, rtac exI,rtac exI, rtac refl])
   45.23 +	]);
   45.24 +
   45.25 +
   45.26 +val inj_onto_Abs_Sprod = prove_goal Sprod0.thy 
   45.27 +	"inj_onto(Abs_Sprod,Sprod)"
   45.28 +(fn prems =>
   45.29 +	[
   45.30 +	(rtac inj_onto_inverseI 1),
   45.31 +	(etac Abs_Sprod_inverse 1)
   45.32 +	]);
   45.33 +
   45.34 +
   45.35 +(* ------------------------------------------------------------------------ *)
   45.36 +(* Strictness and definedness of Spair_Rep                                  *)
   45.37 +(* ------------------------------------------------------------------------ *)
   45.38 +
   45.39 +
   45.40 +val strict_Spair_Rep = prove_goalw Sprod0.thy [Spair_Rep_def]
   45.41 + "(a=UU | b=UU) ==> (Spair_Rep(a,b) = Spair_Rep(UU,UU))"
   45.42 + (fn prems =>
   45.43 +	[
   45.44 +	(cut_facts_tac prems 1),
   45.45 +	(rtac ext 1),
   45.46 +	(rtac ext 1),
   45.47 +	(rtac iffI 1),
   45.48 +	(fast_tac HOL_cs 1),
   45.49 +	(fast_tac HOL_cs 1)
   45.50 +	]);
   45.51 +
   45.52 +val defined_Spair_Rep_rev = prove_goalw Sprod0.thy [Spair_Rep_def]
   45.53 + "(Spair_Rep(a,b) = Spair_Rep(UU,UU)) ==> (a=UU | b=UU)"
   45.54 + (fn prems =>
   45.55 +	[
   45.56 +	(res_inst_tac [("Q","a=UU|b=UU")] classical2 1),
   45.57 +	(atac 1),
   45.58 +	(rtac disjI1 1),
   45.59 +	(rtac ((hd prems) RS fun_cong RS fun_cong RS iffD2 RS mp RS 
   45.60 +	conjunct1 RS sym) 1),
   45.61 +	(fast_tac HOL_cs 1),
   45.62 +	(fast_tac HOL_cs 1)
   45.63 +	]);
   45.64 +
   45.65 +
   45.66 +(* ------------------------------------------------------------------------ *)
   45.67 +(* injectivity of Spair_Rep and Ispair                                      *)
   45.68 +(* ------------------------------------------------------------------------ *)
   45.69 +
   45.70 +val inject_Spair_Rep = prove_goalw Sprod0.thy [Spair_Rep_def]
   45.71 +"[|~aa=UU ; ~ba=UU ; Spair_Rep(a,b)=Spair_Rep(aa,ba) |] ==> a=aa & b=ba"
   45.72 + (fn prems =>
   45.73 +	[
   45.74 +	(cut_facts_tac prems 1),
   45.75 +	(rtac ((nth_elem (2,prems)) RS fun_cong  RS fun_cong 
   45.76 +		RS iffD1 RS mp) 1),
   45.77 +	(fast_tac HOL_cs 1),
   45.78 +	(fast_tac HOL_cs 1)
   45.79 +	]);
   45.80 +
   45.81 +
   45.82 +val inject_Ispair =  prove_goalw Sprod0.thy [Ispair_def]
   45.83 +	"[|~aa=UU ; ~ba=UU ; Ispair(a,b)=Ispair(aa,ba) |] ==> a=aa & b=ba"
   45.84 +(fn prems =>
   45.85 +	[
   45.86 +	(cut_facts_tac prems 1),
   45.87 +	(etac inject_Spair_Rep 1),
   45.88 +	(atac 1),
   45.89 +	(etac (inj_onto_Abs_Sprod  RS inj_ontoD) 1),
   45.90 +	(rtac SprodI 1),
   45.91 +	(rtac SprodI 1)
   45.92 +	]);
   45.93 +
   45.94 +
   45.95 +(* ------------------------------------------------------------------------ *)
   45.96 +(* strictness and definedness of Ispair                                     *)
   45.97 +(* ------------------------------------------------------------------------ *)
   45.98 +
   45.99 +val strict_Ispair = prove_goalw Sprod0.thy [Ispair_def] 
  45.100 + "(a=UU | b=UU) ==> Ispair(a,b)=Ispair(UU,UU)"
  45.101 +(fn prems =>
  45.102 +	[
  45.103 +	(cut_facts_tac prems 1),
  45.104 +	(etac (strict_Spair_Rep RS arg_cong) 1)
  45.105 +	]);
  45.106 +
  45.107 +val strict_Ispair1 = prove_goalw Sprod0.thy [Ispair_def]
  45.108 +	"Ispair(UU,b) = Ispair(UU,UU)"
  45.109 +(fn prems =>
  45.110 +	[
  45.111 +	(rtac (strict_Spair_Rep RS arg_cong) 1),
  45.112 +	(rtac disjI1 1),
  45.113 +	(rtac refl 1)
  45.114 +	]);
  45.115 +
  45.116 +val strict_Ispair2 = prove_goalw Sprod0.thy [Ispair_def]
  45.117 +	"Ispair(a,UU) = Ispair(UU,UU)"
  45.118 +(fn prems =>
  45.119 +	[
  45.120 +	(rtac (strict_Spair_Rep RS arg_cong) 1),
  45.121 +	(rtac disjI2 1),
  45.122 +	(rtac refl 1)
  45.123 +	]);
  45.124 +
  45.125 +val strict_Ispair_rev = prove_goal Sprod0.thy 
  45.126 +	"~Ispair(x,y)=Ispair(UU,UU) ==> ~x=UU & ~y=UU"
  45.127 +(fn prems =>
  45.128 +	[
  45.129 +	(cut_facts_tac prems 1),
  45.130 +	(rtac (de_morgan1 RS ssubst) 1),
  45.131 +	(etac contrapos 1),
  45.132 +	(etac strict_Ispair 1)
  45.133 +	]);
  45.134 +
  45.135 +val defined_Ispair_rev = prove_goalw Sprod0.thy [Ispair_def]
  45.136 +	"Ispair(a,b) = Ispair(UU,UU) ==> (a = UU | b = UU)"
  45.137 +(fn prems =>
  45.138 +	[
  45.139 +	(cut_facts_tac prems 1),
  45.140 +	(rtac defined_Spair_Rep_rev 1),
  45.141 +	(rtac (inj_onto_Abs_Sprod  RS inj_ontoD) 1),
  45.142 +	(atac 1),
  45.143 +	(rtac SprodI 1),
  45.144 +	(rtac SprodI 1)
  45.145 +	]);
  45.146 +
  45.147 +val defined_Ispair = prove_goal Sprod0.thy  
  45.148 +"[|~a=UU; ~b=UU|] ==> ~(Ispair(a,b) = Ispair(UU,UU))" 
  45.149 +(fn prems =>
  45.150 +	[
  45.151 +	(cut_facts_tac prems 1),
  45.152 +	(rtac contrapos 1),
  45.153 +	(etac defined_Ispair_rev 2),
  45.154 +	(rtac (de_morgan1 RS iffD1) 1),
  45.155 +	(etac conjI 1),
  45.156 +	(atac 1)
  45.157 +	]);
  45.158 +
  45.159 +
  45.160 +(* ------------------------------------------------------------------------ *)
  45.161 +(* Exhaustion of the strict product **                                      *)
  45.162 +(* ------------------------------------------------------------------------ *)
  45.163 +
  45.164 +val Exh_Sprod = prove_goalw Sprod0.thy [Ispair_def]
  45.165 +	"z=Ispair(UU,UU) | (? a b. z=Ispair(a,b) & ~a=UU & ~b=UU)"
  45.166 +(fn prems =>
  45.167 +	[
  45.168 +	(rtac (rewrite_rule [Sprod_def] Rep_Sprod RS CollectE) 1),
  45.169 +	(etac exE 1),
  45.170 +	(etac exE 1),
  45.171 +	(rtac (excluded_middle RS disjE) 1),
  45.172 +	(rtac disjI2 1),
  45.173 +	(rtac exI 1),
  45.174 +	(rtac exI 1),
  45.175 +	(rtac conjI 1),
  45.176 +	(rtac (Rep_Sprod_inverse RS sym RS trans) 1),
  45.177 +	(etac arg_cong 1),
  45.178 +	(rtac (de_morgan1 RS ssubst) 1),
  45.179 +	(atac 1),
  45.180 +	(rtac disjI1 1),
  45.181 +	(rtac (Rep_Sprod_inverse RS sym RS trans) 1),
  45.182 +	(res_inst_tac [("f","Abs_Sprod")] arg_cong 1),
  45.183 +	(etac trans 1),
  45.184 +	(etac strict_Spair_Rep 1)
  45.185 +	]);
  45.186 +
  45.187 +(* ------------------------------------------------------------------------ *)
  45.188 +(* general elimination rule for strict product                              *)
  45.189 +(* ------------------------------------------------------------------------ *)
  45.190 +
  45.191 +val IsprodE = prove_goal Sprod0.thy
  45.192 +"[|p=Ispair(UU,UU) ==> Q ;!!x y. [|p=Ispair(x,y); ~x=UU ; ~y=UU|] ==> Q|] ==> Q"
  45.193 +(fn prems =>
  45.194 +	[
  45.195 +	(rtac (Exh_Sprod RS disjE) 1),
  45.196 +	(etac (hd prems) 1),
  45.197 +	(etac exE 1),
  45.198 +	(etac exE 1),
  45.199 +	(etac conjE 1),
  45.200 +	(etac conjE 1),
  45.201 +	(etac (hd (tl prems)) 1),
  45.202 +	(atac 1),
  45.203 +	(atac 1)
  45.204 +	]);
  45.205 +
  45.206 +
  45.207 +(* ------------------------------------------------------------------------ *)
  45.208 +(* some results about the selectors Isfst, Issnd                            *)
  45.209 +(* ------------------------------------------------------------------------ *)
  45.210 +
  45.211 +val strict_Isfst = prove_goalw Sprod0.thy [Isfst_def] 
  45.212 +	"p=Ispair(UU,UU)==>Isfst(p)=UU"
  45.213 +(fn prems =>
  45.214 +	[
  45.215 +	(cut_facts_tac prems 1),
  45.216 +	(rtac  select_equality 1),
  45.217 +	(rtac conjI 1),
  45.218 +	(fast_tac HOL_cs  1),
  45.219 +	(strip_tac 1),
  45.220 +	(res_inst_tac [("P","Ispair(UU,UU) = Ispair(a,b)")] notE 1),
  45.221 +	(rtac not_sym 1),
  45.222 +	(rtac defined_Ispair 1),
  45.223 +	(REPEAT (fast_tac HOL_cs  1))
  45.224 +	]);
  45.225 +
  45.226 +
  45.227 +val strict_Isfst1 =  prove_goal Sprod0.thy
  45.228 +	"Isfst(Ispair(UU,y)) = UU"
  45.229 +(fn prems =>
  45.230 +	[
  45.231 +	(rtac (strict_Ispair1 RS ssubst) 1),
  45.232 +	(rtac strict_Isfst 1),
  45.233 +	(rtac refl 1)
  45.234 +	]);
  45.235 +
  45.236 +val strict_Isfst2 =  prove_goal Sprod0.thy
  45.237 +	"Isfst(Ispair(x,UU)) = UU"
  45.238 +(fn prems =>
  45.239 +	[
  45.240 +	(rtac (strict_Ispair2 RS ssubst) 1),
  45.241 +	(rtac strict_Isfst 1),
  45.242 +	(rtac refl 1)
  45.243 +	]);
  45.244 +
  45.245 +
  45.246 +val strict_Issnd = prove_goalw Sprod0.thy [Issnd_def] 
  45.247 +	"p=Ispair(UU,UU)==>Issnd(p)=UU"
  45.248 +(fn prems =>
  45.249 +	[
  45.250 +	(cut_facts_tac prems 1),
  45.251 +	(rtac  select_equality 1),
  45.252 +	(rtac conjI 1),
  45.253 +	(fast_tac HOL_cs  1),
  45.254 +	(strip_tac 1),
  45.255 +	(res_inst_tac [("P","Ispair(UU,UU) = Ispair(a,b)")] notE 1),
  45.256 +	(rtac not_sym 1),
  45.257 +	(rtac defined_Ispair 1),
  45.258 +	(REPEAT (fast_tac HOL_cs  1))
  45.259 +	]);
  45.260 +
  45.261 +val strict_Issnd1 =  prove_goal Sprod0.thy
  45.262 +	"Issnd(Ispair(UU,y)) = UU"
  45.263 +(fn prems =>
  45.264 +	[
  45.265 +	(rtac (strict_Ispair1 RS ssubst) 1),
  45.266 +	(rtac strict_Issnd 1),
  45.267 +	(rtac refl 1)
  45.268 +	]);
  45.269 +
  45.270 +val strict_Issnd2 =  prove_goal Sprod0.thy
  45.271 +	"Issnd(Ispair(x,UU)) = UU"
  45.272 +(fn prems =>
  45.273 +	[
  45.274 +	(rtac (strict_Ispair2 RS ssubst) 1),
  45.275 +	(rtac strict_Issnd 1),
  45.276 +	(rtac refl 1)
  45.277 +	]);
  45.278 +
  45.279 +val Isfst = prove_goalw Sprod0.thy [Isfst_def]
  45.280 +	"[|~x=UU ;~y=UU |] ==> Isfst(Ispair(x,y)) = x"
  45.281 +(fn prems =>
  45.282 +	[
  45.283 +	(cut_facts_tac prems 1),
  45.284 +	(rtac  select_equality 1),
  45.285 +	(rtac conjI 1),
  45.286 +	(strip_tac 1),
  45.287 +	(res_inst_tac [("P","Ispair(x,y) = Ispair(UU,UU)")] notE 1),
  45.288 +	(etac defined_Ispair 1),
  45.289 +	(atac 1),
  45.290 +	(atac 1),
  45.291 +	(strip_tac 1),
  45.292 +	(rtac (inject_Ispair RS conjunct1) 1),
  45.293 +	(fast_tac HOL_cs  3),
  45.294 +	(fast_tac HOL_cs  1),
  45.295 +	(fast_tac HOL_cs  1),
  45.296 +	(fast_tac HOL_cs  1)
  45.297 +	]);
  45.298 +
  45.299 +val Issnd = prove_goalw Sprod0.thy [Issnd_def]
  45.300 +	"[|~x=UU ;~y=UU |] ==> Issnd(Ispair(x,y)) = y"
  45.301 +(fn prems =>
  45.302 +	[
  45.303 +	(cut_facts_tac prems 1),
  45.304 +	(rtac  select_equality 1),
  45.305 +	(rtac conjI 1),
  45.306 +	(strip_tac 1),
  45.307 +	(res_inst_tac [("P","Ispair(x,y) = Ispair(UU,UU)")] notE 1),
  45.308 +	(etac defined_Ispair 1),
  45.309 +	(atac 1),
  45.310 +	(atac 1),
  45.311 +	(strip_tac 1),
  45.312 +	(rtac (inject_Ispair RS conjunct2) 1),
  45.313 +	(fast_tac HOL_cs  3),
  45.314 +	(fast_tac HOL_cs  1),
  45.315 +	(fast_tac HOL_cs  1),
  45.316 +	(fast_tac HOL_cs  1)
  45.317 +	]);
  45.318 +
  45.319 +val Isfst2 = prove_goal Sprod0.thy "~y=UU ==>Isfst(Ispair(x,y))=x"
  45.320 +(fn prems =>
  45.321 +	[
  45.322 +	(cut_facts_tac prems 1),
  45.323 +	(res_inst_tac [("Q","x=UU")] (excluded_middle RS disjE) 1),
  45.324 +	(etac Isfst 1),
  45.325 +	(atac 1),
  45.326 +	(hyp_subst_tac 1),
  45.327 +	(rtac strict_Isfst1 1)
  45.328 +	]);
  45.329 +
  45.330 +val Issnd2 = prove_goal Sprod0.thy "~x=UU ==>Issnd(Ispair(x,y))=y"
  45.331 +(fn prems =>
  45.332 +	[
  45.333 +	(cut_facts_tac prems 1),
  45.334 +	(res_inst_tac [("Q","y=UU")] (excluded_middle RS disjE) 1),
  45.335 +	(etac Issnd 1),
  45.336 +	(atac 1),
  45.337 +	(hyp_subst_tac 1),
  45.338 +	(rtac strict_Issnd2 1)
  45.339 +	]);
  45.340 +
  45.341 +
  45.342 +(* ------------------------------------------------------------------------ *)
  45.343 +(* instantiate the simplifier                                               *)
  45.344 +(* ------------------------------------------------------------------------ *)
  45.345 +
  45.346 +val Sprod_ss = 
  45.347 +	HOL_ss 
  45.348 +	addsimps [strict_Isfst1,strict_Isfst2,strict_Issnd1,strict_Issnd2,
  45.349 +		 Isfst2,Issnd2];
  45.350 +
  45.351 +
  45.352 +val defined_IsfstIssnd = prove_goal Sprod0.thy 
  45.353 +	"~p=Ispair(UU,UU) ==> ~Isfst(p)=UU & ~Issnd(p)=UU"
  45.354 + (fn prems =>
  45.355 +	[
  45.356 +	(cut_facts_tac prems 1),
  45.357 +	(res_inst_tac [("p","p")] IsprodE 1),
  45.358 +	(contr_tac 1),
  45.359 +	(hyp_subst_tac 1),
  45.360 +	(rtac conjI 1),
  45.361 +	(asm_simp_tac Sprod_ss 1),
  45.362 +	(asm_simp_tac Sprod_ss 1)
  45.363 +	]);
  45.364 +
  45.365 +
  45.366 +(* ------------------------------------------------------------------------ *)
  45.367 +(* Surjective pairing: equivalent to Exh_Sprod                              *)
  45.368 +(* ------------------------------------------------------------------------ *)
  45.369 +
  45.370 +val surjective_pairing_Sprod = prove_goal Sprod0.thy 
  45.371 +	"z = Ispair(Isfst(z))(Issnd(z))"
  45.372 +(fn prems =>
  45.373 +	[
  45.374 +	(res_inst_tac [("z1","z")] (Exh_Sprod RS disjE) 1),
  45.375 +	(asm_simp_tac Sprod_ss 1),
  45.376 +	(etac exE 1),
  45.377 +	(etac exE 1),
  45.378 +	(asm_simp_tac Sprod_ss 1)
  45.379 +	]);
  45.380 +
  45.381 +
  45.382 +
  45.383 +
  45.384 +
  45.385 +
  45.386 +
  45.387 +
  45.388 +
  45.389 +
  45.390 +
  45.391 +
  45.392 +
    46.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    46.2 +++ b/src/HOLCF/Sprod0.thy	Wed Jan 19 17:35:01 1994 +0100
    46.3 @@ -0,0 +1,53 @@
    46.4 +(*  Title: 	HOLCF/sprod0.thy
    46.5 +    ID:         $Id$
    46.6 +    Author: 	Franz Regensburger
    46.7 +    Copyright   1993  Technische Universitaet Muenchen
    46.8 +
    46.9 +Strict product
   46.10 +*)
   46.11 +
   46.12 +Sprod0 = Cfun3 +
   46.13 +
   46.14 +(* new type for strict product *)
   46.15 +
   46.16 +types "**" 2        (infixr 20)
   46.17 +
   46.18 +arities "**" :: (pcpo,pcpo)term	
   46.19 +
   46.20 +consts
   46.21 +  Sprod		:: "('a => 'b => bool)set"
   46.22 +  Spair_Rep	:: "['a,'b] => ['a,'b] => bool"
   46.23 +  Rep_Sprod	:: "('a ** 'b) => ('a => 'b => bool)"
   46.24 +  Abs_Sprod	:: "('a => 'b => bool) => ('a ** 'b)"
   46.25 +  Ispair	:: "['a,'b] => ('a ** 'b)"
   46.26 +  Isfst		:: "('a ** 'b) => 'a"
   46.27 +  Issnd		:: "('a ** 'b) => 'b"  
   46.28 +
   46.29 +rules
   46.30 +
   46.31 +  Spair_Rep_def		"Spair_Rep == (%a b. %x y.\
   46.32 +\				(~a=UU & ~b=UU --> x=a  & y=b ))"
   46.33 +
   46.34 +  Sprod_def		"Sprod == {f. ? a b. f = Spair_Rep(a,b)}"
   46.35 +
   46.36 +  (*faking a type definition... *)
   46.37 +  (* "**" is isomorphic to Sprod *)
   46.38 +
   46.39 +  Rep_Sprod		"Rep_Sprod(p):Sprod"		
   46.40 +  Rep_Sprod_inverse	"Abs_Sprod(Rep_Sprod(p)) = p"	
   46.41 +  Abs_Sprod_inverse	"f:Sprod ==> Rep_Sprod(Abs_Sprod(f)) = f"
   46.42 +
   46.43 +   (*defining the abstract constants*)
   46.44 +
   46.45 +  Ispair_def	"Ispair(a,b) == Abs_Sprod(Spair_Rep(a,b))"
   46.46 +
   46.47 +  Isfst_def	"Isfst(p) == @z.\
   46.48 +\					(p=Ispair(UU,UU) --> z=UU)\
   46.49 +\		&(! a b. ~a=UU & ~b=UU & p=Ispair(a,b)   --> z=a)"  
   46.50 +
   46.51 +  Issnd_def	"Issnd(p) == @z.\
   46.52 +\					(p=Ispair(UU,UU) --> z=UU)\
   46.53 +\		&(! a b. ~a=UU & ~b=UU & p=Ispair(a,b)   --> z=b)"  
   46.54 +
   46.55 +end
   46.56 +
    47.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    47.2 +++ b/src/HOLCF/Sprod1.ML	Wed Jan 19 17:35:01 1994 +0100
    47.3 @@ -0,0 +1,204 @@
    47.4 +(*  Title: 	HOLCF/sprod1.ML
    47.5 +    ID:         $Id$
    47.6 +    Author: 	Franz Regensburger
    47.7 +    Copyright   1993  Technische Universitaet Muenchen
    47.8 +
    47.9 +Lemmas for theory sprod1.thy
   47.10 +*)
   47.11 +
   47.12 +open Sprod1;
   47.13 +
   47.14 +(* ------------------------------------------------------------------------ *)
   47.15 +(* reduction properties for less_sprod                                      *)
   47.16 +(* ------------------------------------------------------------------------ *)
   47.17 +
   47.18 +
   47.19 +val less_sprod1a = prove_goalw Sprod1.thy [less_sprod_def]
   47.20 +	"p1=Ispair(UU,UU) ==> less_sprod(p1,p2)"
   47.21 +(fn prems =>
   47.22 +	[
   47.23 +	(cut_facts_tac prems 1),
   47.24 +	(rtac eqTrueE 1),
   47.25 +	(rtac select_equality 1),
   47.26 +	(rtac conjI 1),
   47.27 +	(fast_tac HOL_cs 1),
   47.28 +	(strip_tac 1),
   47.29 +	(contr_tac 1),
   47.30 +	(dtac conjunct1 1),
   47.31 +	(etac rev_mp 1),
   47.32 +	(atac 1)
   47.33 +	]);
   47.34 +
   47.35 +val less_sprod1b = prove_goalw Sprod1.thy [less_sprod_def]
   47.36 + "~p1=Ispair(UU,UU) ==> \
   47.37 +\ less_sprod(p1,p2) = ( Isfst(p1) << Isfst(p2) & Issnd(p1) << Issnd(p2))"
   47.38 +(fn prems =>
   47.39 +	[
   47.40 +	(cut_facts_tac prems 1),
   47.41 +	(rtac select_equality 1),
   47.42 +	(rtac conjI 1),
   47.43 +	(strip_tac 1),
   47.44 +	(contr_tac 1),
   47.45 +	(fast_tac HOL_cs 1),
   47.46 +	(dtac conjunct2 1),
   47.47 +	(etac rev_mp 1),
   47.48 +	(atac 1)
   47.49 +	]);
   47.50 +
   47.51 +val less_sprod2a = prove_goal Sprod1.thy
   47.52 +	"less_sprod(Ispair(x,y),Ispair(UU,UU)) ==> x = UU | y = UU"
   47.53 +(fn prems =>
   47.54 +	[
   47.55 +	(cut_facts_tac prems 1),
   47.56 +	(rtac (excluded_middle RS disjE) 1),
   47.57 +	(atac 2),
   47.58 +	(rtac disjI1 1),
   47.59 +	(rtac antisym_less 1),
   47.60 +	(rtac minimal 2),
   47.61 +	(res_inst_tac [("s","Isfst(Ispair(x,y))"),("t","x")] subst 1),
   47.62 +	(rtac Isfst 1),
   47.63 +	(fast_tac HOL_cs 1),
   47.64 +	(fast_tac HOL_cs 1),
   47.65 +	(res_inst_tac [("s","Isfst(Ispair(UU,UU))"),("t","UU")] subst 1),
   47.66 +	(simp_tac Sprod_ss 1),
   47.67 +	(rtac (defined_Ispair RS less_sprod1b RS iffD1 RS conjunct1) 1),
   47.68 +	(REPEAT (fast_tac HOL_cs 1))
   47.69 +	]);
   47.70 +
   47.71 +val less_sprod2b = prove_goal Sprod1.thy
   47.72 + "less_sprod(p,Ispair(UU,UU)) ==> p = Ispair(UU,UU)"
   47.73 +(fn prems =>
   47.74 +	[
   47.75 +	(cut_facts_tac prems 1),
   47.76 +	(res_inst_tac [("p","p")] IsprodE 1),
   47.77 +	(atac 1),
   47.78 +	(hyp_subst_tac 1),
   47.79 +	(rtac strict_Ispair 1),
   47.80 +	(etac less_sprod2a 1)
   47.81 +	]);
   47.82 +
   47.83 +val less_sprod2c = prove_goal Sprod1.thy 
   47.84 + "[|less_sprod(Ispair(xa,ya),Ispair(x,y));\
   47.85 +\~ xa = UU ; ~ ya = UU;~ x = UU ; ~ y = UU |] ==> xa << x & ya << y"
   47.86 +(fn prems =>
   47.87 +	[
   47.88 +	(rtac conjI 1),
   47.89 +	(res_inst_tac [("s","Isfst(Ispair(xa,ya))"),("t","xa")] subst 1),
   47.90 +	(simp_tac (Sprod_ss addsimps prems)1),
   47.91 +	(res_inst_tac [("s","Isfst(Ispair(x,y))"),("t","x")] subst 1),
   47.92 +	(simp_tac (Sprod_ss addsimps prems)1),
   47.93 +	(rtac (defined_Ispair RS less_sprod1b RS iffD1 RS conjunct1) 1),
   47.94 +	(resolve_tac prems 1),
   47.95 +	(resolve_tac prems 1),
   47.96 +	(simp_tac (Sprod_ss addsimps prems)1),
   47.97 +	(res_inst_tac [("s","Issnd(Ispair(xa,ya))"),("t","ya")] subst 1),
   47.98 +	(simp_tac (Sprod_ss addsimps prems)1),
   47.99 +	(res_inst_tac [("s","Issnd(Ispair(x,y))"),("t","y")] subst 1),
  47.100 +	(simp_tac (Sprod_ss addsimps prems)1),
  47.101 +	(rtac (defined_Ispair RS less_sprod1b RS iffD1 RS conjunct2) 1),
  47.102 +	(resolve_tac prems 1),
  47.103 +	(resolve_tac prems 1),
  47.104 +	(simp_tac (Sprod_ss addsimps prems)1)
  47.105 +	]);
  47.106 +
  47.107 +(* ------------------------------------------------------------------------ *)
  47.108 +(* less_sprod is a partial order on Sprod                                   *)
  47.109 +(* ------------------------------------------------------------------------ *)
  47.110 +
  47.111 +val refl_less_sprod = prove_goal Sprod1.thy "less_sprod(p,p)"
  47.112 +(fn prems =>
  47.113 +	[
  47.114 +	(res_inst_tac [("p","p")] IsprodE 1),
  47.115 +	(etac less_sprod1a 1),
  47.116 +	(hyp_subst_tac 1),
  47.117 +	(rtac (less_sprod1b RS ssubst) 1),
  47.118 +	(rtac defined_Ispair 1),
  47.119 +	(REPEAT (fast_tac (HOL_cs addIs [refl_less]) 1))
  47.120 +	]);
  47.121 +
  47.122 +
  47.123 +val antisym_less_sprod = prove_goal Sprod1.thy 
  47.124 + "[|less_sprod(p1,p2);less_sprod(p2,p1)|] ==> p1=p2"
  47.125 + (fn prems =>
  47.126 +	[
  47.127 +	(cut_facts_tac prems 1),
  47.128 +	(res_inst_tac [("p","p1")] IsprodE 1),
  47.129 +	(hyp_subst_tac 1),
  47.130 +	(res_inst_tac [("p","p2")] IsprodE 1),
  47.131 +	(hyp_subst_tac 1),
  47.132 +	(rtac refl 1),
  47.133 +	(hyp_subst_tac 1),
  47.134 +	(rtac (strict_Ispair RS sym) 1),
  47.135 +	(etac less_sprod2a 1),
  47.136 +	(hyp_subst_tac 1),
  47.137 +	(res_inst_tac [("p","p2")] IsprodE 1),
  47.138 +	(hyp_subst_tac 1),
  47.139 +	(rtac (strict_Ispair) 1),
  47.140 +	(etac less_sprod2a 1),
  47.141 +	(hyp_subst_tac 1),
  47.142 +	(res_inst_tac [("x1","x"),("y1","xa"),("x","y"),("y","ya")] (arg_cong RS cong) 1),
  47.143 +	(rtac antisym_less 1),
  47.144 +	(asm_simp_tac (HOL_ss addsimps [less_sprod2c RS conjunct1]) 1),
  47.145 +	(asm_simp_tac (HOL_ss addsimps [less_sprod2c RS conjunct1]) 1),
  47.146 +	(rtac antisym_less 1),
  47.147 +	(asm_simp_tac (HOL_ss addsimps [less_sprod2c RS conjunct2]) 1),
  47.148 +	(asm_simp_tac (HOL_ss addsimps [less_sprod2c RS conjunct2]) 1)
  47.149 +	]);
  47.150 +
  47.151 +val trans_less_sprod = prove_goal Sprod1.thy 
  47.152 + "[|less_sprod(p1,p2);less_sprod(p2,p3)|] ==> less_sprod(p1,p3)"
  47.153 +(fn prems =>
  47.154 +	[
  47.155 +	(cut_facts_tac prems 1),
  47.156 +	(res_inst_tac [("p","p1")] IsprodE 1),
  47.157 +	(etac less_sprod1a 1),
  47.158 +	(hyp_subst_tac 1),
  47.159 +	(res_inst_tac [("p","p3")] IsprodE 1),
  47.160 +	(hyp_subst_tac 1),
  47.161 +	(res_inst_tac [("s","p2"),("t","Ispair(UU,UU)")] subst 1),
  47.162 +	(etac less_sprod2b 1),
  47.163 +	(atac 1),
  47.164 +	(hyp_subst_tac 1),
  47.165 +	(res_inst_tac [("Q","p2=Ispair(UU,UU)")]  
  47.166 +		(excluded_middle RS disjE) 1),
  47.167 +	(rtac (defined_Ispair RS less_sprod1b RS ssubst) 1),
  47.168 +	(atac 1),
  47.169 +	(atac 1),
  47.170 +	(rtac conjI 1),
  47.171 +	(res_inst_tac [("y","Isfst(p2)")] trans_less 1),
  47.172 +	(rtac conjunct1 1),
  47.173 +	(rtac (less_sprod1b RS subst) 1),
  47.174 +	(rtac defined_Ispair 1),
  47.175 +	(atac 1),
  47.176 +	(atac 1),
  47.177 +	(atac 1),
  47.178 +	(rtac conjunct1 1),
  47.179 +	(rtac (less_sprod1b RS subst) 1),
  47.180 +	(atac 1),
  47.181 +	(atac 1),
  47.182 +	(res_inst_tac [("y","Issnd(p2)")] trans_less 1),
  47.183 +	(rtac conjunct2 1),
  47.184 +	(rtac (less_sprod1b RS subst) 1),
  47.185 +	(rtac defined_Ispair 1),
  47.186 +	(atac 1),
  47.187 +	(atac 1),
  47.188 +	(atac 1),
  47.189 +	(rtac conjunct2 1),
  47.190 +	(rtac (less_sprod1b RS subst) 1),
  47.191 +	(atac 1),
  47.192 +	(atac 1),
  47.193 +	(hyp_subst_tac 1),
  47.194 +	(res_inst_tac [("s","Ispair(UU,UU)"),("t","Ispair(x,y)")] subst 1),
  47.195 +	(etac (less_sprod2b RS sym) 1),
  47.196 +	(atac 1)
  47.197 +	]);
  47.198 +
  47.199 +
  47.200 +
  47.201 +
  47.202 +
  47.203 +
  47.204 +
  47.205 +
  47.206 +
  47.207 +
    48.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    48.2 +++ b/src/HOLCF/Sprod1.thy	Wed Jan 19 17:35:01 1994 +0100
    48.3 @@ -0,0 +1,22 @@
    48.4 +(*  Title: 	HOLCF/sprod1.thy
    48.5 +    ID:         $Id$
    48.6 +    Author: 	Franz Regensburger
    48.7 +    Copyright   1993  Technische Universitaet Muenchen
    48.8 +
    48.9 +Partial ordering for the strict product
   48.10 +*)
   48.11 +
   48.12 +Sprod1 = Sprod0 +
   48.13 +
   48.14 +consts
   48.15 +  less_sprod	:: "[('a ** 'b),('a ** 'b)] => bool"	
   48.16 +
   48.17 +rules
   48.18 +
   48.19 +  less_sprod_def "less_sprod(p1,p2) == @z.\
   48.20 +\	 ( p1=Ispair(UU,UU) --> z = True)\
   48.21 +\	&(~p1=Ispair(UU,UU) --> z = (   Isfst(p1) << Isfst(p2) &\
   48.22 +\					Issnd(p1) << Issnd(p2)))"
   48.23 +
   48.24 +end
   48.25 +
    49.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    49.2 +++ b/src/HOLCF/Sprod2.ML	Wed Jan 19 17:35:01 1994 +0100
    49.3 @@ -0,0 +1,274 @@
    49.4 +(*  Title: 	HOLCF/sprod2.ML
    49.5 +    ID:         $Id$
    49.6 +    Author: 	Franz Regensburger
    49.7 +    Copyright   1993 Technische Universitaet Muenchen
    49.8 +
    49.9 +Lemmas for sprod2.thy
   49.10 +*)
   49.11 +
   49.12 +
   49.13 +open Sprod2;
   49.14 +
   49.15 +(* ------------------------------------------------------------------------ *)
   49.16 +(* access to less_sprod in class po                                         *)
   49.17 +(* ------------------------------------------------------------------------ *)
   49.18 +
   49.19 +val less_sprod3a = prove_goal Sprod2.thy 
   49.20 +	"p1=Ispair(UU,UU) ==> p1 << p2"
   49.21 +(fn prems =>
   49.22 +	[
   49.23 +	(cut_facts_tac prems 1),
   49.24 +	(rtac (inst_sprod_po RS ssubst) 1),
   49.25 +	(etac less_sprod1a 1)
   49.26 +	]);
   49.27 +
   49.28 +
   49.29 +val less_sprod3b = prove_goal Sprod2.thy
   49.30 + "~p1=Ispair(UU,UU) ==>\
   49.31 +\	(p1<<p2) = (Isfst(p1)<<Isfst(p2) & Issnd(p1)<<Issnd(p2))" 
   49.32 +(fn prems =>
   49.33 +	[
   49.34 +	(cut_facts_tac prems 1),
   49.35 +	(rtac (inst_sprod_po RS ssubst) 1),
   49.36 +	(etac less_sprod1b 1)
   49.37 +	]);
   49.38 +
   49.39 +val less_sprod4b = prove_goal Sprod2.thy 
   49.40 +	"p << Ispair(UU,UU) ==> p = Ispair(UU,UU)"
   49.41 +(fn prems =>
   49.42 +	[
   49.43 +	(cut_facts_tac prems 1),
   49.44 +	(rtac less_sprod2b 1),
   49.45 +	(etac (inst_sprod_po RS subst) 1)
   49.46 +	]);
   49.47 +
   49.48 +val less_sprod4a = (less_sprod4b RS defined_Ispair_rev);
   49.49 +(* Ispair(?a,?b) << Ispair(UU,UU) ==> ?a = UU | ?b = UU *)
   49.50 +
   49.51 +val less_sprod4c = prove_goal Sprod2.thy
   49.52 + "[|Ispair(xa,ya)<<Ispair(x,y);~xa=UU;~ya=UU;~x=UU;~y=UU|] ==>\
   49.53 +\		xa<<x & ya << y"
   49.54 +(fn prems =>
   49.55 +	[
   49.56 +	(cut_facts_tac prems 1),
   49.57 +	(rtac less_sprod2c 1),
   49.58 +	(etac (inst_sprod_po RS subst) 1),
   49.59 +	(REPEAT (atac 1))
   49.60 +	]);
   49.61 +
   49.62 +(* ------------------------------------------------------------------------ *)
   49.63 +(* type sprod is pointed                                                    *)
   49.64 +(* ------------------------------------------------------------------------ *)
   49.65 +
   49.66 +val minimal_sprod = prove_goal Sprod2.thy  "Ispair(UU,UU)<<p"
   49.67 +(fn prems =>
   49.68 +	[
   49.69 +	(rtac less_sprod3a 1),
   49.70 +	(rtac refl 1)
   49.71 +	]);
   49.72 +
   49.73 +(* ------------------------------------------------------------------------ *)
   49.74 +(* Ispair is monotone in both arguments                                     *)
   49.75 +(* ------------------------------------------------------------------------ *)
   49.76 +
   49.77 +val monofun_Ispair1 = prove_goalw Sprod2.thy [monofun] "monofun(Ispair)"
   49.78 +(fn prems =>
   49.79 +	[
   49.80 +	(strip_tac 1),
   49.81 +	(rtac (less_fun RS iffD2) 1),
   49.82 +	(strip_tac 1),
   49.83 +	(res_inst_tac [("Q",
   49.84 +	" Ispair(y,xa) =Ispair(UU,UU)")] (excluded_middle RS disjE) 1),
   49.85 +	(res_inst_tac [("Q",
   49.86 +	" Ispair(x,xa) =Ispair(UU,UU)")] (excluded_middle RS disjE) 1),
   49.87 +	(rtac (less_sprod3b RS iffD2) 1),
   49.88 +	(atac 1),
   49.89 +	(rtac conjI 1),
   49.90 +	(rtac (Isfst RS ssubst) 1),
   49.91 +	(etac (strict_Ispair_rev RS conjunct1) 1),
   49.92 +	(etac (strict_Ispair_rev RS conjunct2) 1),
   49.93 +	(rtac (Isfst RS ssubst) 1),
   49.94 +	(etac (strict_Ispair_rev RS conjunct1) 1),
   49.95 +	(etac (strict_Ispair_rev RS conjunct2) 1),
   49.96 +	(atac 1),
   49.97 +	(rtac (Issnd RS ssubst) 1),
   49.98 +	(etac (strict_Ispair_rev RS conjunct1) 1),
   49.99 +	(etac (strict_Ispair_rev RS conjunct2) 1),
  49.100 +	(rtac (Issnd RS ssubst) 1),
  49.101 +	(etac (strict_Ispair_rev RS conjunct1) 1),
  49.102 +	(etac (strict_Ispair_rev RS conjunct2) 1),
  49.103 +	(rtac refl_less 1),
  49.104 +	(etac less_sprod3a 1),
  49.105 +	(res_inst_tac [("Q",
  49.106 +	" Ispair(x,xa) =Ispair(UU,UU)")] (excluded_middle RS disjE) 1),
  49.107 +	(etac less_sprod3a 2),
  49.108 +	(res_inst_tac [("P","Ispair(y,xa) = Ispair(UU,UU)")] notE 1),
  49.109 +	(atac 2),
  49.110 +	(rtac defined_Ispair 1),
  49.111 +	(etac notUU_I 1),
  49.112 +	(etac (strict_Ispair_rev RS  conjunct1) 1),
  49.113 +	(etac (strict_Ispair_rev RS  conjunct2) 1)
  49.114 +	]);
  49.115 +
  49.116 +
  49.117 +val monofun_Ispair2 = prove_goalw Sprod2.thy [monofun] "monofun(Ispair(x))"
  49.118 +(fn prems =>
  49.119 +	[
  49.120 +	(strip_tac 1),
  49.121 +	(res_inst_tac [("Q",
  49.122 +	" Ispair(x,y) =Ispair(UU,UU)")] (excluded_middle RS disjE) 1),
  49.123 +	(res_inst_tac [("Q",
  49.124 +	" Ispair(x,xa) =Ispair(UU,UU)")] (excluded_middle RS disjE) 1),
  49.125 +	(rtac (less_sprod3b RS iffD2) 1),
  49.126 +	(atac 1),
  49.127 +	(rtac conjI 1),
  49.128 +	(rtac (Isfst RS ssubst) 1),
  49.129 +	(etac (strict_Ispair_rev RS conjunct1) 1),
  49.130 +	(etac (strict_Ispair_rev RS conjunct2) 1),
  49.131 +	(rtac (Isfst RS ssubst) 1),
  49.132 +	(etac (strict_Ispair_rev RS conjunct1) 1),
  49.133 +	(etac (strict_Ispair_rev RS conjunct2) 1),
  49.134 +	(rtac refl_less 1),
  49.135 +	(rtac (Issnd RS ssubst) 1),
  49.136 +	(etac (strict_Ispair_rev RS conjunct1) 1),
  49.137 +	(etac (strict_Ispair_rev RS conjunct2) 1),
  49.138 +	(rtac (Issnd RS ssubst) 1),
  49.139 +	(etac (strict_Ispair_rev RS conjunct1) 1),
  49.140 +	(etac (strict_Ispair_rev RS conjunct2) 1),
  49.141 +	(atac 1),
  49.142 +	(etac less_sprod3a 1),
  49.143 +	(res_inst_tac [("Q",
  49.144 +	" Ispair(x,xa) =Ispair(UU,UU)")] (excluded_middle RS disjE) 1),
  49.145 +	(etac less_sprod3a 2),
  49.146 +	(res_inst_tac [("P","Ispair(x,y) = Ispair(UU,UU)")] notE 1),
  49.147 +	(atac 2),
  49.148 +	(rtac defined_Ispair 1),
  49.149 +	(etac (strict_Ispair_rev RS  conjunct1) 1),
  49.150 +	(etac notUU_I 1),
  49.151 +	(etac (strict_Ispair_rev RS  conjunct2) 1)
  49.152 +	]);
  49.153 +
  49.154 +val  monofun_Ispair = prove_goal Sprod2.thy 
  49.155 + "[|x1<<x2; y1<<y2|] ==> Ispair(x1,y1)<<Ispair(x2,y2)"
  49.156 +(fn prems =>
  49.157 +	[
  49.158 +	(cut_facts_tac prems 1),
  49.159 +	(rtac trans_less 1),
  49.160 +	(rtac (monofun_Ispair1 RS monofunE RS spec RS spec RS mp RS 
  49.161 +	(less_fun RS iffD1 RS spec)) 1),
  49.162 +	(rtac (monofun_Ispair2 RS monofunE RS spec RS spec RS mp) 2),
  49.163 +	(atac 1),
  49.164 +	(atac 1)
  49.165 +	]);
  49.166 +
  49.167 +
  49.168 +(* ------------------------------------------------------------------------ *)
  49.169 +(* Isfst and Issnd are monotone                                             *)
  49.170 +(* ------------------------------------------------------------------------ *)
  49.171 +
  49.172 +val  monofun_Isfst = prove_goalw Sprod2.thy [monofun] "monofun(Isfst)"
  49.173 +(fn prems =>
  49.174 +	[
  49.175 +	(strip_tac 1),
  49.176 +	(res_inst_tac [("p","x")] IsprodE 1),
  49.177 +	(hyp_subst_tac 1),
  49.178 +	(rtac trans_less 1),
  49.179 +	(rtac minimal 2),
  49.180 +	(rtac (strict_Isfst1 RS ssubst) 1),
  49.181 +	(rtac refl_less 1),
  49.182 +	(hyp_subst_tac 1),
  49.183 +	(res_inst_tac [("p","y")] IsprodE 1),
  49.184 +	(hyp_subst_tac 1),
  49.185 +	(res_inst_tac [("t","Isfst(Ispair(xa,ya))")] subst 1),
  49.186 +	(rtac refl_less 2),
  49.187 +	(etac (less_sprod4b RS sym RS arg_cong) 1),
  49.188 +	(hyp_subst_tac 1),
  49.189 +	(rtac (Isfst RS ssubst) 1),
  49.190 +	(atac 1),
  49.191 +	(atac 1),
  49.192 +	(rtac (Isfst RS ssubst) 1),
  49.193 +	(atac 1),
  49.194 +	(atac 1),
  49.195 +	(etac (less_sprod4c RS  conjunct1) 1),
  49.196 +	(REPEAT (atac 1))
  49.197 +	]);
  49.198 +
  49.199 +val monofun_Issnd = prove_goalw Sprod2.thy [monofun] "monofun(Issnd)"
  49.200 +(fn prems =>
  49.201 +	[
  49.202 +	(strip_tac 1),
  49.203 +	(res_inst_tac [("p","x")] IsprodE 1),
  49.204 +	(hyp_subst_tac 1),
  49.205 +	(rtac trans_less 1),
  49.206 +	(rtac minimal 2),
  49.207 +	(rtac (strict_Issnd1 RS ssubst) 1),
  49.208 +	(rtac refl_less 1),
  49.209 +	(hyp_subst_tac 1),
  49.210 +	(res_inst_tac [("p","y")] IsprodE 1),
  49.211 +	(hyp_subst_tac 1),
  49.212 +	(res_inst_tac [("t","Issnd(Ispair(xa,ya))")] subst 1),
  49.213 +	(rtac refl_less 2),
  49.214 +	(etac (less_sprod4b RS sym RS arg_cong) 1),
  49.215 +	(hyp_subst_tac 1),
  49.216 +	(rtac (Issnd RS ssubst) 1),
  49.217 +	(atac 1),
  49.218 +	(atac 1),
  49.219 +	(rtac (Issnd RS ssubst) 1),
  49.220 +	(atac 1),
  49.221 +	(atac 1),
  49.222 +	(etac (less_sprod4c RS  conjunct2) 1),
  49.223 +	(REPEAT (atac 1))
  49.224 +	]);
  49.225 +
  49.226 +
  49.227 +(* ------------------------------------------------------------------------ *)
  49.228 +(* the type 'a ** 'b is a cpo                                               *)
  49.229 +(* ------------------------------------------------------------------------ *)
  49.230 +
  49.231 +val lub_sprod = prove_goal Sprod2.thy 
  49.232 +"[|is_chain(S)|] ==> range(S) <<| \
  49.233 +\ Ispair(lub(range(%i.Isfst(S(i)))),lub(range(%i.Issnd(S(i)))))"
  49.234 +(fn prems =>
  49.235 +	[
  49.236 +	(cut_facts_tac prems 1),
  49.237 +	(rtac is_lubI 1),
  49.238 +	(rtac conjI 1),
  49.239 +	(rtac ub_rangeI 1),
  49.240 +	(rtac allI 1),
  49.241 +	(res_inst_tac [("t","S(i)")] (surjective_pairing_Sprod RS ssubst) 1),
  49.242 +	(rtac monofun_Ispair 1),
  49.243 +	(rtac is_ub_thelub 1),
  49.244 +	(etac (monofun_Isfst RS ch2ch_monofun) 1),
  49.245 +	(rtac is_ub_thelub 1),
  49.246 +	(etac (monofun_Issnd RS ch2ch_monofun) 1),
  49.247 +	(strip_tac 1),
  49.248 +	(res_inst_tac [("t","u")] (surjective_pairing_Sprod RS ssubst) 1),
  49.249 +	(rtac monofun_Ispair 1),
  49.250 +	(rtac is_lub_thelub 1),
  49.251 +	(etac (monofun_Isfst RS ch2ch_monofun) 1),
  49.252 +	(etac (monofun_Isfst RS ub2ub_monofun) 1),
  49.253 +	(rtac is_lub_thelub 1),
  49.254 +	(etac (monofun_Issnd RS ch2ch_monofun) 1),
  49.255 +	(etac (monofun_Issnd RS ub2ub_monofun) 1)
  49.256 +	]);
  49.257 +
  49.258 +val thelub_sprod = (lub_sprod RS thelubI);
  49.259 +(* is_chain(?S1) ==> lub(range(?S1)) =                                     *)
  49.260 +(* Ispair(lub(range(%i. Isfst(?S1(i)))),lub(range(%i. Issnd(?S1(i)))))     *)
  49.261 +
  49.262 +val cpo_sprod = prove_goal Sprod2.thy 
  49.263 +	"is_chain(S::nat=>'a**'b)==>? x.range(S)<<| x"
  49.264 +(fn prems =>
  49.265 +	[
  49.266 +	(cut_facts_tac prems 1),
  49.267 +	(rtac exI 1),
  49.268 +	(etac lub_sprod 1)
  49.269 +	]);
  49.270 +
  49.271 +
  49.272 +
  49.273 +
  49.274 +
  49.275 +
  49.276 +
  49.277 +
    50.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    50.2 +++ b/src/HOLCF/Sprod2.thy	Wed Jan 19 17:35:01 1994 +0100
    50.3 @@ -0,0 +1,24 @@
    50.4 +(*  Title: 	HOLCF/sprod2.thy
    50.5 +    ID:         $Id$
    50.6 +    Author: 	Franz Regensburger
    50.7 +    Copyright   1993 Technische Universitaet Muenchen
    50.8 +
    50.9 +Class Instance **::(pcpo,pcpo)po
   50.10 +*)
   50.11 +
   50.12 +Sprod2 = Sprod1 + 
   50.13 +
   50.14 +arities "**" :: (pcpo,pcpo)po
   50.15 +
   50.16 +(* Witness for the above arity axiom is sprod1.ML *)
   50.17 +
   50.18 +rules
   50.19 +
   50.20 +(* instance of << for type ['a ** 'b]  *)
   50.21 +
   50.22 +inst_sprod_po	"(op <<)::['a ** 'b,'a ** 'b]=>bool = less_sprod"
   50.23 +
   50.24 +end
   50.25 +
   50.26 +
   50.27 +
    51.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    51.2 +++ b/src/HOLCF/Sprod3.ML	Wed Jan 19 17:35:01 1994 +0100
    51.3 @@ -0,0 +1,695 @@
    51.4 +(*  Title: 	HOLCF/sprod3.thy
    51.5 +    ID:         $Id$
    51.6 +    Author: 	Franz Regensburger
    51.7 +    Copyright   1993 Technische Universitaet Muenchen
    51.8 +
    51.9 +Lemmas for Sprod3.thy 
   51.10 +*)
   51.11 +
   51.12 +open Sprod3;
   51.13 +
   51.14 +(* ------------------------------------------------------------------------ *)
   51.15 +(* continuity of Ispair, Isfst, Issnd                                       *)
   51.16 +(* ------------------------------------------------------------------------ *)
   51.17 +
   51.18 +val sprod3_lemma1 = prove_goal Sprod3.thy 
   51.19 +"[| is_chain(Y);  x~= UU;  lub(range(Y))~= UU |] ==>\
   51.20 +\ Ispair(lub(range(Y)),x) =\
   51.21 +\ Ispair(lub(range(%i. Isfst(Ispair(Y(i),x)))),\
   51.22 +\        lub(range(%i. Issnd(Ispair(Y(i),x)))))"
   51.23 + (fn prems =>
   51.24 +	[
   51.25 +	(cut_facts_tac prems 1),
   51.26 +	(res_inst_tac [("f1","Ispair")] (arg_cong RS cong) 1),
   51.27 +	(rtac lub_equal 1),
   51.28 +	(atac 1),
   51.29 +	(rtac (monofun_Isfst RS ch2ch_monofun) 1),
   51.30 +	(rtac ch2ch_fun 1),
   51.31 +	(rtac (monofun_Ispair1 RS ch2ch_monofun) 1),
   51.32 +	(atac 1),
   51.33 +	(rtac allI 1),
   51.34 +	(asm_simp_tac Sprod_ss 1),
   51.35 +	(rtac sym 1),
   51.36 +	(rtac lub_chain_maxelem 1),
   51.37 +	(rtac (monofun_Issnd RS ch2ch_monofun) 1),
   51.38 +	(rtac ch2ch_fun 1),
   51.39 +	(rtac (monofun_Ispair1 RS ch2ch_monofun) 1),
   51.40 +	(atac 1),
   51.41 +	(res_inst_tac [("P","%j.~Y(j)=UU")] exE 1),
   51.42 +	(rtac (notall2ex RS iffD1) 1),
   51.43 +	(res_inst_tac [("Q","lub(range(Y)) = UU")] contrapos 1),
   51.44 +	(atac 1),
   51.45 +	(rtac chain_UU_I_inverse 1),
   51.46 +	(atac 1),
   51.47 +	(rtac exI 1),
   51.48 +	(etac Issnd2 1),
   51.49 +	(rtac allI 1),
   51.50 +	(res_inst_tac [("Q","Y(i)=UU")] (excluded_middle RS disjE) 1),
   51.51 +	(asm_simp_tac Sprod_ss  1),
   51.52 +	(rtac refl_less 1),
   51.53 +	(res_inst_tac [("s","UU"),("t","Y(i)")] subst 1),
   51.54 +	(etac sym 1),
   51.55 +	(asm_simp_tac Sprod_ss  1),
   51.56 +	(rtac minimal 1)
   51.57 +	]);
   51.58 +
   51.59 +
   51.60 +val sprod3_lemma2 = prove_goal Sprod3.thy 
   51.61 +"[| is_chain(Y); ~ x = UU; lub(range(Y)) = UU |] ==>\
   51.62 +\   Ispair(lub(range(Y)),x) =\
   51.63 +\   Ispair(lub(range(%i. Isfst(Ispair(Y(i),x)))),\
   51.64 +\          lub(range(%i. Issnd(Ispair(Y(i),x)))))"
   51.65 + (fn prems =>
   51.66 +	[
   51.67 +	(cut_facts_tac prems 1),
   51.68 +	(res_inst_tac [("s","UU"),("t","lub(range(Y))")] ssubst 1),
   51.69 +	(atac 1),
   51.70 +	(rtac trans 1),
   51.71 +	(rtac strict_Ispair1 1),
   51.72 +	(rtac (strict_Ispair RS sym) 1),
   51.73 +	(rtac disjI1 1),
   51.74 +	(rtac chain_UU_I_inverse 1),
   51.75 +	(rtac allI 1),
   51.76 +	(asm_simp_tac Sprod_ss  1),
   51.77 +	(etac (chain_UU_I RS spec) 1),
   51.78 +	(atac 1)
   51.79 +	]);
   51.80 +
   51.81 +
   51.82 +val sprod3_lemma3 = prove_goal Sprod3.thy 
   51.83 +"[| is_chain(Y); x = UU |] ==>\
   51.84 +\          Ispair(lub(range(Y)),x) =\
   51.85 +\          Ispair(lub(range(%i. Isfst(Ispair(Y(i),x)))),\
   51.86 +\                  lub(range(%i. Issnd(Ispair(Y(i),x)))))"
   51.87 + (fn prems =>
   51.88 +	[
   51.89 +	(cut_facts_tac prems 1),
   51.90 +	(res_inst_tac [("s","UU"),("t","x")] ssubst 1),
   51.91 +	(atac 1),
   51.92 +	(rtac trans 1),
   51.93 +	(rtac strict_Ispair2 1),
   51.94 +	(rtac (strict_Ispair RS sym) 1),
   51.95 +	(rtac disjI1 1),
   51.96 +	(rtac chain_UU_I_inverse 1),
   51.97 +	(rtac allI 1),
   51.98 +	(simp_tac Sprod_ss  1)
   51.99 +	]);
  51.100 +
  51.101 +
  51.102 +val contlub_Ispair1 = prove_goal Sprod3.thy "contlub(Ispair)"
  51.103 +(fn prems =>
  51.104 +	[
  51.105 +	(rtac contlubI 1),
  51.106 +	(strip_tac 1),
  51.107 +	(rtac (expand_fun_eq RS iffD2) 1),
  51.108 +	(strip_tac 1),
  51.109 +	(rtac (lub_fun RS thelubI RS ssubst) 1),
  51.110 +	(etac (monofun_Ispair1 RS ch2ch_monofun) 1),
  51.111 +	(rtac trans 1),
  51.112 +	(rtac (thelub_sprod RS sym) 2),
  51.113 +	(rtac ch2ch_fun 2),
  51.114 +	(etac (monofun_Ispair1 RS ch2ch_monofun) 2),
  51.115 +	(res_inst_tac [("Q","x=UU")] (excluded_middle RS disjE) 1),
  51.116 +	(res_inst_tac 
  51.117 +		[("Q","lub(range(Y))=UU")] (excluded_middle RS disjE) 1),
  51.118 +	(etac sprod3_lemma1 1),
  51.119 +	(atac 1),
  51.120 +	(atac 1),
  51.121 +	(etac sprod3_lemma2 1),
  51.122 +	(atac 1),
  51.123 +	(atac 1),
  51.124 +	(etac sprod3_lemma3 1),
  51.125 +	(atac 1)
  51.126 +	]);
  51.127 +
  51.128 +val sprod3_lemma4 = prove_goal Sprod3.thy 
  51.129 +"[| is_chain(Y); ~ x = UU; ~ lub(range(Y)) = UU |] ==>\
  51.130 +\         Ispair(x,lub(range(Y))) =\
  51.131 +\         Ispair(lub(range(%i. Isfst(Ispair(x,Y(i))))),\
  51.132 +\                lub(range(%i. Issnd(Ispair(x,Y(i))))))"
  51.133 +(fn prems =>
  51.134 +	[
  51.135 +	(cut_facts_tac prems 1),
  51.136 +	(res_inst_tac [("f1","Ispair")] (arg_cong RS cong) 1),
  51.137 +	(rtac sym 1),
  51.138 +	(rtac lub_chain_maxelem 1),
  51.139 +	(rtac (monofun_Isfst RS ch2ch_monofun) 1),
  51.140 +	(rtac (monofun_Ispair2 RS ch2ch_monofun) 1),
  51.141 +	(atac 1),
  51.142 +	(res_inst_tac [("P","%j.~Y(j)=UU")] exE 1),
  51.143 +	(rtac (notall2ex RS iffD1) 1),
  51.144 +	(res_inst_tac [("Q","lub(range(Y)) = UU")] contrapos 1),
  51.145 +	(atac 1),
  51.146 +	(rtac chain_UU_I_inverse 1),
  51.147 +	(atac 1),
  51.148 +	(rtac exI 1),
  51.149 +	(etac Isfst2 1),
  51.150 +	(rtac allI 1),
  51.151 +	(res_inst_tac [("Q","Y(i)=UU")] (excluded_middle RS disjE) 1),
  51.152 +	(asm_simp_tac Sprod_ss 1),
  51.153 +	(rtac refl_less 1),
  51.154 +	(res_inst_tac [("s","UU"),("t","Y(i)")] subst 1),
  51.155 +	(etac sym 1),
  51.156 +	(asm_simp_tac Sprod_ss  1),
  51.157 +	(rtac minimal 1),
  51.158 +	(rtac lub_equal 1),
  51.159 +	(atac 1),
  51.160 +	(rtac (monofun_Issnd RS ch2ch_monofun) 1),
  51.161 +	(rtac (monofun_Ispair2 RS ch2ch_monofun) 1),
  51.162 +	(atac 1),
  51.163 +	(rtac allI 1),
  51.164 +	(asm_simp_tac Sprod_ss 1)
  51.165 +	]);
  51.166 +
  51.167 +val sprod3_lemma5 = prove_goal Sprod3.thy 
  51.168 +"[| is_chain(Y); ~ x = UU; lub(range(Y)) = UU |] ==>\
  51.169 +\         Ispair(x,lub(range(Y))) =\
  51.170 +\         Ispair(lub(range(%i. Isfst(Ispair(x,Y(i))))),\
  51.171 +\                lub(range(%i. Issnd(Ispair(x,Y(i))))))"
  51.172 + (fn prems =>
  51.173 +	[
  51.174 +	(cut_facts_tac prems 1),
  51.175 +	(res_inst_tac [("s","UU"),("t","lub(range(Y))")] ssubst 1),
  51.176 +	(atac 1),
  51.177 +	(rtac trans 1),
  51.178 +	(rtac strict_Ispair2 1),
  51.179 +	(rtac (strict_Ispair RS sym) 1),
  51.180 +	(rtac disjI2 1),
  51.181 +	(rtac chain_UU_I_inverse 1),
  51.182 +	(rtac allI 1),
  51.183 +	(asm_simp_tac Sprod_ss  1),
  51.184 +	(etac (chain_UU_I RS spec) 1),
  51.185 +	(atac 1)
  51.186 +	]);
  51.187 +
  51.188 +val sprod3_lemma6 = prove_goal Sprod3.thy 
  51.189 +"[| is_chain(Y); x = UU |] ==>\
  51.190 +\         Ispair(x,lub(range(Y))) =\
  51.191 +\         Ispair(lub(range(%i. Isfst(Ispair(x,Y(i))))),\
  51.192 +\                lub(range(%i. Issnd(Ispair(x,Y(i))))))"
  51.193 +(fn prems =>
  51.194 +	[
  51.195 +	(cut_facts_tac prems 1),
  51.196 +	(res_inst_tac [("s","UU"),("t","x")] ssubst 1),
  51.197 +	(atac 1),
  51.198 +	(rtac trans 1),
  51.199 +	(rtac strict_Ispair1 1),
  51.200 +	(rtac (strict_Ispair RS sym) 1),
  51.201 +	(rtac disjI1 1),
  51.202 +	(rtac chain_UU_I_inverse 1),
  51.203 +	(rtac allI 1),
  51.204 +	(simp_tac Sprod_ss  1)
  51.205 +	]);
  51.206 +
  51.207 +val contlub_Ispair2 = prove_goal Sprod3.thy "contlub(Ispair(x))"
  51.208 +(fn prems =>
  51.209 +	[
  51.210 +	(rtac contlubI 1),
  51.211 +	(strip_tac 1),
  51.212 +	(rtac trans 1),
  51.213 +	(rtac (thelub_sprod RS sym) 2),
  51.214 +	(etac (monofun_Ispair2 RS ch2ch_monofun) 2),
  51.215 +	(res_inst_tac [("Q","x=UU")] (excluded_middle RS disjE) 1),
  51.216 +	(res_inst_tac [("Q","lub(range(Y))=UU")]