Changes of HOLCF from Oscar Slotosch:
authorslotosch
Mon Feb 17 10:57:11 1997 +0100 (1997-02-17)
changeset 2640ee4dfce170a0
parent 2639 2c38796b33b9
child 2641 533a84b3bedd
Changes of HOLCF from Oscar Slotosch:

1. axclass instead of class
* less instead of
less_fun,
less_cfun,
less_sprod,
less_cprod,
less_ssum,
less_up,
less_lift
* @x.!y.x<<y instead of UUU instead of
UU_fun, UU_cfun, ...
* no witness type void needed (eliminated Void.thy.Void.ML)
* inst_<typ>_<class> derived as theorems

2. improved some proves on less_sprod and less_cprod
* eliminated the following theorems
Sprod1.ML: less_sprod1a
Sprod1.ML: less_sprod1b
Sprod1.ML: less_sprod2a
Sprod1.ML: less_sprod2b
Sprod1.ML: less_sprod2c
Sprod2.ML: less_sprod3a
Sprod2.ML: less_sprod3b
Sprod2.ML: less_sprod4b
Sprod2.ML: less_sprod4c
Sprod3.ML: less_sprod5b
Sprod3.ML: less_sprod5c
Cprod1.ML: less_cprod1b
Cprod1.ML: less_cprod2a
Cprod1.ML: less_cprod2b
Cprod1.ML: less_cprod2c
Cprod2.ML: less_cprod3a
Cprod2.ML: less_cprod3b

3. new classes:
* cpo<po,
* chfin<pcpo,
* flat<pcpo,
* derived: flat<chfin
to do: show instances for lift

4. Data Type One
* Used lift for the definition: one = unit lift
* Changed the constant one into ONE

5. Data Type Tr
* Used lift for the definition: tr = bool lift
* adopted definitions of if,andalso,orelse,neg
* only one theory Tr.thy,Tr.ML instead of
Tr1.thy,Tr1.ML, Tr2.thy,Tr2.ML
* reintroduced ceils for =TT,=FF

6. typedef
* Using typedef instead of faking type definitions
to do: change fapp, fabs from Cfun1 to Rep_Cfun, Abs_Cfun

7. adopted examples and domain construct to theses changes

These changes eliminated all rules and arities from HOLCF
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/Cprod1.ML
src/HOLCF/Cprod1.thy
src/HOLCF/Cprod2.ML
src/HOLCF/Cprod2.thy
src/HOLCF/Cprod3.ML
src/HOLCF/Cprod3.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.thy
src/HOLCF/IsaMakefile
src/HOLCF/Lift.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/Porder0.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.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/Tr.ML
src/HOLCF/Tr.thy
src/HOLCF/Tr1.ML
src/HOLCF/Tr1.thy
src/HOLCF/Tr2.ML
src/HOLCF/Tr2.thy
src/HOLCF/Up1.ML
src/HOLCF/Up1.thy
src/HOLCF/Up2.ML
src/HOLCF/Up2.thy
src/HOLCF/Up3.ML
src/HOLCF/Up3.thy
src/HOLCF/Void.ML
src/HOLCF/Void.thy
src/HOLCF/ccc1.thy
     1.1 --- a/src/HOLCF/Cfun1.ML	Sat Feb 15 18:24:05 1997 +0100
     1.2 +++ b/src/HOLCF/Cfun1.ML	Mon Feb 17 10:57:11 1997 +0100
     1.3 @@ -1,37 +1,48 @@
     1.4 -(*  Title:      HOLCF/cfun1.ML
     1.5 +(*  Title:      HOLCF/Cfun1.ML
     1.6      ID:         $Id$
     1.7      Author:     Franz Regensburger
     1.8      Copyright   1993 Technische Universitaet Muenchen
     1.9  
    1.10 -Lemmas for cfun1.thy 
    1.11 +Lemmas for Cfun1.thy 
    1.12  *)
    1.13  
    1.14  open Cfun1;
    1.15  
    1.16  (* ------------------------------------------------------------------------ *)
    1.17 -(* A non-emptyness result for Cfun                                          *)
    1.18 +(* derive old type definition rules for fabs & fapp                         *)
    1.19 +(* fapp and fabs should be replaced by Rep_Cfun anf Abs_Cfun in future      *)
    1.20  (* ------------------------------------------------------------------------ *)
    1.21 -
    1.22 -qed_goalw "CfunI" Cfun1.thy [Cfun_def] "(% x.x):Cfun"
    1.23 - (fn prems =>
    1.24 +qed_goalw "Rep_Cfun" thy [fapp_def] "fapp fo : CFun"
    1.25 +(fn prems =>
    1.26          [
    1.27 -        (stac mem_Collect_eq 1),
    1.28 -        (rtac cont_id 1)
    1.29 +        (rtac Rep_CFun 1)
    1.30          ]);
    1.31  
    1.32 +qed_goalw "Rep_Cfun_inverse" thy [fapp_def,fabs_def] "fabs (fapp fo) = fo"
    1.33 +(fn prems =>
    1.34 +        [
    1.35 +        (rtac Rep_CFun_inverse 1)
    1.36 +        ]);
    1.37 +
    1.38 +qed_goalw "Abs_Cfun_inverse" thy [fapp_def,fabs_def] "f:CFun==>fapp(fabs f)=f"
    1.39 +(fn prems =>
    1.40 +        [
    1.41 +	(cut_facts_tac prems 1),
    1.42 +        (etac Abs_CFun_inverse 1)
    1.43 +        ]);
    1.44  
    1.45  (* ------------------------------------------------------------------------ *)
    1.46  (* less_cfun is a partial order on type 'a -> 'b                            *)
    1.47  (* ------------------------------------------------------------------------ *)
    1.48  
    1.49 -qed_goalw "refl_less_cfun" Cfun1.thy [less_cfun_def] "less_cfun f f"
    1.50 +qed_goalw "refl_less_cfun" thy [less_cfun_def] "less(f::'a::pcpo->'b::pcpo) f"
    1.51  (fn prems =>
    1.52          [
    1.53          (rtac refl_less 1)
    1.54          ]);
    1.55  
    1.56 -qed_goalw "antisym_less_cfun" Cfun1.thy [less_cfun_def] 
    1.57 -        "[|less_cfun f1 f2; less_cfun f2 f1|] ==> f1 = f2"
    1.58 +qed_goalw "antisym_less_cfun" thy [less_cfun_def] 
    1.59 +        "[|less (f1::'a::pcpo->'b::pcpo) f2; less f2 f1|] ==> f1 = f2"
    1.60  (fn prems =>
    1.61          [
    1.62          (cut_facts_tac prems 1),
    1.63 @@ -43,8 +54,8 @@
    1.64          (rtac Rep_Cfun_inverse 1)
    1.65          ]);
    1.66  
    1.67 -qed_goalw "trans_less_cfun" Cfun1.thy [less_cfun_def] 
    1.68 -        "[|less_cfun f1 f2; less_cfun f2 f3|] ==> less_cfun f1 f3"
    1.69 +qed_goalw "trans_less_cfun" thy [less_cfun_def] 
    1.70 +        "[|less (f1::'a::pcpo->'b::pcpo) f2; less f2 f3|] ==> less f1 f3"
    1.71  (fn prems =>
    1.72          [
    1.73          (cut_facts_tac prems 1),
    1.74 @@ -56,7 +67,7 @@
    1.75  (* lemmas about application of continuous functions                         *)
    1.76  (* ------------------------------------------------------------------------ *)
    1.77  
    1.78 -qed_goal "cfun_cong" Cfun1.thy 
    1.79 +qed_goal "cfun_cong" thy 
    1.80           "[| f=g; x=y |] ==> f`x = g`y"
    1.81  (fn prems =>
    1.82          [
    1.83 @@ -64,7 +75,7 @@
    1.84          (fast_tac HOL_cs 1)
    1.85          ]);
    1.86  
    1.87 -qed_goal "cfun_fun_cong" Cfun1.thy "f=g ==> f`x = g`x"
    1.88 +qed_goal "cfun_fun_cong" thy "f=g ==> f`x = g`x"
    1.89  (fn prems =>
    1.90          [
    1.91          (cut_facts_tac prems 1),
    1.92 @@ -72,7 +83,7 @@
    1.93          (rtac refl 1)
    1.94          ]);
    1.95  
    1.96 -qed_goal "cfun_arg_cong" Cfun1.thy "x=y ==> f`x = f`y"
    1.97 +qed_goal "cfun_arg_cong" thy "x=y ==> f`x = f`y"
    1.98  (fn prems =>
    1.99          [
   1.100          (cut_facts_tac prems 1),
   1.101 @@ -86,12 +97,12 @@
   1.102  (* additional lemma about the isomorphism between -> and Cfun               *)
   1.103  (* ------------------------------------------------------------------------ *)
   1.104  
   1.105 -qed_goal "Abs_Cfun_inverse2" Cfun1.thy "cont(f) ==> fapp(fabs(f)) = f"
   1.106 +qed_goal "Abs_Cfun_inverse2" thy "cont f ==> fapp (fabs f) = f"
   1.107  (fn prems =>
   1.108          [
   1.109          (cut_facts_tac prems 1),
   1.110          (rtac Abs_Cfun_inverse 1),
   1.111 -        (rewtac Cfun_def),
   1.112 +        (rewtac CFun_def),
   1.113          (etac (mem_Collect_eq RS ssubst) 1)
   1.114          ]);
   1.115  
   1.116 @@ -99,8 +110,7 @@
   1.117  (* simplification of application                                            *)
   1.118  (* ------------------------------------------------------------------------ *)
   1.119  
   1.120 -qed_goal "Cfunapp2" Cfun1.thy 
   1.121 -        "cont(f) ==> (fabs f)`x = f x"
   1.122 +qed_goal "Cfunapp2" thy "cont f ==> (fabs f)`x = f x"
   1.123  (fn prems =>
   1.124          [
   1.125          (cut_facts_tac prems 1),
   1.126 @@ -111,7 +121,7 @@
   1.127  (* beta - equality for continuous functions                                 *)
   1.128  (* ------------------------------------------------------------------------ *)
   1.129  
   1.130 -qed_goal "beta_cfun" Cfun1.thy 
   1.131 +qed_goal "beta_cfun" thy 
   1.132          "cont(c1) ==> (LAM x .c1 x)`u = c1 u"
   1.133  (fn prems =>
   1.134          [
     2.1 --- a/src/HOLCF/Cfun1.thy	Sat Feb 15 18:24:05 1997 +0100
     2.2 +++ b/src/HOLCF/Cfun1.thy	Mon Feb 17 10:57:11 1997 +0100
     2.3 @@ -9,49 +9,28 @@
     2.4  
     2.5  Cfun1 = Cont +
     2.6  
     2.7 -
     2.8 -(* new type of continuous functions *)
     2.9 -
    2.10 -types "->" 2        (infixr 5)
    2.11 -
    2.12 -arities "->" :: (pcpo,pcpo)term         (* No properties for ->'s range *)
    2.13 +typedef (CFun)  ('a, 'b) "->" (infixr 0) = "{f. cont f}" (CfunI)
    2.14  
    2.15  consts  
    2.16 -        Cfun    :: "('a => 'b)set"
    2.17 -        fapp    :: "('a -> 'b)=>('a => 'b)"     (* usually Rep_Cfun *)
    2.18 +        fapp      :: "('a -> 'b)=>('a => 'b)"   (* usually Rep_Cfun *)
    2.19                                                  (* application      *)
    2.20 -
    2.21 -        fabs    :: "('a => 'b)=>('a -> 'b)"     (binder "LAM " 10)
    2.22 +        fabs      :: "('a => 'b)=>('a -> 'b)"     (binder "LAM " 10)
    2.23                                                  (* usually Abs_Cfun *)
    2.24                                                  (* abstraction      *)
    2.25 -
    2.26          less_cfun :: "[('a -> 'b),('a -> 'b)]=>bool"
    2.27  
    2.28 -syntax  "@fapp"     :: "('a -> 'b)=>('a => 'b)" ("_`_" [999,1000] 999)
    2.29 +syntax  "@fapp"   :: "('a -> 'b)=>('a => 'b)" ("_`_" [999,1000] 999)
    2.30  
    2.31  translations "f`x" == "fapp f x"
    2.32  
    2.33  syntax (symbols)
    2.34 -
    2.35 -  "->"		:: [type, type] => type		("(_ \\<rightarrow>/ _)" [6,5]5)
    2.36 +  "->"		:: [type, type] => type	("(_ \\<rightarrow>/ _)" [6,5]5)
    2.37    "LAM "	:: "[idts, 'a => 'b] => ('a -> 'b)"
    2.38  					("(3\\<Lambda>_./ _)" [0, 10] 10)
    2.39 -
    2.40  defs 
    2.41 -
    2.42 -  Cfun_def      "Cfun == {f. cont(f)}"
    2.43 -
    2.44 -rules
    2.45 +  fabs_def	"fabs==Abs_CFun"
    2.46 +  fapp_def	"fapp==Rep_CFun"
    2.47  
    2.48 -  (*faking a type definition... *)
    2.49 -  (* -> is isomorphic to Cfun   *)
    2.50 -
    2.51 -  Rep_Cfun              "fapp fo : Cfun"
    2.52 -  Rep_Cfun_inverse      "fabs (fapp fo) = fo"
    2.53 -  Abs_Cfun_inverse      "f:Cfun ==> fapp(fabs f) = f"
    2.54 -
    2.55 -defs
    2.56 -  (*defining the abstract constants*)
    2.57 -  less_cfun_def         "less_cfun fo1 fo2 == ( fapp fo1 << fapp fo2 )"
    2.58 +  less_cfun_def "less == (% fo1 fo2. fapp fo1 << fapp fo2 )"
    2.59  
    2.60  end
     3.1 --- a/src/HOLCF/Cfun2.ML	Sat Feb 15 18:24:05 1997 +0100
     3.2 +++ b/src/HOLCF/Cfun2.ML	Mon Feb 17 10:57:11 1997 +0100
     3.3 @@ -8,43 +8,57 @@
     3.4  
     3.5  open Cfun2;
     3.6  
     3.7 +(* for compatibility with old HOLCF-Version *)
     3.8 +qed_goal "inst_cfun_po" thy "(op <<)=(%f1 f2.fapp f1 << fapp f2)"
     3.9 + (fn prems => 
    3.10 +        [
    3.11 +	(fold_goals_tac [po_def,less_cfun_def]),
    3.12 +	(rtac refl 1)
    3.13 +        ]);
    3.14 +
    3.15  (* ------------------------------------------------------------------------ *)
    3.16  (* access to less_cfun in class po                                          *)
    3.17  (* ------------------------------------------------------------------------ *)
    3.18  
    3.19 -qed_goal "less_cfun" Cfun2.thy "( f1 << f2 ) = (fapp(f1) << fapp(f2))"
    3.20 +qed_goal "less_cfun" thy "( f1 << f2 ) = (fapp(f1) << fapp(f2))"
    3.21  (fn prems =>
    3.22          [
    3.23 -        (stac inst_cfun_po 1),
    3.24 -        (fold_goals_tac [less_cfun_def]),
    3.25 -        (rtac refl 1)
    3.26 +        (simp_tac (!simpset addsimps [inst_cfun_po]) 1)
    3.27          ]);
    3.28  
    3.29  (* ------------------------------------------------------------------------ *)
    3.30  (* Type 'a ->'b  is pointed                                                 *)
    3.31  (* ------------------------------------------------------------------------ *)
    3.32  
    3.33 -qed_goalw "minimal_cfun" Cfun2.thy [UU_cfun_def] "UU_cfun << f"
    3.34 +qed_goal "minimal_cfun" thy "fabs(% x.UU) << f"
    3.35  (fn prems =>
    3.36          [
    3.37          (stac less_cfun 1),
    3.38          (stac Abs_Cfun_inverse2 1),
    3.39          (rtac cont_const 1),
    3.40 -        (fold_goals_tac [UU_fun_def]),
    3.41          (rtac minimal_fun 1)
    3.42          ]);
    3.43  
    3.44 +bind_thm ("UU_cfun_def",minimal_cfun RS minimal2UU RS sym);
    3.45 +
    3.46 +qed_goal "least_cfun" thy "? x::'a->'b.!y.x<<y"
    3.47 +(fn prems =>
    3.48 +        [
    3.49 +        (res_inst_tac [("x","fabs(% x.UU)")] exI 1),
    3.50 +        (rtac (minimal_cfun RS allI) 1)
    3.51 +        ]);
    3.52 +
    3.53  (* ------------------------------------------------------------------------ *)
    3.54  (* fapp yields continuous functions in 'a => 'b                             *)
    3.55  (* this is continuity of fapp in its 'second' argument                      *)
    3.56  (* cont_fapp2 ==> monofun_fapp2 & contlub_fapp2                            *)
    3.57  (* ------------------------------------------------------------------------ *)
    3.58  
    3.59 -qed_goal "cont_fapp2" Cfun2.thy "cont(fapp(fo))"
    3.60 +qed_goal "cont_fapp2" thy "cont(fapp(fo))"
    3.61  (fn prems =>
    3.62          [
    3.63          (res_inst_tac [("P","cont")] CollectD 1),
    3.64 -        (fold_goals_tac [Cfun_def]),
    3.65 +        (fold_goals_tac [CFun_def]),
    3.66          (rtac Rep_Cfun 1)
    3.67          ]);
    3.68  
    3.69 @@ -71,7 +85,7 @@
    3.70  (* fapp is monotone in its 'first' argument                                 *)
    3.71  (* ------------------------------------------------------------------------ *)
    3.72  
    3.73 -qed_goalw "monofun_fapp1" Cfun2.thy [monofun] "monofun(fapp)"
    3.74 +qed_goalw "monofun_fapp1" thy [monofun] "monofun(fapp)"
    3.75  (fn prems =>
    3.76          [
    3.77          (strip_tac 1),
    3.78 @@ -83,7 +97,7 @@
    3.79  (* monotonicity of application fapp in mixfix syntax [_]_                   *)
    3.80  (* ------------------------------------------------------------------------ *)
    3.81  
    3.82 -qed_goal "monofun_cfun_fun" Cfun2.thy  "f1 << f2 ==> f1`x << f2`x"
    3.83 +qed_goal "monofun_cfun_fun" thy  "f1 << f2 ==> f1`x << f2`x"
    3.84  (fn prems =>
    3.85          [
    3.86          (cut_facts_tac prems 1),
    3.87 @@ -100,7 +114,7 @@
    3.88  (* monotonicity of fapp in both arguments in mixfix syntax [_]_             *)
    3.89  (* ------------------------------------------------------------------------ *)
    3.90  
    3.91 -qed_goal "monofun_cfun" Cfun2.thy
    3.92 +qed_goal "monofun_cfun" thy
    3.93          "[|f1<<f2;x1<<x2|] ==> f1`x1 << f2`x2"
    3.94  (fn prems =>
    3.95          [
    3.96 @@ -111,7 +125,7 @@
    3.97          ]);
    3.98  
    3.99  
   3.100 -qed_goal "strictI" Cfun2.thy "f`x = UU ==> f`UU = UU" (fn prems => [
   3.101 +qed_goal "strictI" thy "f`x = UU ==> f`UU = UU" (fn prems => [
   3.102          cut_facts_tac prems 1,
   3.103          rtac (eq_UU_iff RS iffD2) 1,
   3.104          etac subst 1,
   3.105 @@ -123,7 +137,7 @@
   3.106  (* use MF2 lemmas from Cont.ML                                              *)
   3.107  (* ------------------------------------------------------------------------ *)
   3.108  
   3.109 -qed_goal "ch2ch_fappR" Cfun2.thy 
   3.110 +qed_goal "ch2ch_fappR" thy 
   3.111   "is_chain(Y) ==> is_chain(%i. f`(Y i))"
   3.112  (fn prems =>
   3.113          [
   3.114 @@ -141,7 +155,7 @@
   3.115  (* use MF2 lemmas from Cont.ML                                              *)
   3.116  (* ------------------------------------------------------------------------ *)
   3.117  
   3.118 -qed_goal "lub_cfun_mono" Cfun2.thy 
   3.119 +qed_goal "lub_cfun_mono" thy 
   3.120          "is_chain(F) ==> monofun(% x.lub(range(% j.(F j)`x)))"
   3.121  (fn prems =>
   3.122          [
   3.123 @@ -157,7 +171,7 @@
   3.124  (* use MF2 lemmas from Cont.ML                                              *)
   3.125  (* ------------------------------------------------------------------------ *)
   3.126  
   3.127 -qed_goal "ex_lubcfun" Cfun2.thy
   3.128 +qed_goal "ex_lubcfun" thy
   3.129          "[| is_chain(F); is_chain(Y) |] ==>\
   3.130  \               lub(range(%j. lub(range(%i. F(j)`(Y i))))) =\
   3.131  \               lub(range(%i. lub(range(%j. F(j)`(Y i)))))"
   3.132 @@ -175,7 +189,7 @@
   3.133  (* the lub of a chain of cont. functions is continuous                      *)
   3.134  (* ------------------------------------------------------------------------ *)
   3.135  
   3.136 -qed_goal "cont_lubcfun" Cfun2.thy 
   3.137 +qed_goal "cont_lubcfun" thy 
   3.138          "is_chain(F) ==> cont(% x.lub(range(% j.F(j)`x)))"
   3.139  (fn prems =>
   3.140          [
   3.141 @@ -194,7 +208,7 @@
   3.142  (* type 'a -> 'b is chain complete                                          *)
   3.143  (* ------------------------------------------------------------------------ *)
   3.144  
   3.145 -qed_goal "lub_cfun" Cfun2.thy 
   3.146 +qed_goal "lub_cfun" thy 
   3.147    "is_chain(CCF) ==> range(CCF) <<| (LAM x.lub(range(% i.CCF(i)`x)))"
   3.148  (fn prems =>
   3.149          [
   3.150 @@ -222,7 +236,7 @@
   3.151  is_chain(?CCF1) ==>  lub (range ?CCF1) = (LAM x. lub (range (%i. ?CCF1 i`x)))
   3.152  *)
   3.153  
   3.154 -qed_goal "cpo_cfun" Cfun2.thy 
   3.155 +qed_goal "cpo_cfun" thy 
   3.156    "is_chain(CCF::nat=>('a::pcpo->'b::pcpo)) ==> ? x. range(CCF) <<| x"
   3.157  (fn prems =>
   3.158          [
   3.159 @@ -250,7 +264,7 @@
   3.160  (* Monotonicity of fabs                                                     *)
   3.161  (* ------------------------------------------------------------------------ *)
   3.162  
   3.163 -qed_goal "semi_monofun_fabs" Cfun2.thy 
   3.164 +qed_goal "semi_monofun_fabs" thy 
   3.165          "[|cont(f);cont(g);f<<g|]==>fabs(f)<<fabs(g)"
   3.166   (fn prems =>
   3.167          [
   3.168 @@ -266,7 +280,7 @@
   3.169  (* Extenionality wrt. << in 'a -> 'b                                        *)
   3.170  (* ------------------------------------------------------------------------ *)
   3.171  
   3.172 -qed_goal "less_cfun2" Cfun2.thy "(!!x. f`x << g`x) ==> f << g"
   3.173 +qed_goal "less_cfun2" thy "(!!x. f`x << g`x) ==> f << g"
   3.174   (fn prems =>
   3.175          [
   3.176          (res_inst_tac [("t","f")] (Rep_Cfun_inverse RS subst) 1),
     4.1 --- a/src/HOLCF/Cfun2.thy	Sat Feb 15 18:24:05 1997 +0100
     4.2 +++ b/src/HOLCF/Cfun2.thy	Mon Feb 17 10:57:11 1997 +0100
     4.3 @@ -1,4 +1,4 @@
     4.4 -(*  Title:      HOLCF/cfun2.thy
     4.5 +(*  Title:      HOLCF/Cfun2.thy
     4.6      ID:         $Id$
     4.7      Author:     Franz Regensburger
     4.8      Copyright   1993 Technische Universitaet Muenchen
     4.9 @@ -9,22 +9,6 @@
    4.10  
    4.11  Cfun2 = Cfun1 + 
    4.12  
    4.13 -(* Witness for the above arity axiom is cfun1.ML *)
    4.14 -arities "->" :: (pcpo,pcpo)po
    4.15 -
    4.16 -consts  
    4.17 -        UU_cfun  :: "'a->'b"
    4.18 -
    4.19 -rules
    4.20 -
    4.21 -(* instance of << for type ['a -> 'b]  *)
    4.22 -
    4.23 -inst_cfun_po    "((op <<)::['a->'b,'a->'b]=>bool) = less_cfun"
    4.24 -
    4.25 -defs
    4.26 -(* The least element in type 'a->'b *)
    4.27 -
    4.28 -UU_cfun_def     "UU_cfun == fabs(% x.UU)"
    4.29 +instance "->"::(pcpo,pcpo)po (refl_less_cfun,antisym_less_cfun,trans_less_cfun)
    4.30  
    4.31  end
    4.32 -
     5.1 --- a/src/HOLCF/Cfun3.ML	Sat Feb 15 18:24:05 1997 +0100
     5.2 +++ b/src/HOLCF/Cfun3.ML	Mon Feb 17 10:57:11 1997 +0100
     5.3 @@ -6,11 +6,18 @@
     5.4  
     5.5  open Cfun3;
     5.6  
     5.7 +(* for compatibility with old HOLCF-Version *)
     5.8 +qed_goal "inst_cfun_pcpo" thy "UU = fabs(%x.UU)"
     5.9 + (fn prems => 
    5.10 +        [
    5.11 +        (simp_tac (HOL_ss addsimps [UU_def,UU_cfun_def]) 1)
    5.12 +        ]);
    5.13 +
    5.14  (* ------------------------------------------------------------------------ *)
    5.15  (* the contlub property for fapp its 'first' argument                       *)
    5.16  (* ------------------------------------------------------------------------ *)
    5.17  
    5.18 -qed_goal "contlub_fapp1" Cfun3.thy "contlub(fapp)"
    5.19 +qed_goal "contlub_fapp1" thy "contlub(fapp)"
    5.20  (fn prems =>
    5.21          [
    5.22          (rtac contlubI 1),
    5.23 @@ -31,7 +38,7 @@
    5.24  (* the cont property for fapp in its first argument                        *)
    5.25  (* ------------------------------------------------------------------------ *)
    5.26  
    5.27 -qed_goal "cont_fapp1" Cfun3.thy "cont(fapp)"
    5.28 +qed_goal "cont_fapp1" thy "cont(fapp)"
    5.29  (fn prems =>
    5.30          [
    5.31          (rtac monocontlub2cont 1),
    5.32 @@ -44,7 +51,7 @@
    5.33  (* contlub, cont properties of fapp in its first argument in mixfix _[_]   *)
    5.34  (* ------------------------------------------------------------------------ *)
    5.35  
    5.36 -qed_goal "contlub_cfun_fun" Cfun3.thy 
    5.37 +qed_goal "contlub_cfun_fun" thy 
    5.38  "is_chain(FY) ==>\
    5.39  \ lub(range FY)`x = lub(range (%i.FY(i)`x))"
    5.40  (fn prems =>
    5.41 @@ -58,7 +65,7 @@
    5.42          ]);
    5.43  
    5.44  
    5.45 -qed_goal "cont_cfun_fun" Cfun3.thy 
    5.46 +qed_goal "cont_cfun_fun" thy 
    5.47  "is_chain(FY) ==>\
    5.48  \ range(%i.FY(i)`x) <<| lub(range FY)`x"
    5.49  (fn prems =>
    5.50 @@ -74,7 +81,7 @@
    5.51  (* contlub, cont  properties of fapp in both argument in mixfix _[_]       *)
    5.52  (* ------------------------------------------------------------------------ *)
    5.53  
    5.54 -qed_goal "contlub_cfun" Cfun3.thy 
    5.55 +qed_goal "contlub_cfun" thy 
    5.56  "[|is_chain(FY);is_chain(TY)|] ==>\
    5.57  \ (lub(range FY))`(lub(range TY)) = lub(range(%i.FY(i)`(TY i)))"
    5.58  (fn prems =>
    5.59 @@ -88,7 +95,7 @@
    5.60          (atac 1)
    5.61          ]);
    5.62  
    5.63 -qed_goal "cont_cfun" Cfun3.thy 
    5.64 +qed_goal "cont_cfun" thy 
    5.65  "[|is_chain(FY);is_chain(TY)|] ==>\
    5.66  \ range(%i.(FY i)`(TY i)) <<| (lub (range FY))`(lub(range TY))"
    5.67  (fn prems =>
    5.68 @@ -109,7 +116,7 @@
    5.69  (* cont2cont lemma for fapp                                               *)
    5.70  (* ------------------------------------------------------------------------ *)
    5.71  
    5.72 -qed_goal "cont2cont_fapp" Cfun3.thy 
    5.73 +qed_goal "cont2cont_fapp" thy 
    5.74          "[|cont(%x.ft x);cont(%x.tt x)|] ==> cont(%x. (ft x)`(tt x))"
    5.75   (fn prems =>
    5.76          [
    5.77 @@ -129,7 +136,7 @@
    5.78  (* cont2mono Lemma for %x. LAM y. c1(x)(y)                                  *)
    5.79  (* ------------------------------------------------------------------------ *)
    5.80  
    5.81 -qed_goal "cont2mono_LAM" Cfun3.thy 
    5.82 +qed_goal "cont2mono_LAM" thy 
    5.83   "[|!x.cont(c1 x); !y.monofun(%x.c1 x y)|] ==>\
    5.84  \                       monofun(%x. LAM y. c1 x y)"
    5.85  (fn prems =>
    5.86 @@ -151,7 +158,7 @@
    5.87  (* cont2cont Lemma for %x. LAM y. c1 x y)                                 *)
    5.88  (* ------------------------------------------------------------------------ *)
    5.89  
    5.90 -qed_goal "cont2cont_LAM" Cfun3.thy 
    5.91 +qed_goal "cont2cont_LAM" thy 
    5.92   "[| !x.cont(c1 x); !y.cont(%x.c1 x y) |] ==> cont(%x. LAM y. c1 x y)"
    5.93  (fn prems =>
    5.94          [
    5.95 @@ -207,11 +214,10 @@
    5.96  (* function application _[_]  is strict in its first arguments              *)
    5.97  (* ------------------------------------------------------------------------ *)
    5.98  
    5.99 -qed_goal "strict_fapp1" Cfun3.thy "(UU::'a->'b)`x = (UU::'b)"
   5.100 +qed_goal "strict_fapp1" thy "(UU::'a->'b)`x = (UU::'b)"
   5.101   (fn prems =>
   5.102          [
   5.103          (stac inst_cfun_pcpo 1),
   5.104 -        (rewtac UU_cfun_def),
   5.105          (stac beta_cfun 1),
   5.106          (Simp_tac 1),
   5.107          (rtac refl 1)
   5.108 @@ -222,14 +228,14 @@
   5.109  (* results about strictify                                                  *)
   5.110  (* ------------------------------------------------------------------------ *)
   5.111  
   5.112 -qed_goalw "Istrictify1" Cfun3.thy [Istrictify_def]
   5.113 +qed_goalw "Istrictify1" thy [Istrictify_def]
   5.114          "Istrictify(f)(UU)= (UU)"
   5.115   (fn prems =>
   5.116          [
   5.117          (Simp_tac 1)
   5.118          ]);
   5.119  
   5.120 -qed_goalw "Istrictify2" Cfun3.thy [Istrictify_def]
   5.121 +qed_goalw "Istrictify2" thy [Istrictify_def]
   5.122          "~x=UU ==> Istrictify(f)(x)=f`x"
   5.123   (fn prems =>
   5.124          [
   5.125 @@ -237,7 +243,7 @@
   5.126          (Asm_simp_tac 1)
   5.127          ]);
   5.128  
   5.129 -qed_goal "monofun_Istrictify1" Cfun3.thy "monofun(Istrictify)"
   5.130 +qed_goal "monofun_Istrictify1" thy "monofun(Istrictify)"
   5.131   (fn prems =>
   5.132          [
   5.133          (rtac monofunI 1),
   5.134 @@ -257,7 +263,7 @@
   5.135          (rtac refl_less 1)
   5.136          ]);
   5.137  
   5.138 -qed_goal "monofun_Istrictify2" Cfun3.thy "monofun(Istrictify(f))"
   5.139 +qed_goal "monofun_Istrictify2" thy "monofun(Istrictify(f))"
   5.140   (fn prems =>
   5.141          [
   5.142          (rtac monofunI 1),
   5.143 @@ -276,7 +282,7 @@
   5.144          ]);
   5.145  
   5.146  
   5.147 -qed_goal "contlub_Istrictify1" Cfun3.thy "contlub(Istrictify)"
   5.148 +qed_goal "contlub_Istrictify1" thy "contlub(Istrictify)"
   5.149   (fn prems =>
   5.150          [
   5.151          (rtac contlubI 1),
   5.152 @@ -303,7 +309,7 @@
   5.153          (rtac (refl RS allI) 1)
   5.154          ]);
   5.155  
   5.156 -qed_goal "contlub_Istrictify2" Cfun3.thy "contlub(Istrictify(f::'a -> 'b))"
   5.157 +qed_goal "contlub_Istrictify2" thy "contlub(Istrictify(f::'a -> 'b))"
   5.158   (fn prems =>
   5.159          [
   5.160          (rtac contlubI 1),
   5.161 @@ -352,7 +358,7 @@
   5.162          (monofun_Istrictify2 RS monocontlub2cont)); 
   5.163  
   5.164  
   5.165 -qed_goalw "strictify1" Cfun3.thy [strictify_def] "strictify`f`UU=UU" (fn _ => [
   5.166 +qed_goalw "strictify1" thy [strictify_def] "strictify`f`UU=UU" (fn _ => [
   5.167          (stac beta_cfun 1),
   5.168           (simp_tac (!simpset addsimps [cont_Istrictify2,cont_Istrictify1,
   5.169  					cont2cont_CF1L]) 1),
   5.170 @@ -361,7 +367,7 @@
   5.171          (rtac Istrictify1 1)
   5.172          ]);
   5.173  
   5.174 -qed_goalw "strictify2" Cfun3.thy [strictify_def]
   5.175 +qed_goalw "strictify2" thy [strictify_def]
   5.176          "~x=UU ==> strictify`f`x=f`x"  (fn prems => [
   5.177          (stac beta_cfun 1),
   5.178           (simp_tac (!simpset addsimps [cont_Istrictify2,cont_Istrictify1,
     6.1 --- a/src/HOLCF/Cfun3.thy	Sat Feb 15 18:24:05 1997 +0100
     6.2 +++ b/src/HOLCF/Cfun3.thy	Mon Feb 17 10:57:11 1997 +0100
     6.3 @@ -1,4 +1,4 @@
     6.4 -(*  Title:      HOLCF/cfun3.thy
     6.5 +(*  Title:      HOLCF/Cfun3.thy
     6.6      ID:         $Id$
     6.7      Author:     Franz Regensburger
     6.8      Copyright   1993 Technische Universitaet Muenchen
     6.9 @@ -9,21 +9,14 @@
    6.10  
    6.11  Cfun3 = Cfun2 +
    6.12  
    6.13 -arities "->"    :: (pcpo,pcpo)pcpo              (* Witness cfun2.ML *)
    6.14 +instance "->" :: (pcpo,pcpo)pcpo              (least_cfun,cpo_cfun)
    6.15  
    6.16  consts  
    6.17          Istrictify   :: "('a->'b)=>'a=>'b"
    6.18          strictify    :: "('a->'b)->'a->'b"
    6.19 -
    6.20 -rules 
    6.21 -
    6.22 -inst_cfun_pcpo  "(UU::'a->'b) = UU_cfun"
    6.23 -
    6.24  defs
    6.25  
    6.26  Istrictify_def  "Istrictify f x == if x=UU then UU else f`x"    
    6.27 -
    6.28  strictify_def   "strictify == (LAM f x.Istrictify f x)"
    6.29  
    6.30  end
    6.31 -
     7.1 --- a/src/HOLCF/Cont.ML	Sat Feb 15 18:24:05 1997 +0100
     7.2 +++ b/src/HOLCF/Cont.ML	Mon Feb 17 10:57:11 1997 +0100
     7.3 @@ -1,9 +1,9 @@
     7.4 -(*  Title:      HOLCF/cont.ML
     7.5 +(*  Title:      HOLCF/Cont.ML
     7.6      ID:         $Id$
     7.7      Author:     Franz Regensburger
     7.8      Copyright   1993 Technische Universitaet Muenchen
     7.9  
    7.10 -Lemmas for cont.thy 
    7.11 +Lemmas for Cont.thy 
    7.12  *)
    7.13  
    7.14  open Cont;
    7.15 @@ -12,7 +12,7 @@
    7.16  (* access to definition                                                     *)
    7.17  (* ------------------------------------------------------------------------ *)
    7.18  
    7.19 -qed_goalw "contlubI" Cont.thy [contlub]
    7.20 +qed_goalw "contlubI" thy [contlub]
    7.21          "! Y. is_chain(Y) --> f(lub(range(Y))) = lub(range(%i. f(Y(i))))==>\
    7.22  \        contlub(f)"
    7.23  (fn prems =>
    7.24 @@ -21,7 +21,7 @@
    7.25          (atac 1)
    7.26          ]);
    7.27  
    7.28 -qed_goalw "contlubE" Cont.thy [contlub]
    7.29 +qed_goalw "contlubE" thy [contlub]
    7.30          " contlub(f)==>\
    7.31  \         ! Y. is_chain(Y) --> f(lub(range(Y))) = lub(range(%i. f(Y(i))))"
    7.32  (fn prems =>
    7.33 @@ -31,7 +31,7 @@
    7.34          ]);
    7.35  
    7.36  
    7.37 -qed_goalw "contI" Cont.thy [cont]
    7.38 +qed_goalw "contI" thy [cont]
    7.39   "! Y. is_chain(Y) --> range(% i.f(Y(i))) <<| f(lub(range(Y))) ==> cont(f)"
    7.40  (fn prems =>
    7.41          [
    7.42 @@ -39,7 +39,7 @@
    7.43          (atac 1)
    7.44          ]);
    7.45  
    7.46 -qed_goalw "contE" Cont.thy [cont]
    7.47 +qed_goalw "contE" thy [cont]
    7.48   "cont(f) ==> ! Y. is_chain(Y) --> range(% i.f(Y(i))) <<| f(lub(range(Y)))"
    7.49  (fn prems =>
    7.50          [
    7.51 @@ -48,7 +48,7 @@
    7.52          ]);
    7.53  
    7.54  
    7.55 -qed_goalw "monofunI" Cont.thy [monofun]
    7.56 +qed_goalw "monofunI" thy [monofun]
    7.57          "! x y. x << y --> f(x) << f(y) ==> monofun(f)"
    7.58  (fn prems =>
    7.59          [
    7.60 @@ -56,7 +56,7 @@
    7.61          (atac 1)
    7.62          ]);
    7.63  
    7.64 -qed_goalw "monofunE" Cont.thy [monofun]
    7.65 +qed_goalw "monofunE" thy [monofun]
    7.66          "monofun(f) ==> ! x y. x << y --> f(x) << f(y)"
    7.67  (fn prems =>
    7.68          [
    7.69 @@ -73,7 +73,7 @@
    7.70  (* monotone functions map chains to chains                                  *)
    7.71  (* ------------------------------------------------------------------------ *)
    7.72  
    7.73 -qed_goal "ch2ch_monofun" Cont.thy 
    7.74 +qed_goal "ch2ch_monofun" thy 
    7.75          "[| monofun(f); is_chain(Y) |] ==> is_chain(%i. f(Y(i)))"
    7.76  (fn prems =>
    7.77          [
    7.78 @@ -88,7 +88,7 @@
    7.79  (* monotone functions map upper bound to upper bounds                       *)
    7.80  (* ------------------------------------------------------------------------ *)
    7.81  
    7.82 -qed_goal "ub2ub_monofun" Cont.thy 
    7.83 +qed_goal "ub2ub_monofun" thy 
    7.84   "[| monofun(f); range(Y) <| u|]  ==> range(%i.f(Y(i))) <| f(u)"
    7.85  (fn prems =>
    7.86          [
    7.87 @@ -103,7 +103,7 @@
    7.88  (* left to right: monofun(f) & contlub(f)  ==> cont(f)                     *)
    7.89  (* ------------------------------------------------------------------------ *)
    7.90  
    7.91 -qed_goalw "monocontlub2cont" Cont.thy [cont]
    7.92 +qed_goalw "monocontlub2cont" thy [cont]
    7.93          "[|monofun(f);contlub(f)|] ==> cont(f)"
    7.94  (fn prems =>
    7.95          [
    7.96 @@ -120,7 +120,7 @@
    7.97  (* first a lemma about binary chains                                        *)
    7.98  (* ------------------------------------------------------------------------ *)
    7.99  
   7.100 -qed_goal "binchain_cont" Cont.thy
   7.101 +qed_goal "binchain_cont" thy
   7.102  "[| cont(f); x << y |]  ==> range(%i. f(if i = 0 then x else y)) <<| f(y)"
   7.103  (fn prems => 
   7.104          [
   7.105 @@ -137,7 +137,7 @@
   7.106  (* part1:         cont(f) ==> monofun(f                                    *)
   7.107  (* ------------------------------------------------------------------------ *)
   7.108  
   7.109 -qed_goalw "cont2mono" Cont.thy [monofun]
   7.110 +qed_goalw "cont2mono" thy [monofun]
   7.111          "cont(f) ==> monofun(f)"
   7.112  (fn prems =>
   7.113          [
   7.114 @@ -155,7 +155,7 @@
   7.115  (* part2:         cont(f) ==>              contlub(f)                      *)
   7.116  (* ------------------------------------------------------------------------ *)
   7.117  
   7.118 -qed_goalw "cont2contlub" Cont.thy [contlub]
   7.119 +qed_goalw "cont2contlub" thy [contlub]
   7.120          "cont(f) ==> contlub(f)"
   7.121  (fn prems =>
   7.122          [
   7.123 @@ -170,7 +170,7 @@
   7.124  (* monotone functions map finite chains to finite chains              	    *)
   7.125  (* ------------------------------------------------------------------------ *)
   7.126  
   7.127 -qed_goalw "monofun_finch2finch" Cont.thy [finite_chain_def]
   7.128 +qed_goalw "monofun_finch2finch" thy [finite_chain_def]
   7.129    "[| monofun f; finite_chain Y |] ==> finite_chain (%n. f (Y n))" 
   7.130  (fn prems => 
   7.131  	[
   7.132 @@ -193,7 +193,7 @@
   7.133  (* in both arguments                                                        *)
   7.134  (* ------------------------------------------------------------------------ *)
   7.135  
   7.136 -qed_goal "ch2ch_MF2L" Cont.thy 
   7.137 +qed_goal "ch2ch_MF2L" thy 
   7.138  "[|monofun(MF2); is_chain(F)|] ==> is_chain(%i. MF2 (F i) x)"
   7.139  (fn prems =>
   7.140          [
   7.141 @@ -203,7 +203,7 @@
   7.142          ]);
   7.143  
   7.144  
   7.145 -qed_goal "ch2ch_MF2R" Cont.thy 
   7.146 +qed_goal "ch2ch_MF2R" thy 
   7.147  "[|monofun(MF2(f)); is_chain(Y)|] ==> is_chain(%i. MF2 f (Y i))"
   7.148  (fn prems =>
   7.149          [
   7.150 @@ -212,7 +212,7 @@
   7.151          (atac 1)
   7.152          ]);
   7.153  
   7.154 -qed_goal "ch2ch_MF2LR" Cont.thy 
   7.155 +qed_goal "ch2ch_MF2LR" thy 
   7.156  "[|monofun(MF2); !f.monofun(MF2(f)); is_chain(F); is_chain(Y)|] ==> \
   7.157  \  is_chain(%i. MF2(F(i))(Y(i)))"
   7.158   (fn prems =>
   7.159 @@ -228,7 +228,7 @@
   7.160          ]);
   7.161  
   7.162  
   7.163 -qed_goal "ch2ch_lubMF2R" Cont.thy 
   7.164 +qed_goal "ch2ch_lubMF2R" thy 
   7.165  "[|monofun(MF2::('a::po=>'b::po=>'c::pcpo));\
   7.166  \  !f.monofun(MF2(f)::('b::po=>'c::pcpo));\
   7.167  \       is_chain(F);is_chain(Y)|] ==> \
   7.168 @@ -248,7 +248,7 @@
   7.169          ]);
   7.170  
   7.171  
   7.172 -qed_goal "ch2ch_lubMF2L" Cont.thy 
   7.173 +qed_goal "ch2ch_lubMF2L" thy 
   7.174  "[|monofun(MF2::('a::po=>'b::po=>'c::pcpo));\
   7.175  \  !f.monofun(MF2(f)::('b::po=>'c::pcpo));\
   7.176  \       is_chain(F);is_chain(Y)|] ==> \
   7.177 @@ -268,7 +268,7 @@
   7.178          ]);
   7.179  
   7.180  
   7.181 -qed_goal "lub_MF2_mono" Cont.thy 
   7.182 +qed_goal "lub_MF2_mono" thy 
   7.183  "[|monofun(MF2::('a::po=>'b::po=>'c::pcpo));\
   7.184  \  !f.monofun(MF2(f)::('b::po=>'c::pcpo));\
   7.185  \       is_chain(F)|] ==> \
   7.186 @@ -288,7 +288,7 @@
   7.187          (atac 1)
   7.188          ]);
   7.189  
   7.190 -qed_goal "ex_lubMF2" Cont.thy 
   7.191 +qed_goal "ex_lubMF2" thy 
   7.192  "[|monofun(MF2::('a::po=>'b::po=>'c::pcpo));\
   7.193  \  !f.monofun(MF2(f)::('b::po=>'c::pcpo));\
   7.194  \       is_chain(F); is_chain(Y)|] ==> \
   7.195 @@ -327,7 +327,7 @@
   7.196          ]);
   7.197  
   7.198  
   7.199 -qed_goal "diag_lubMF2_1" Cont.thy 
   7.200 +qed_goal "diag_lubMF2_1" thy 
   7.201  "[|monofun(MF2::('a::po=>'b::po=>'c::pcpo));\
   7.202  \  !f.monofun(MF2(f)::('b::po=>'c::pcpo));\
   7.203  \  is_chain(FY);is_chain(TY)|] ==>\
   7.204 @@ -371,7 +371,7 @@
   7.205          (atac 1)
   7.206          ]);
   7.207  
   7.208 -qed_goal "diag_lubMF2_2" Cont.thy 
   7.209 +qed_goal "diag_lubMF2_2" thy 
   7.210  "[|monofun(MF2::('a::po=>'b::po=>'c::pcpo));\
   7.211  \  !f.monofun(MF2(f)::('b::po=>'c::pcpo));\
   7.212  \  is_chain(FY);is_chain(TY)|] ==>\
   7.213 @@ -395,7 +395,7 @@
   7.214  (* in both arguments                                                        *)
   7.215  (* ------------------------------------------------------------------------ *)
   7.216  
   7.217 -qed_goal "contlub_CF2" Cont.thy 
   7.218 +qed_goal "contlub_CF2" thy 
   7.219  "[|cont(CF2);!f.cont(CF2(f));is_chain(FY);is_chain(TY)|] ==>\
   7.220  \ CF2(lub(range(FY)))(lub(range(TY))) = lub(range(%i.CF2(FY(i))(TY(i))))"
   7.221   (fn prems =>
   7.222 @@ -421,7 +421,7 @@
   7.223  (* The following results are about application for functions in 'a=>'b      *)
   7.224  (* ------------------------------------------------------------------------ *)
   7.225  
   7.226 -qed_goal "monofun_fun_fun" Cont.thy 
   7.227 +qed_goal "monofun_fun_fun" thy 
   7.228          "f1 << f2 ==> f1(x) << f2(x)"
   7.229  (fn prems =>
   7.230          [
   7.231 @@ -429,7 +429,7 @@
   7.232          (etac (less_fun RS iffD1 RS spec) 1)
   7.233          ]);
   7.234  
   7.235 -qed_goal "monofun_fun_arg" Cont.thy 
   7.236 +qed_goal "monofun_fun_arg" thy 
   7.237          "[|monofun(f); x1 << x2|] ==> f(x1) << f(x2)"
   7.238  (fn prems =>
   7.239          [
   7.240 @@ -438,7 +438,7 @@
   7.241          (atac 1)
   7.242          ]);
   7.243  
   7.244 -qed_goal "monofun_fun" Cont.thy 
   7.245 +qed_goal "monofun_fun" thy 
   7.246  "[|monofun(f1); monofun(f2); f1 << f2; x1 << x2|] ==> f1(x1) << f2(x2)"
   7.247  (fn prems =>
   7.248          [
   7.249 @@ -455,7 +455,7 @@
   7.250  (* continuity                                                               *)
   7.251  (* ------------------------------------------------------------------------ *)
   7.252  
   7.253 -qed_goal "mono2mono_MF1L" Cont.thy 
   7.254 +qed_goal "mono2mono_MF1L" thy 
   7.255          "[|monofun(c1)|] ==> monofun(%x. c1 x y)"
   7.256  (fn prems =>
   7.257          [
   7.258 @@ -466,7 +466,7 @@
   7.259          (atac 1)
   7.260          ]);
   7.261  
   7.262 -qed_goal "cont2cont_CF1L" Cont.thy 
   7.263 +qed_goal "cont2cont_CF1L" thy 
   7.264          "[|cont(c1)|] ==> cont(%x. c1 x y)"
   7.265  (fn prems =>
   7.266          [
   7.267 @@ -487,7 +487,7 @@
   7.268  
   7.269  (*********  Note "(%x.%y.c1 x y) = c1" ***********)
   7.270  
   7.271 -qed_goal "mono2mono_MF1L_rev" Cont.thy
   7.272 +qed_goal "mono2mono_MF1L_rev" thy
   7.273          "!y.monofun(%x.c1 x y) ==> monofun(c1)"
   7.274  (fn prems =>
   7.275          [
   7.276 @@ -500,7 +500,7 @@
   7.277          (atac 1)
   7.278          ]);
   7.279  
   7.280 -qed_goal "cont2cont_CF1L_rev" Cont.thy
   7.281 +qed_goal "cont2cont_CF1L_rev" thy
   7.282          "!y.cont(%x.c1 x y) ==> cont(c1)"
   7.283  (fn prems =>
   7.284          [
   7.285 @@ -526,7 +526,7 @@
   7.286  (* never used here                                                          *)
   7.287  (* ------------------------------------------------------------------------ *)
   7.288  
   7.289 -qed_goal "contlub_abstraction" Cont.thy
   7.290 +qed_goal "contlub_abstraction" thy
   7.291  "[|is_chain(Y::nat=>'a);!y.cont(%x.(c::'a=>'b=>'c) x y)|] ==>\
   7.292  \ (%y.lub(range(%i.c (Y i) y))) = (lub(range(%i.%y.c (Y i) y)))"
   7.293   (fn prems =>
   7.294 @@ -543,7 +543,7 @@
   7.295          ]);
   7.296  
   7.297  
   7.298 -qed_goal "mono2mono_app" Cont.thy 
   7.299 +qed_goal "mono2mono_app" thy 
   7.300  "[|monofun(ft);!x.monofun(ft(x));monofun(tt)|] ==>\
   7.301  \        monofun(%x.(ft(x))(tt(x)))"
   7.302   (fn prems =>
   7.303 @@ -561,7 +561,7 @@
   7.304          ]);
   7.305  
   7.306  
   7.307 -qed_goal "cont2contlub_app" Cont.thy 
   7.308 +qed_goal "cont2contlub_app" thy 
   7.309  "[|cont(ft);!x.cont(ft(x));cont(tt)|] ==> contlub(%x.(ft(x))(tt(x)))"
   7.310   (fn prems =>
   7.311          [
   7.312 @@ -578,7 +578,7 @@
   7.313          ]);
   7.314  
   7.315  
   7.316 -qed_goal "cont2cont_app" Cont.thy 
   7.317 +qed_goal "cont2cont_app" thy 
   7.318  "[|cont(ft);!x.cont(ft(x));cont(tt)|] ==>\
   7.319  \        cont(%x.(ft(x))(tt(x)))"
   7.320   (fn prems =>
   7.321 @@ -609,7 +609,7 @@
   7.322  (* The identity function is continuous                                      *)
   7.323  (* ------------------------------------------------------------------------ *)
   7.324  
   7.325 -qed_goal "cont_id" Cont.thy "cont(% x.x)"
   7.326 +qed_goal "cont_id" thy "cont(% x.x)"
   7.327   (fn prems =>
   7.328          [
   7.329          (rtac contI 1),
   7.330 @@ -618,13 +618,11 @@
   7.331          (rtac refl 1)
   7.332          ]);
   7.333  
   7.334 -
   7.335 -
   7.336  (* ------------------------------------------------------------------------ *)
   7.337  (* constant functions are continuous                                        *)
   7.338  (* ------------------------------------------------------------------------ *)
   7.339  
   7.340 -qed_goalw "cont_const" Cont.thy [cont] "cont(%x.c)"
   7.341 +qed_goalw "cont_const" thy [cont] "cont(%x.c)"
   7.342   (fn prems =>
   7.343          [
   7.344          (strip_tac 1),
   7.345 @@ -639,7 +637,7 @@
   7.346          ]);
   7.347  
   7.348  
   7.349 -qed_goal "cont2cont_app3" Cont.thy 
   7.350 +qed_goal "cont2cont_app3" thy 
   7.351   "[|cont(f);cont(t) |] ==> cont(%x. f(t(x)))"
   7.352   (fn prems =>
   7.353          [
   7.354 @@ -650,3 +648,13 @@
   7.355          (atac 1)
   7.356          ]);
   7.357  
   7.358 +(* ------------------------------------------------------------------------ *)
   7.359 +(* A non-emptyness result for Cfun                                          *)
   7.360 +(* ------------------------------------------------------------------------ *)
   7.361 +
   7.362 +qed_goal "CfunI" thy "?x:Collect cont"
   7.363 + (fn prems =>
   7.364 +        [
   7.365 +        (rtac CollectI 1),
   7.366 +        (rtac cont_const 1)
   7.367 +        ]);
     8.1 --- a/src/HOLCF/Cprod1.ML	Sat Feb 15 18:24:05 1997 +0100
     8.2 +++ b/src/HOLCF/Cprod1.ML	Mon Feb 17 10:57:11 1997 +0100
     8.3 @@ -1,113 +1,48 @@
     8.4 -(*  Title:      HOLCF/cprod1.ML
     8.5 +(*  Title:      HOLCF/Cprod1.ML
     8.6      ID:         $Id$
     8.7      Author:     Franz Regensburger
     8.8      Copyright   1993  Technische Universitaet Muenchen
     8.9  
    8.10 -Lemmas for theory cprod1.thy 
    8.11 +Lemmas for theory Cprod1.thy 
    8.12  *)
    8.13  
    8.14  open Cprod1;
    8.15  
    8.16 -qed_goalw "less_cprod1b" Cprod1.thy [less_cprod_def]
    8.17 - "less_cprod p1 p2 = ( fst(p1) << fst(p2) & snd(p1) << snd(p2))"
    8.18 - (fn prems =>
    8.19 -        [
    8.20 -        (rtac refl 1)
    8.21 -        ]);
    8.22 -
    8.23 -qed_goalw "less_cprod2a" Cprod1.thy [less_cprod_def]
    8.24 - "less_cprod (x,y) (UU,UU) ==> x = UU & y = UU"
    8.25 - (fn prems =>
    8.26 -        [
    8.27 -        (cut_facts_tac prems 1),
    8.28 -        (etac conjE 1),
    8.29 -        (dtac (fst_conv RS subst) 1),
    8.30 -        (dtac (fst_conv RS subst) 1),
    8.31 -        (dtac (fst_conv RS subst) 1),
    8.32 -        (dtac (snd_conv RS subst) 1),
    8.33 -        (dtac (snd_conv RS subst) 1),
    8.34 -        (dtac (snd_conv RS subst) 1),
    8.35 -        (rtac conjI 1),
    8.36 -        (etac UU_I 1),
    8.37 -        (etac UU_I 1)
    8.38 -        ]);
    8.39 -
    8.40 -qed_goal "less_cprod2b" Cprod1.thy 
    8.41 - "less_cprod p (UU,UU) ==> p = (UU,UU)"
    8.42 - (fn prems =>
    8.43 -        [
    8.44 -        (cut_facts_tac prems 1),
    8.45 -        (res_inst_tac [("p","p")] PairE 1),
    8.46 -        (hyp_subst_tac 1),
    8.47 -        (dtac less_cprod2a 1),
    8.48 -        (Asm_simp_tac 1)
    8.49 -        ]);
    8.50 -
    8.51 -qed_goalw "less_cprod2c" Cprod1.thy [less_cprod_def]
    8.52 - "less_cprod (x1,y1) (x2,y2) ==> x1 << x2 & y1 << y2"
    8.53 - (fn prems =>
    8.54 -        [
    8.55 -        (cut_facts_tac prems 1),
    8.56 -        (etac conjE 1),
    8.57 -        (dtac (fst_conv RS subst) 1),
    8.58 -        (dtac (fst_conv RS subst) 1),
    8.59 -        (dtac (fst_conv RS subst) 1),
    8.60 -        (dtac (snd_conv RS subst) 1),
    8.61 -        (dtac (snd_conv RS subst) 1),
    8.62 -        (dtac (snd_conv RS subst) 1),
    8.63 -        (rtac conjI 1),
    8.64 -        (atac 1),
    8.65 -        (atac 1)
    8.66 -        ]);
    8.67  
    8.68  (* ------------------------------------------------------------------------ *)
    8.69  (* less_cprod is a partial order on 'a * 'b                                 *)
    8.70  (* ------------------------------------------------------------------------ *)
    8.71  
    8.72 -qed_goalw "refl_less_cprod" Cprod1.thy [less_cprod_def] "less_cprod p p"
    8.73 - (fn prems => [Simp_tac 1]);
    8.74 -
    8.75 -qed_goal "antisym_less_cprod" Cprod1.thy 
    8.76 - "[|less_cprod p1 p2;less_cprod p2 p1|] ==> p1=p2"
    8.77 - (fn prems =>
    8.78 +qed_goal "Sel_injective_cprod" Prod.thy 
    8.79 +        "[|fst x = fst y; snd x = snd y|] ==> x = y"
    8.80 +(fn prems =>
    8.81          [
    8.82          (cut_facts_tac prems 1),
    8.83 -        (res_inst_tac [("p","p1")] PairE 1),
    8.84 -        (hyp_subst_tac 1),
    8.85 -        (res_inst_tac [("p","p2")] PairE 1),
    8.86 -        (hyp_subst_tac 1),
    8.87 -        (dtac less_cprod2c 1),
    8.88 -        (dtac less_cprod2c 1),
    8.89 -        (etac conjE 1),
    8.90 -        (etac conjE 1),
    8.91 -        (stac Pair_eq 1),
    8.92 -        (fast_tac (HOL_cs addSIs [antisym_less]) 1)
    8.93 +        (subgoal_tac "(fst x,snd x)=(fst y,snd y)" 1),
    8.94 +        (rotate_tac ~1 1),
    8.95 +        (asm_full_simp_tac(HOL_ss addsimps[surjective_pairing RS sym])1),
    8.96 +        (Asm_simp_tac 1)
    8.97          ]);
    8.98  
    8.99 +qed_goalw "refl_less_cprod" Cprod1.thy [less_cprod_def] "less (p::'a*'b) p"
   8.100 + (fn prems => [Simp_tac 1]);
   8.101  
   8.102 -qed_goal "trans_less_cprod" Cprod1.thy 
   8.103 - "[|less_cprod p1 p2;less_cprod p2 p3|] ==> less_cprod p1 p3"
   8.104 - (fn prems =>
   8.105 +qed_goalw "antisym_less_cprod" thy [less_cprod_def]
   8.106 +        "[|less (p1::'a * 'b) p2;less p2 p1|] ==> p1=p2"
   8.107 +(fn prems =>
   8.108          [
   8.109          (cut_facts_tac prems 1),
   8.110 -        (res_inst_tac [("p","p1")] PairE 1),
   8.111 -        (hyp_subst_tac 1),
   8.112 -        (res_inst_tac [("p","p3")] PairE 1),
   8.113 -        (hyp_subst_tac 1),
   8.114 -        (res_inst_tac [("p","p2")] PairE 1),
   8.115 -        (hyp_subst_tac 1),
   8.116 -        (dtac less_cprod2c 1),
   8.117 -        (dtac less_cprod2c 1),
   8.118 -        (stac less_cprod1b 1),
   8.119 -        (Simp_tac 1),
   8.120 -        (etac conjE 1),
   8.121 -        (etac conjE 1),
   8.122 -        (rtac conjI 1),
   8.123 -        (etac trans_less 1),
   8.124 -        (atac 1),
   8.125 -        (etac trans_less 1),
   8.126 -        (atac 1)
   8.127 +        (rtac Sel_injective_cprod 1),
   8.128 +        (fast_tac (HOL_cs addIs [antisym_less]) 1),
   8.129 +        (fast_tac (HOL_cs addIs [antisym_less]) 1)
   8.130          ]);
   8.131  
   8.132 -
   8.133 -
   8.134 +qed_goalw "trans_less_cprod" thy [less_cprod_def]
   8.135 +        "[|less (p1::'a*'b) p2;less p2 p3|] ==> less p1 p3"
   8.136 +(fn prems =>
   8.137 +        [
   8.138 +        (cut_facts_tac prems 1),
   8.139 +        (rtac conjI 1),
   8.140 +        (fast_tac (HOL_cs addIs [trans_less]) 1),
   8.141 +        (fast_tac (HOL_cs addIs [trans_less]) 1)
   8.142 +        ]);
     9.1 --- a/src/HOLCF/Cprod1.thy	Sat Feb 15 18:24:05 1997 +0100
     9.2 +++ b/src/HOLCF/Cprod1.thy	Mon Feb 17 10:57:11 1997 +0100
     9.3 @@ -1,4 +1,4 @@
     9.4 -(*  Title:      HOLCF/cprod1.thy
     9.5 +(*  Title:      HOLCF/Cprod1.thy
     9.6      ID:         $Id$
     9.7      Author:     Franz Regensburger
     9.8      Copyright   1993  Technische Universitaet Muenchen
     9.9 @@ -10,14 +10,8 @@
    9.10  
    9.11  Cprod1 = Cfun3 +
    9.12  
    9.13 -
    9.14 -consts
    9.15 -  less_cprod    :: "[('a::pcpo * 'b::pcpo),('a * 'b)] => bool"  
    9.16 -
    9.17  defs
    9.18  
    9.19 -  less_cprod_def "less_cprod p1 p2 == ( fst(p1) << fst(p2) &
    9.20 -                                        snd(p1) << snd(p2))"
    9.21 +  less_cprod_def "less p1 p2 == (fst p1<<fst p2 & snd p1 << snd p2)"
    9.22  
    9.23  end
    9.24 -
    10.1 --- a/src/HOLCF/Cprod2.ML	Sat Feb 15 18:24:05 1997 +0100
    10.2 +++ b/src/HOLCF/Cprod2.ML	Mon Feb 17 10:57:11 1997 +0100
    10.3 @@ -8,88 +8,70 @@
    10.4  
    10.5  open Cprod2;
    10.6  
    10.7 -qed_goal "less_cprod3a" Cprod2.thy 
    10.8 -        "p1=(UU,UU) ==> p1 << p2"
    10.9 +(* for compatibility with old HOLCF-Version *)
   10.10 +qed_goal "inst_cprod_po" thy "(op <<)=(%x y.fst x<<fst y & snd x<<snd y)"
   10.11 + (fn prems => 
   10.12 +        [
   10.13 +        (fold_goals_tac [po_def,less_cprod_def]),
   10.14 +        (rtac refl 1)
   10.15 +        ]);
   10.16 +
   10.17 +qed_goalw "less_cprod4c" thy [inst_cprod_po RS eq_reflection]
   10.18 + "(x1,y1) << (x2,y2) ==> x1 << x2 & y1 << y2"
   10.19   (fn prems =>
   10.20          [
   10.21          (cut_facts_tac prems 1),
   10.22 -        (stac inst_cprod_po 1),
   10.23 -        (stac less_cprod1b 1),
   10.24 -        (hyp_subst_tac 1),
   10.25 -        (Asm_simp_tac  1)
   10.26 -        ]);
   10.27 -
   10.28 -qed_goal "less_cprod3b" Cprod2.thy
   10.29 - "(p1 << p2) = (fst(p1)<<fst(p2) & snd(p1)<<snd(p2))"
   10.30 - (fn prems =>
   10.31 -        [
   10.32 -        (stac inst_cprod_po 1),
   10.33 -        (rtac less_cprod1b 1)
   10.34 -        ]);
   10.35 -
   10.36 -qed_goal "less_cprod4a" Cprod2.thy 
   10.37 -        "(x1,x2) << (UU,UU) ==> x1=UU & x2=UU"
   10.38 - (fn prems =>
   10.39 -        [
   10.40 -        (cut_facts_tac prems 1),
   10.41 -        (rtac less_cprod2a 1),
   10.42 -        (etac (inst_cprod_po RS subst) 1)
   10.43 -        ]);
   10.44 -
   10.45 -qed_goal "less_cprod4b" Cprod2.thy 
   10.46 -        "p << (UU,UU) ==> p = (UU,UU)"
   10.47 -(fn prems =>
   10.48 -        [
   10.49 -        (cut_facts_tac prems 1),
   10.50 -        (rtac less_cprod2b 1),
   10.51 -        (etac (inst_cprod_po RS subst) 1)
   10.52 -        ]);
   10.53 -
   10.54 -qed_goal "less_cprod4c" Cprod2.thy
   10.55 - " (xa,ya) << (x,y) ==> xa<<x & ya << y"
   10.56 -(fn prems =>
   10.57 -        [
   10.58 -        (cut_facts_tac prems 1),
   10.59 -        (rtac less_cprod2c 1),
   10.60 -        (etac (inst_cprod_po RS subst) 1),
   10.61 -        (REPEAT (atac 1))
   10.62 +        (etac conjE 1),
   10.63 +        (dtac (fst_conv RS subst) 1),
   10.64 +        (dtac (fst_conv RS subst) 1),
   10.65 +        (dtac (fst_conv RS subst) 1),
   10.66 +        (dtac (snd_conv RS subst) 1),
   10.67 +        (dtac (snd_conv RS subst) 1),
   10.68 +        (dtac (snd_conv RS subst) 1),
   10.69 +        (rtac conjI 1),
   10.70 +        (atac 1),
   10.71 +        (atac 1)
   10.72          ]);
   10.73  
   10.74  (* ------------------------------------------------------------------------ *)
   10.75  (* type cprod is pointed                                                    *)
   10.76  (* ------------------------------------------------------------------------ *)
   10.77  
   10.78 -qed_goal "minimal_cprod" Cprod2.thy  "(UU,UU)<<p"
   10.79 +qed_goal "minimal_cprod" thy  "(UU,UU)<<p"
   10.80  (fn prems =>
   10.81          [
   10.82 -        (rtac less_cprod3a 1),
   10.83 -        (rtac refl 1)
   10.84 +        (simp_tac(!simpset addsimps[inst_cprod_po])1)
   10.85 +        ]);
   10.86 +
   10.87 +bind_thm ("UU_cprod_def",minimal_cprod RS minimal2UU RS sym);
   10.88 +
   10.89 +qed_goal "least_cprod" thy "? x::'a*'b.!y.x<<y"
   10.90 +(fn prems =>
   10.91 +        [
   10.92 +        (res_inst_tac [("x","(UU,UU)")] exI 1),
   10.93 +        (rtac (minimal_cprod RS allI) 1)
   10.94          ]);
   10.95  
   10.96  (* ------------------------------------------------------------------------ *)
   10.97  (* Pair <_,_>  is monotone in both arguments                                *)
   10.98  (* ------------------------------------------------------------------------ *)
   10.99  
  10.100 -qed_goalw "monofun_pair1" Cprod2.thy [monofun] "monofun(Pair)"
  10.101 +qed_goalw "monofun_pair1" thy [monofun] "monofun Pair"
  10.102   (fn prems =>
  10.103          [
  10.104          (strip_tac 1),
  10.105          (rtac (less_fun RS iffD2) 1),
  10.106          (strip_tac 1),
  10.107 -        (rtac (less_cprod3b RS iffD2) 1),
  10.108 -        (Simp_tac 1)
  10.109 +        (asm_simp_tac (!simpset addsimps [inst_cprod_po]) 1)
  10.110          ]);
  10.111  
  10.112 -qed_goalw "monofun_pair2" Cprod2.thy [monofun] "monofun(Pair(x))"
  10.113 +qed_goalw "monofun_pair2" thy [monofun] "monofun(Pair x)"
  10.114   (fn prems =>
  10.115          [
  10.116 -        (strip_tac 1),
  10.117 -        (rtac (less_cprod3b RS iffD2) 1),
  10.118 -        (Simp_tac 1)
  10.119 +        (asm_simp_tac (!simpset addsimps [inst_cprod_po]) 1)
  10.120          ]);
  10.121  
  10.122 -qed_goal "monofun_pair" Cprod2.thy 
  10.123 - "[|x1<<x2; y1<<y2|] ==> (x1,y1) << (x2,y2)"
  10.124 +qed_goal "monofun_pair" thy "[|x1<<x2; y1<<y2|] ==> (x1,y1) << (x2,y2)"
  10.125   (fn prems =>
  10.126          [
  10.127          (cut_facts_tac prems 1),
  10.128 @@ -105,7 +87,7 @@
  10.129  (* fst and snd are monotone                                                 *)
  10.130  (* ------------------------------------------------------------------------ *)
  10.131  
  10.132 -qed_goalw "monofun_fst" Cprod2.thy [monofun] "monofun(fst)"
  10.133 +qed_goalw "monofun_fst" thy [monofun] "monofun fst"
  10.134   (fn prems =>
  10.135          [
  10.136          (strip_tac 1),
  10.137 @@ -117,7 +99,7 @@
  10.138          (etac (less_cprod4c RS conjunct1) 1)
  10.139          ]);
  10.140  
  10.141 -qed_goalw "monofun_snd" Cprod2.thy [monofun] "monofun(snd)"
  10.142 +qed_goalw "monofun_snd" thy [monofun] "monofun snd"
  10.143   (fn prems =>
  10.144          [
  10.145          (strip_tac 1),
  10.146 @@ -133,17 +115,14 @@
  10.147  (* the type 'a * 'b is a cpo                                                *)
  10.148  (* ------------------------------------------------------------------------ *)
  10.149  
  10.150 -qed_goal "lub_cprod" Cprod2.thy 
  10.151 -" is_chain(S) ==> range(S) <<| \
  10.152 -\   (lub(range(%i.fst(S i))),lub(range(%i.snd(S i)))) "
  10.153 +qed_goal "lub_cprod" thy 
  10.154 +"is_chain S ==> range S<<|(lub(range(%i.fst(S i))),lub(range(%i.snd(S i))))"
  10.155   (fn prems =>
  10.156          [
  10.157          (cut_facts_tac prems 1),
  10.158 -        (rtac is_lubI 1),
  10.159 -        (rtac conjI 1),
  10.160 -        (rtac ub_rangeI 1),
  10.161 -        (rtac allI 1),
  10.162 -        (res_inst_tac [("t","S(i)")] (surjective_pairing RS ssubst) 1),
  10.163 +        (rtac (conjI RS is_lubI) 1),
  10.164 +        (rtac (allI RS ub_rangeI) 1),
  10.165 +        (res_inst_tac [("t","S i")] (surjective_pairing RS ssubst) 1),
  10.166          (rtac monofun_pair 1),
  10.167          (rtac is_ub_thelub 1),
  10.168          (etac (monofun_fst RS ch2ch_monofun) 1),
  10.169 @@ -168,8 +147,7 @@
  10.170  
  10.171  *)
  10.172  
  10.173 -qed_goal "cpo_cprod" Cprod2.thy 
  10.174 -        "is_chain(S::nat=>'a*'b)==>? x.range(S)<<| x"
  10.175 +qed_goal "cpo_cprod" thy "is_chain(S::nat=>'a*'b)==>? x.range S<<| x"
  10.176  (fn prems =>
  10.177          [
  10.178          (cut_facts_tac prems 1),
    11.1 --- a/src/HOLCF/Cprod2.thy	Sat Feb 15 18:24:05 1997 +0100
    11.2 +++ b/src/HOLCF/Cprod2.thy	Mon Feb 17 10:57:11 1997 +0100
    11.3 @@ -1,4 +1,4 @@
    11.4 -(*  Title:      HOLCF/cprod2.thy
    11.5 +(*  Title:      HOLCF/Cprod2.thy
    11.6      ID:         $Id$
    11.7      Author:     Franz Regensburger
    11.8      Copyright   1993 Technische Universitaet Muenchen
    11.9 @@ -9,16 +9,8 @@
   11.10  
   11.11  Cprod2 = Cprod1 + 
   11.12  
   11.13 -(* Witness for the above arity axiom is cprod1.ML *)
   11.14 -
   11.15 -arities "*" :: (pcpo,pcpo)po
   11.16 -
   11.17 -rules
   11.18 -
   11.19 -(* instance of << for type ['a * 'b]  *)
   11.20 -
   11.21 -inst_cprod_po   "((op <<)::['a * 'b,'a * 'b]=>bool) = less_cprod"
   11.22 -
   11.23 +instance "*"::(pcpo,pcpo)po 
   11.24 +	(refl_less_cprod,antisym_less_cprod,trans_less_cprod)
   11.25  end
   11.26  
   11.27  
    12.1 --- a/src/HOLCF/Cprod3.ML	Sat Feb 15 18:24:05 1997 +0100
    12.2 +++ b/src/HOLCF/Cprod3.ML	Mon Feb 17 10:57:11 1997 +0100
    12.3 @@ -8,6 +8,13 @@
    12.4  
    12.5  open Cprod3;
    12.6  
    12.7 +(* for compatibility with old HOLCF-Version *)
    12.8 +qed_goal "inst_cprod_pcpo" thy "UU = (UU,UU)"
    12.9 + (fn prems => 
   12.10 +        [
   12.11 +        (simp_tac (HOL_ss addsimps [UU_def,UU_cprod_def]) 1)
   12.12 +        ]);
   12.13 +
   12.14  (* ------------------------------------------------------------------------ *)
   12.15  (* continuity of (_,_) , fst, snd                                           *)
   12.16  (* ------------------------------------------------------------------------ *)
   12.17 @@ -226,9 +233,9 @@
   12.18          ]);
   12.19  
   12.20  qed_goal "cfst_strict" Cprod3.thy "cfst`UU = UU" (fn _ => [
   12.21 -                      (simp_tac (HOL_ss addsimps [inst_cprod_pcpo2,cfst2]) 1)]);
   12.22 +             (simp_tac (HOL_ss addsimps [inst_cprod_pcpo2,cfst2]) 1)]);
   12.23  qed_goal "csnd_strict" Cprod3.thy "csnd`UU = UU" (fn _ => [
   12.24 -                      (simp_tac (HOL_ss addsimps [inst_cprod_pcpo2,csnd2]) 1)]);
   12.25 +             (simp_tac (HOL_ss addsimps [inst_cprod_pcpo2,csnd2]) 1)]);
   12.26  
   12.27  qed_goalw "surjective_pairing_Cprod2" Cprod3.thy 
   12.28          [cfst_def,csnd_def,cpair_def] "<cfst`p , csnd`p> = p"
   12.29 @@ -242,22 +249,6 @@
   12.30          (rtac (surjective_pairing RS sym) 1)
   12.31          ]);
   12.32  
   12.33 -
   12.34 -qed_goalw "less_cprod5b" Cprod3.thy [cfst_def,csnd_def,cpair_def]
   12.35 - " (p1 << p2) = (cfst`p1 << cfst`p2 & csnd`p1 << csnd`p2)"
   12.36 - (fn prems =>
   12.37 -        [
   12.38 -        (stac beta_cfun 1),
   12.39 -        (rtac cont_snd 1),
   12.40 -        (stac beta_cfun 1),
   12.41 -        (rtac cont_snd 1),
   12.42 -        (stac beta_cfun 1),
   12.43 -        (rtac cont_fst 1),
   12.44 -        (stac beta_cfun 1),
   12.45 -        (rtac cont_fst 1),
   12.46 -        (rtac less_cprod3b 1)
   12.47 -        ]);
   12.48 -
   12.49  qed_goalw "less_cprod5c" Cprod3.thy [cfst_def,csnd_def,cpair_def]
   12.50   "<xa,ya> << <x,y> ==> xa<<x & ya << y"
   12.51   (fn prems =>
   12.52 @@ -269,7 +260,6 @@
   12.53          (atac 1)
   12.54          ]);
   12.55  
   12.56 -
   12.57  qed_goalw "lub_cprod2" Cprod3.thy [cfst_def,csnd_def,cpair_def]
   12.58  "[|is_chain(S)|] ==> range(S) <<| \
   12.59  \ <(lub(range(%i.cfst`(S i)))) , lub(range(%i.csnd`(S i)))>"
    13.1 --- a/src/HOLCF/Cprod3.thy	Sat Feb 15 18:24:05 1997 +0100
    13.2 +++ b/src/HOLCF/Cprod3.thy	Mon Feb 17 10:57:11 1997 +0100
    13.3 @@ -1,16 +1,15 @@
    13.4 -(*  Title:      HOLCF/cprod3.thy
    13.5 +(*  Title:      HOLCF/Cprod3.thy
    13.6      ID:         $Id$
    13.7      Author:     Franz Regensburger
    13.8      Copyright   1993 Technische Universitaet Muenchen
    13.9  
   13.10 -
   13.11  Class instance of  * for class pcpo
   13.12  
   13.13  *)
   13.14  
   13.15  Cprod3 = Cprod2 +
   13.16  
   13.17 -arities "*" :: (pcpo,pcpo)pcpo                  (* Witness cprod2.ML *)
   13.18 +instance "*" :: (pcpo,pcpo)pcpo   (least_cprod,cpo_cprod)
   13.19  
   13.20  consts  
   13.21          cpair        :: "'a -> 'b -> ('a*'b)" (* continuous  pairing *)
   13.22 @@ -21,15 +20,10 @@
   13.23  syntax  
   13.24          "@ctuple"    :: "['a, args] => 'a * 'b"         ("(1<_,/ _>)")
   13.25  
   13.26 -
   13.27  translations 
   13.28          "<x, y, z>"   == "<x, <y, z>>"
   13.29          "<x, y>"      == "cpair`x`y"
   13.30  
   13.31 -rules 
   13.32 -
   13.33 -inst_cprod_pcpo "(UU::'a*'b) = (UU,UU)"
   13.34 -
   13.35  defs
   13.36  cpair_def       "cpair  == (LAM x y.(x,y))"
   13.37  cfst_def        "cfst   == (LAM p.fst(p))"
   13.38 @@ -70,7 +64,6 @@
   13.39    (* Misc Definitions *)
   13.40    CLet_def       "CLet == LAM s. LAM f.f`s"
   13.41  
   13.42 -
   13.43  syntax
   13.44    (* syntax for LAM <x,y,z>.E *)
   13.45    "@Cpttrn"  :: "[pttrn,pttrns] => pttrn"              ("<_,/_>")
    14.1 --- a/src/HOLCF/Fix.ML	Sat Feb 15 18:24:05 1997 +0100
    14.2 +++ b/src/HOLCF/Fix.ML	Mon Feb 17 10:57:11 1997 +0100
    14.3 @@ -1,9 +1,9 @@
    14.4 -(*  Title:      HOLCF/fix.ML
    14.5 +(*  Title:      HOLCF/Fix.ML
    14.6      ID:         $Id$
    14.7      Author:     Franz Regensburger
    14.8      Copyright   1993  Technische Universitaet Muenchen
    14.9  
   14.10 -Lemmas for fix.thy 
   14.11 +Lemmas for Fix.thy 
   14.12  *)
   14.13  
   14.14  open Fix;
   14.15 @@ -12,13 +12,13 @@
   14.16  (* derive inductive properties of iterate from primitive recursion          *)
   14.17  (* ------------------------------------------------------------------------ *)
   14.18  
   14.19 -qed_goal "iterate_0" Fix.thy "iterate 0 F x = x"
   14.20 +qed_goal "iterate_0" thy "iterate 0 F x = x"
   14.21   (fn prems =>
   14.22          [
   14.23          (resolve_tac (nat_recs iterate_def) 1)
   14.24          ]);
   14.25  
   14.26 -qed_goal "iterate_Suc" Fix.thy "iterate (Suc n) F x  = F`(iterate n F x)"
   14.27 +qed_goal "iterate_Suc" thy "iterate (Suc n) F x  = F`(iterate n F x)"
   14.28   (fn prems =>
   14.29          [
   14.30          (resolve_tac (nat_recs iterate_def) 1)
   14.31 @@ -26,7 +26,7 @@
   14.32  
   14.33  Addsimps [iterate_0, iterate_Suc];
   14.34  
   14.35 -qed_goal "iterate_Suc2" Fix.thy "iterate (Suc n) F x = iterate n F (F`x)"
   14.36 +qed_goal "iterate_Suc2" thy "iterate (Suc n) F x = iterate n F (F`x)"
   14.37   (fn prems =>
   14.38          [
   14.39          (nat_ind_tac "n" 1),
   14.40 @@ -42,7 +42,7 @@
   14.41  (* This property is essential since monotonicity of iterate makes no sense  *)
   14.42  (* ------------------------------------------------------------------------ *)
   14.43  
   14.44 -qed_goalw "is_chain_iterate2" Fix.thy [is_chain] 
   14.45 +qed_goalw "is_chain_iterate2" thy [is_chain] 
   14.46          " x << F`x ==> is_chain (%i.iterate i F x)"
   14.47   (fn prems =>
   14.48          [
   14.49 @@ -56,7 +56,7 @@
   14.50          ]);
   14.51  
   14.52  
   14.53 -qed_goal "is_chain_iterate" Fix.thy  
   14.54 +qed_goal "is_chain_iterate" thy  
   14.55          "is_chain (%i.iterate i F UU)"
   14.56   (fn prems =>
   14.57          [
   14.58 @@ -71,7 +71,7 @@
   14.59  (* ------------------------------------------------------------------------ *)
   14.60  
   14.61  
   14.62 -qed_goalw "Ifix_eq" Fix.thy  [Ifix_def] "Ifix F =F`(Ifix F)"
   14.63 +qed_goalw "Ifix_eq" thy  [Ifix_def] "Ifix F =F`(Ifix F)"
   14.64   (fn prems =>
   14.65          [
   14.66          (stac contlub_cfun_arg 1),
   14.67 @@ -95,7 +95,7 @@
   14.68          ]);
   14.69  
   14.70  
   14.71 -qed_goalw "Ifix_least" Fix.thy [Ifix_def] "F`x=x ==> Ifix(F) << x"
   14.72 +qed_goalw "Ifix_least" thy [Ifix_def] "F`x=x ==> Ifix(F) << x"
   14.73   (fn prems =>
   14.74          [
   14.75          (cut_facts_tac prems 1),
   14.76 @@ -116,7 +116,7 @@
   14.77  (* monotonicity and continuity of iterate                                   *)
   14.78  (* ------------------------------------------------------------------------ *)
   14.79  
   14.80 -qed_goalw "monofun_iterate" Fix.thy  [monofun] "monofun(iterate(i))"
   14.81 +qed_goalw "monofun_iterate" thy  [monofun] "monofun(iterate(i))"
   14.82   (fn prems =>
   14.83          [
   14.84          (strip_tac 1),
   14.85 @@ -137,7 +137,7 @@
   14.86  (* In this special case it is the application function fapp                 *)
   14.87  (* ------------------------------------------------------------------------ *)
   14.88  
   14.89 -qed_goalw "contlub_iterate" Fix.thy  [contlub] "contlub(iterate(i))"
   14.90 +qed_goalw "contlub_iterate" thy  [contlub] "contlub(iterate(i))"
   14.91   (fn prems =>
   14.92          [
   14.93          (strip_tac 1),
   14.94 @@ -168,7 +168,7 @@
   14.95          ]);
   14.96  
   14.97  
   14.98 -qed_goal "cont_iterate" Fix.thy "cont(iterate(i))"
   14.99 +qed_goal "cont_iterate" thy "cont(iterate(i))"
  14.100   (fn prems =>
  14.101          [
  14.102          (rtac monocontlub2cont 1),
  14.103 @@ -180,7 +180,7 @@
  14.104  (* a lemma about continuity of iterate in its third argument                *)
  14.105  (* ------------------------------------------------------------------------ *)
  14.106  
  14.107 -qed_goal "monofun_iterate2" Fix.thy "monofun(iterate n F)"
  14.108 +qed_goal "monofun_iterate2" thy "monofun(iterate n F)"
  14.109   (fn prems =>
  14.110          [
  14.111          (rtac monofunI 1),
  14.112 @@ -191,7 +191,7 @@
  14.113          (etac monofun_cfun_arg 1)
  14.114          ]);
  14.115  
  14.116 -qed_goal "contlub_iterate2" Fix.thy "contlub(iterate n F)"
  14.117 +qed_goal "contlub_iterate2" thy "contlub(iterate n F)"
  14.118   (fn prems =>
  14.119          [
  14.120          (rtac contlubI 1),
  14.121 @@ -206,7 +206,7 @@
  14.122          (etac (monofun_iterate2 RS ch2ch_monofun) 1)
  14.123          ]);
  14.124  
  14.125 -qed_goal "cont_iterate2" Fix.thy "cont (iterate n F)"
  14.126 +qed_goal "cont_iterate2" thy "cont (iterate n F)"
  14.127   (fn prems =>
  14.128          [
  14.129          (rtac monocontlub2cont 1),
  14.130 @@ -218,7 +218,7 @@
  14.131  (* monotonicity and continuity of Ifix                                      *)
  14.132  (* ------------------------------------------------------------------------ *)
  14.133  
  14.134 -qed_goalw "monofun_Ifix" Fix.thy  [monofun,Ifix_def] "monofun(Ifix)"
  14.135 +qed_goalw "monofun_Ifix" thy  [monofun,Ifix_def] "monofun(Ifix)"
  14.136   (fn prems =>
  14.137          [
  14.138          (strip_tac 1),
  14.139 @@ -235,7 +235,7 @@
  14.140  (* be derived for lubs in this argument                                     *)
  14.141  (* ------------------------------------------------------------------------ *)
  14.142  
  14.143 -qed_goal "is_chain_iterate_lub" Fix.thy   
  14.144 +qed_goal "is_chain_iterate_lub" thy   
  14.145  "is_chain(Y) ==> is_chain(%i. lub(range(%ia. iterate ia (Y i) UU)))"
  14.146   (fn prems =>
  14.147          [
  14.148 @@ -256,7 +256,7 @@
  14.149  (* chains is the essential argument which is usually derived from monot.    *)
  14.150  (* ------------------------------------------------------------------------ *)
  14.151  
  14.152 -qed_goal "contlub_Ifix_lemma1" Fix.thy 
  14.153 +qed_goal "contlub_Ifix_lemma1" thy 
  14.154  "is_chain(Y) ==>iterate n (lub(range Y)) y = lub(range(%i. iterate n (Y i) y))"
  14.155   (fn prems =>
  14.156          [
  14.157 @@ -271,7 +271,7 @@
  14.158          ]);
  14.159  
  14.160  
  14.161 -qed_goal "ex_lub_iterate" Fix.thy  "is_chain(Y) ==>\
  14.162 +qed_goal "ex_lub_iterate" thy  "is_chain(Y) ==>\
  14.163  \         lub(range(%i. lub(range(%ia. iterate i (Y ia) UU)))) =\
  14.164  \         lub(range(%i. lub(range(%ia. iterate ia (Y i) UU))))"
  14.165   (fn prems =>
  14.166 @@ -305,7 +305,7 @@
  14.167          ]);
  14.168  
  14.169  
  14.170 -qed_goalw "contlub_Ifix" Fix.thy  [contlub,Ifix_def] "contlub(Ifix)"
  14.171 +qed_goalw "contlub_Ifix" thy  [contlub,Ifix_def] "contlub(Ifix)"
  14.172   (fn prems =>
  14.173          [
  14.174          (strip_tac 1),
  14.175 @@ -315,7 +315,7 @@
  14.176          ]);
  14.177  
  14.178  
  14.179 -qed_goal "cont_Ifix" Fix.thy "cont(Ifix)"
  14.180 +qed_goal "cont_Ifix" thy "cont(Ifix)"
  14.181   (fn prems =>
  14.182          [
  14.183          (rtac monocontlub2cont 1),
  14.184 @@ -327,14 +327,14 @@
  14.185  (* propagate properties of Ifix to its continuous counterpart               *)
  14.186  (* ------------------------------------------------------------------------ *)
  14.187  
  14.188 -qed_goalw "fix_eq" Fix.thy  [fix_def] "fix`F = F`(fix`F)"
  14.189 +qed_goalw "fix_eq" thy  [fix_def] "fix`F = F`(fix`F)"
  14.190   (fn prems =>
  14.191          [
  14.192          (asm_simp_tac (!simpset addsimps [cont_Ifix]) 1),
  14.193          (rtac Ifix_eq 1)
  14.194          ]);
  14.195  
  14.196 -qed_goalw "fix_least" Fix.thy [fix_def] "F`x = x ==> fix`F << x"
  14.197 +qed_goalw "fix_least" thy [fix_def] "F`x = x ==> fix`F << x"
  14.198   (fn prems =>
  14.199          [
  14.200          (cut_facts_tac prems 1),
  14.201 @@ -343,7 +343,7 @@
  14.202          ]);
  14.203  
  14.204  
  14.205 -qed_goal "fix_eqI" Fix.thy
  14.206 +qed_goal "fix_eqI" thy
  14.207  "[| F`x = x; !z. F`z = z --> x << z |] ==> x = fix`F"
  14.208   (fn prems =>
  14.209          [
  14.210 @@ -356,14 +356,14 @@
  14.211          ]);
  14.212  
  14.213  
  14.214 -qed_goal "fix_eq2" Fix.thy "f == fix`F ==> f = F`f"
  14.215 +qed_goal "fix_eq2" thy "f == fix`F ==> f = F`f"
  14.216   (fn prems =>
  14.217          [
  14.218          (rewrite_goals_tac prems),
  14.219          (rtac fix_eq 1)
  14.220          ]);
  14.221  
  14.222 -qed_goal "fix_eq3" Fix.thy "f == fix`F ==> f`x = F`f`x"
  14.223 +qed_goal "fix_eq3" thy "f == fix`F ==> f`x = F`f`x"
  14.224   (fn prems =>
  14.225          [
  14.226          (rtac trans 1),
  14.227 @@ -373,7 +373,7 @@
  14.228  
  14.229  fun fix_tac3 thm i  = ((rtac trans i) THEN (rtac (thm RS fix_eq3) i)); 
  14.230  
  14.231 -qed_goal "fix_eq4" Fix.thy "f = fix`F ==> f = F`f"
  14.232 +qed_goal "fix_eq4" thy "f = fix`F ==> f = F`f"
  14.233   (fn prems =>
  14.234          [
  14.235          (cut_facts_tac prems 1),
  14.236 @@ -381,7 +381,7 @@
  14.237          (rtac fix_eq 1)
  14.238          ]);
  14.239  
  14.240 -qed_goal "fix_eq5" Fix.thy "f = fix`F ==> f`x = F`f`x"
  14.241 +qed_goal "fix_eq5" thy "f = fix`F ==> f`x = F`f`x"
  14.242   (fn prems =>
  14.243          [
  14.244          (rtac trans 1),
  14.245 @@ -418,7 +418,7 @@
  14.246  (* ------------------------------------------------------------------------ *)
  14.247  
  14.248  
  14.249 -qed_goal "Ifix_def2" Fix.thy "Ifix=(%x. lub(range(%i. iterate i x UU)))"
  14.250 +qed_goal "Ifix_def2" thy "Ifix=(%x. lub(range(%i. iterate i x UU)))"
  14.251   (fn prems =>
  14.252          [
  14.253          (rtac ext 1),
  14.254 @@ -430,7 +430,7 @@
  14.255  (* direct connection between fix and iteration without Ifix                 *)
  14.256  (* ------------------------------------------------------------------------ *)
  14.257  
  14.258 -qed_goalw "fix_def2" Fix.thy [fix_def]
  14.259 +qed_goalw "fix_def2" thy [fix_def]
  14.260   "fix`F = lub(range(%i. iterate i F UU))"
  14.261   (fn prems =>
  14.262          [
  14.263 @@ -447,14 +447,14 @@
  14.264  (* access to definitions                                                    *)
  14.265  (* ------------------------------------------------------------------------ *)
  14.266  
  14.267 -qed_goalw "adm_def2" Fix.thy [adm_def]
  14.268 +qed_goalw "adm_def2" thy [adm_def]
  14.269          "adm(P) = (!Y. is_chain(Y) --> (!i.P(Y(i))) --> P(lub(range(Y))))"
  14.270   (fn prems =>
  14.271          [
  14.272          (rtac refl 1)
  14.273          ]);
  14.274  
  14.275 -qed_goalw "admw_def2" Fix.thy [admw_def]
  14.276 +qed_goalw "admw_def2" thy [admw_def]
  14.277          "admw(P) = (!F.(!n.P(iterate n F UU)) -->\
  14.278  \                        P (lub(range(%i.iterate i F UU))))"
  14.279   (fn prems =>
  14.280 @@ -466,7 +466,7 @@
  14.281  (* an admissible formula is also weak admissible                            *)
  14.282  (* ------------------------------------------------------------------------ *)
  14.283  
  14.284 -qed_goalw "adm_impl_admw"  Fix.thy [admw_def] "adm(P)==>admw(P)"
  14.285 +qed_goalw "adm_impl_admw"  thy [admw_def] "adm(P)==>admw(P)"
  14.286   (fn prems =>
  14.287          [
  14.288          (cut_facts_tac prems 1),
  14.289 @@ -481,7 +481,7 @@
  14.290  (* fixed point induction                                                    *)
  14.291  (* ------------------------------------------------------------------------ *)
  14.292  
  14.293 -qed_goal "fix_ind"  Fix.thy  
  14.294 +qed_goal "fix_ind"  thy  
  14.295  "[| adm(P);P(UU);!!x. P(x) ==> P(F`x)|] ==> P(fix`F)"
  14.296   (fn prems =>
  14.297          [
  14.298 @@ -499,7 +499,7 @@
  14.299          (atac 1)
  14.300          ]);
  14.301  
  14.302 -qed_goal "def_fix_ind" Fix.thy "[| f == fix`F; adm(P); \
  14.303 +qed_goal "def_fix_ind" thy "[| f == fix`F; adm(P); \
  14.304  \       P(UU);!!x. P(x) ==> P(F`x)|] ==> P f" (fn prems => [
  14.305          (cut_facts_tac prems 1),
  14.306  	(asm_simp_tac HOL_ss 1),
  14.307 @@ -511,7 +511,7 @@
  14.308  (* computational induction for weak admissible formulae                     *)
  14.309  (* ------------------------------------------------------------------------ *)
  14.310  
  14.311 -qed_goal "wfix_ind"  Fix.thy  
  14.312 +qed_goal "wfix_ind"  thy  
  14.313  "[| admw(P); !n. P(iterate n F UU)|] ==> P(fix`F)"
  14.314   (fn prems =>
  14.315          [
  14.316 @@ -523,7 +523,7 @@
  14.317          (etac spec 1)
  14.318          ]);
  14.319  
  14.320 -qed_goal "def_wfix_ind" Fix.thy "[| f == fix`F; admw(P); \
  14.321 +qed_goal "def_wfix_ind" thy "[| f == fix`F; admw(P); \
  14.322  \       !n. P(iterate n F UU) |] ==> P f" (fn prems => [
  14.323          (cut_facts_tac prems 1),
  14.324  	(asm_simp_tac HOL_ss 1),
  14.325 @@ -534,7 +534,7 @@
  14.326  (* for chain-finite (easy) types every formula is admissible                *)
  14.327  (* ------------------------------------------------------------------------ *)
  14.328  
  14.329 -qed_goalw "adm_max_in_chain"  Fix.thy  [adm_def]
  14.330 +qed_goalw "adm_max_in_chain"  thy  [adm_def]
  14.331  "!Y. is_chain(Y::nat=>'a) --> (? n.max_in_chain n Y) ==> adm(P::'a=>bool)"
  14.332   (fn prems =>
  14.333          [
  14.334 @@ -550,7 +550,7 @@
  14.335          (etac spec 1)
  14.336          ]);
  14.337  
  14.338 -qed_goalw "adm_chain_finite"  Fix.thy  [chain_finite_def]
  14.339 +qed_goalw "adm_chain_finite"  thy  [chain_finite_def]
  14.340          "chain_finite(x::'a) ==> adm(P::'a=>bool)"
  14.341   (fn prems =>
  14.342          [
  14.343 @@ -562,7 +562,7 @@
  14.344  (* flat types are chain_finite                                              *)
  14.345  (* ------------------------------------------------------------------------ *)
  14.346  
  14.347 -qed_goalw "flat_imp_chain_finite"  Fix.thy  [flat_def,chain_finite_def]
  14.348 +qed_goalw "flat_imp_chain_finite"  thy  [flat_def,chain_finite_def]
  14.349          "flat(x::'a)==>chain_finite(x::'a)"
  14.350   (fn prems =>
  14.351          [
  14.352 @@ -606,7 +606,16 @@
  14.353  (* some properties of flat			 			    *)
  14.354  (* ------------------------------------------------------------------------ *)
  14.355  
  14.356 -qed_goalw "flatdom2monofun" Fix.thy [flat_def] 
  14.357 +qed_goalw "flatI" thy [flat_def] "!x y::'a.x<<y-->x=UU|x=y==>flat(x::'a)"
  14.358 +(fn prems => [rtac (hd(prems)) 1]);
  14.359 +
  14.360 +qed_goalw "flatE" thy [flat_def] "flat(x::'a)==>!x y::'a.x<<y-->x=UU|x=y"
  14.361 +(fn prems => [rtac (hd(prems)) 1]);
  14.362 +
  14.363 +qed_goalw "flat_flat" thy [flat_def] "flat(x::'a::flat)"
  14.364 +(fn prems => [rtac ax_flat 1]);
  14.365 +
  14.366 +qed_goalw "flatdom2monofun" thy [flat_def] 
  14.367    "[| flat(x::'a::pcpo); f UU = UU |] ==> monofun (f::'a=>'b::pcpo)" 
  14.368  (fn prems => 
  14.369  	[
  14.370 @@ -615,15 +624,7 @@
  14.371  	]);
  14.372  
  14.373  
  14.374 -qed_goalw "flat_void" Fix.thy [flat_def] "flat(UU::void)"
  14.375 - (fn prems =>
  14.376 -        [
  14.377 -        (strip_tac 1),
  14.378 -        (rtac disjI1 1),
  14.379 -        (rtac unique_void2 1)
  14.380 -        ]);
  14.381 -
  14.382 -qed_goalw "flat_eq" Fix.thy [flat_def] 
  14.383 +qed_goalw "flat_eq" thy [flat_def] 
  14.384          "[| flat (x::'a); (a::'a) ~= UU |] ==> a << b = (a = b)" (fn prems=>[
  14.385          (cut_facts_tac prems 1),
  14.386          (fast_tac (HOL_cs addIs [refl_less]) 1)]);
  14.387 @@ -633,8 +634,19 @@
  14.388  (* some lemmata for functions with flat/chain_finite domain/range types	    *)
  14.389  (* ------------------------------------------------------------------------ *)
  14.390  
  14.391 -qed_goal "chfin2finch" Fix.thy 
  14.392 -    "[| is_chain (Y::nat=>'a); chain_finite (x::'a) |] ==> finite_chain Y"
  14.393 +qed_goalw "chfinI" thy [chain_finite_def] 
  14.394 +  "!Y::nat=>'a.is_chain Y-->(? n.max_in_chain n Y)==>chain_finite(x::'a)"
  14.395 +(fn prems => [rtac (hd(prems)) 1]);
  14.396 +
  14.397 +qed_goalw "chfinE" Fix.thy [chain_finite_def] 
  14.398 +  "chain_finite(x::'a)==>!Y::nat=>'a.is_chain Y-->(? n.max_in_chain n Y)"
  14.399 +(fn prems => [rtac (hd(prems)) 1]);
  14.400 +
  14.401 +qed_goalw "chfin_chfin" thy [chain_finite_def] "chain_finite(x::'a::chfin)"
  14.402 +(fn prems => [rtac ax_chfin 1]);
  14.403 +
  14.404 +qed_goal "chfin2finch" thy 
  14.405 +    "[| is_chain (Y::nat=>'a); chain_finite(x::'a) |] ==> finite_chain Y"
  14.406  (fn prems => 
  14.407  	[
  14.408  	cut_facts_tac prems 1,
  14.409 @@ -642,7 +654,9 @@
  14.410  		 (!simpset addsimps [chain_finite_def,finite_chain_def])) 1
  14.411  	]);
  14.412  
  14.413 -qed_goal "chfindom_monofun2cont" Fix.thy 
  14.414 +bind_thm("flat_subclass_chfin",flat_flat RS flat_imp_chain_finite RS chfinE);
  14.415 +
  14.416 +qed_goal "chfindom_monofun2cont" thy 
  14.417    "[| chain_finite(x::'a::pcpo); monofun f |] ==> cont (f::'a=>'b::pcpo)"
  14.418  (fn prems => 
  14.419  	[
  14.420 @@ -666,7 +680,7 @@
  14.421  bind_thm("flatdom_monofun2cont",flat_imp_chain_finite RS chfindom_monofun2cont);
  14.422  (* [| flat ?x; monofun ?f |] ==> cont ?f *)
  14.423  
  14.424 -qed_goal "flatdom_strict2cont" Fix.thy 
  14.425 +qed_goal "flatdom_strict2cont" thy 
  14.426    "[| flat(x::'a::pcpo); f UU = UU |] ==> cont (f::'a=>'b::pcpo)" 
  14.427  (fn prems =>
  14.428  	[
  14.429 @@ -675,7 +689,7 @@
  14.430  			flat_imp_chain_finite RS chfindom_monofun2cont])) 1
  14.431  	]);
  14.432  
  14.433 -qed_goal "chfin_fappR" Fix.thy 
  14.434 +qed_goal "chfin_fappR" thy 
  14.435      "[| is_chain (Y::nat => 'a->'b); chain_finite(x::'b) |] ==> \
  14.436  \    !s. ? n. lub(range(Y))`s = Y n`s" 
  14.437  (fn prems => 
  14.438 @@ -687,7 +701,7 @@
  14.439  	fast_tac (HOL_cs addSIs [thelubI,lub_finch2,chfin2finch,ch2ch_fappL])1
  14.440  	]);
  14.441  
  14.442 -qed_goalw "adm_chfindom" Fix.thy [adm_def]
  14.443 +qed_goalw "adm_chfindom" thy [adm_def]
  14.444  	    "chain_finite (x::'b) ==> adm (%(u::'a->'b). P(u`s))" (fn prems => [
  14.445  	cut_facts_tac prems 1,
  14.446  	strip_tac 1,
  14.447 @@ -731,7 +745,7 @@
  14.448          fast_tac (HOL_cs addDs [le_imp_less_or_eq] 
  14.449                           addEs [chain_mono RS mp]) 1]);
  14.450  
  14.451 -qed_goalw "admI" Fix.thy [adm_def]
  14.452 +qed_goalw "admI" thy [adm_def]
  14.453   "(!!Y. [| is_chain Y; !i. P (Y i); !i. ? j. i < j & Y i ~= Y j & Y i << Y j |]\
  14.454  \ ==> P(lub (range Y))) ==> adm P" 
  14.455   (fn prems => [
  14.456 @@ -745,7 +759,7 @@
  14.457  (* a prove for embedding projection pairs is similar                        *)
  14.458  (* ------------------------------------------------------------------------ *)
  14.459  
  14.460 -qed_goal "iso_strict"  Fix.thy  
  14.461 +qed_goal "iso_strict"  thy  
  14.462  "!!f g.[|!y.f`(g`y)=(y::'b) ; !x.g`(f`x)=(x::'a) |] \
  14.463  \ ==> f`UU=UU & g`UU=UU"
  14.464   (fn prems =>
  14.465 @@ -762,7 +776,7 @@
  14.466          ]);
  14.467  
  14.468  
  14.469 -qed_goal "isorep_defined" Fix.thy 
  14.470 +qed_goal "isorep_defined" thy 
  14.471          "[|!x.rep`(abs`x)=x;!y.abs`(rep`y)=y; z~=UU|] ==> rep`z ~= UU"
  14.472   (fn prems =>
  14.473          [
  14.474 @@ -776,7 +790,7 @@
  14.475          (atac 1)
  14.476          ]);
  14.477  
  14.478 -qed_goal "isoabs_defined" Fix.thy 
  14.479 +qed_goal "isoabs_defined" thy 
  14.480          "[|!x.rep`(abs`x) = x;!y.abs`(rep`y)=y ; z~=UU|] ==> abs`z ~= UU"
  14.481   (fn prems =>
  14.482          [
  14.483 @@ -794,7 +808,7 @@
  14.484  (* propagation of flatness and chainfiniteness by continuous isomorphisms   *)
  14.485  (* ------------------------------------------------------------------------ *)
  14.486  
  14.487 -qed_goalw "chfin2chfin"  Fix.thy  [chain_finite_def]
  14.488 +qed_goalw "chfin2chfin"  thy  [chain_finite_def]
  14.489  "!!f g.[|chain_finite(x::'a); !y.f`(g`y)=(y::'b) ; !x.g`(f`x)=(x::'a) |] \
  14.490  \ ==> chain_finite(y::'b)"
  14.491   (fn prems =>
  14.492 @@ -817,7 +831,7 @@
  14.493          (atac 1)
  14.494          ]);
  14.495  
  14.496 -qed_goalw "flat2flat"  Fix.thy  [flat_def]
  14.497 +qed_goalw "flat2flat"  thy  [flat_def]
  14.498  "!!f g.[|flat(x::'a); !y.f`(g`y)=(y::'b) ; !x.g`(f`x)=(x::'a) |] \
  14.499  \ ==> flat(y::'b)"
  14.500   (fn prems =>
  14.501 @@ -848,7 +862,7 @@
  14.502  (* a result about functions with flat codomain                               *)
  14.503  (* ------------------------------------------------------------------------- *)
  14.504  
  14.505 -qed_goalw "flat_codom" Fix.thy [flat_def]
  14.506 +qed_goalw "flat_codom" thy [flat_def]
  14.507  "[|flat(y::'b);f`(x::'a)=(c::'b)|] ==> f`(UU::'a)=(UU::'b) | (!z.f`(z::'a)=c)"
  14.508   (fn prems =>
  14.509          [
  14.510 @@ -885,7 +899,7 @@
  14.511  (* admissibility of special formulae and propagation                        *)
  14.512  (* ------------------------------------------------------------------------ *)
  14.513  
  14.514 -qed_goalw "adm_less"  Fix.thy [adm_def]
  14.515 +qed_goalw "adm_less"  thy [adm_def]
  14.516          "[|cont u;cont v|]==> adm(%x.u x << v x)"
  14.517   (fn prems =>
  14.518          [
  14.519 @@ -905,7 +919,7 @@
  14.520          (atac 1)
  14.521          ]);
  14.522  
  14.523 -qed_goal "adm_conj"  Fix.thy  
  14.524 +qed_goal "adm_conj"  thy  
  14.525          "[| adm P; adm Q |] ==> adm(%x. P x & Q x)"
  14.526   (fn prems =>
  14.527          [
  14.528 @@ -923,7 +937,7 @@
  14.529          (fast_tac HOL_cs 1)
  14.530          ]);
  14.531  
  14.532 -qed_goal "adm_cong"  Fix.thy  
  14.533 +qed_goal "adm_cong"  thy  
  14.534          "(!x. P x = Q x) ==> adm P = adm Q "
  14.535   (fn prems =>
  14.536          [
  14.537 @@ -934,13 +948,13 @@
  14.538          (etac spec 1)
  14.539          ]);
  14.540  
  14.541 -qed_goalw "adm_not_free"  Fix.thy [adm_def] "adm(%x.t)"
  14.542 +qed_goalw "adm_not_free"  thy [adm_def] "adm(%x.t)"
  14.543   (fn prems =>
  14.544          [
  14.545          (fast_tac HOL_cs 1)
  14.546          ]);
  14.547  
  14.548 -qed_goalw "adm_not_less"  Fix.thy [adm_def]
  14.549 +qed_goalw "adm_not_less"  thy [adm_def]
  14.550          "cont t ==> adm(%x.~ (t x) << u)"
  14.551   (fn prems =>
  14.552          [
  14.553 @@ -955,7 +969,7 @@
  14.554          (atac 1)
  14.555          ]);
  14.556  
  14.557 -qed_goal "adm_all"  Fix.thy  
  14.558 +qed_goal "adm_all"  thy  
  14.559          " !y.adm(P y) ==> adm(%x.!y.P y x)"
  14.560   (fn prems =>
  14.561          [
  14.562 @@ -972,7 +986,7 @@
  14.563  
  14.564  bind_thm ("adm_all2", allI RS adm_all);
  14.565  
  14.566 -qed_goal "adm_subst"  Fix.thy  
  14.567 +qed_goal "adm_subst"  thy  
  14.568          "[|cont t; adm P|] ==> adm(%x. P (t x))"
  14.569   (fn prems =>
  14.570          [
  14.571 @@ -990,7 +1004,7 @@
  14.572          (atac 1)
  14.573          ]);
  14.574  
  14.575 -qed_goal "adm_UU_not_less"  Fix.thy "adm(%x.~ UU << t(x))"
  14.576 +qed_goal "adm_UU_not_less"  thy "adm(%x.~ UU << t(x))"
  14.577   (fn prems =>
  14.578          [
  14.579          (res_inst_tac [("P2","%x.False")] (adm_cong RS iffD1) 1),
  14.580 @@ -998,7 +1012,7 @@
  14.581          (rtac adm_not_free 1)
  14.582          ]);
  14.583  
  14.584 -qed_goalw "adm_not_UU"  Fix.thy [adm_def] 
  14.585 +qed_goalw "adm_not_UU"  thy [adm_def] 
  14.586          "cont(t)==> adm(%x.~ (t x) = UU)"
  14.587   (fn prems =>
  14.588          [
  14.589 @@ -1016,7 +1030,7 @@
  14.590          (atac 1)
  14.591          ]);
  14.592  
  14.593 -qed_goal "adm_eq"  Fix.thy 
  14.594 +qed_goal "adm_eq"  thy 
  14.595          "[|cont u ; cont v|]==> adm(%x. u x = v x)"
  14.596   (fn prems =>
  14.597          [
  14.598 @@ -1052,13 +1066,13 @@
  14.599          (fast_tac HOL_cs 1)
  14.600          ]);
  14.601  
  14.602 -  val adm_disj_lemma2 = prove_goal Fix.thy  
  14.603 +  val adm_disj_lemma2 = prove_goal thy  
  14.604    "!!Q. [| adm(Q); ? X.is_chain(X) & (!n.Q(X(n))) &\
  14.605    \   lub(range(Y))=lub(range(X))|] ==> Q(lub(range(Y)))"
  14.606   (fn _ => [fast_tac (!claset addEs [adm_def2 RS iffD1 RS spec RS mp RS mp]
  14.607                               addss !simpset) 1]);
  14.608  
  14.609 -  val adm_disj_lemma3 = prove_goalw Fix.thy [is_chain]
  14.610 +  val adm_disj_lemma3 = prove_goalw thy [is_chain]
  14.611    "!!Q. is_chain(Y) ==> is_chain(%m. if m < Suc i then Y(Suc i) else Y m)"
  14.612   (fn _ =>
  14.613          [
  14.614 @@ -1080,7 +1094,7 @@
  14.615          trans_tac 1
  14.616          ]);
  14.617  
  14.618 -  val adm_disj_lemma5 = prove_goal Fix.thy
  14.619 +  val adm_disj_lemma5 = prove_goal thy
  14.620    "!!Y::nat=>'a. [| is_chain(Y); ! j. i < j --> Q(Y(j)) |] ==>\
  14.621    \       lub(range(Y)) = lub(range(%m. if m< Suc(i) then Y(Suc(i)) else Y m))"
  14.622   (fn prems =>
  14.623 @@ -1093,7 +1107,7 @@
  14.624          trans_tac 1
  14.625          ]);
  14.626  
  14.627 -  val adm_disj_lemma6 = prove_goal Fix.thy
  14.628 +  val adm_disj_lemma6 = prove_goal thy
  14.629    "[| is_chain(Y::nat=>'a); ? i. ! j. i < j --> Q(Y(j)) |] ==>\
  14.630    \         ? X. is_chain(X) & (! n. Q(X(n))) & lub(range(Y)) = lub(range(X))"
  14.631   (fn prems =>
  14.632 @@ -1112,7 +1126,7 @@
  14.633          (atac 1)
  14.634          ]);
  14.635  
  14.636 -  val adm_disj_lemma7 = prove_goal Fix.thy 
  14.637 +  val adm_disj_lemma7 = prove_goal thy 
  14.638    "[| is_chain(Y::nat=>'a); ! i. ? j. i < j & P(Y(j))  |] ==>\
  14.639    \         is_chain(%m. Y(Least(%j. m<j & P(Y(j)))))"
  14.640   (fn prems =>
  14.641 @@ -1135,7 +1149,7 @@
  14.642          (atac 1)
  14.643          ]);
  14.644  
  14.645 -  val adm_disj_lemma8 = prove_goal Fix.thy 
  14.646 +  val adm_disj_lemma8 = prove_goal thy 
  14.647    "[| ! i. ? j. i < j & P(Y(j)) |] ==> ! m. P(Y(LEAST j::nat. m<j & P(Y(j))))"
  14.648   (fn prems =>
  14.649          [
  14.650 @@ -1146,7 +1160,7 @@
  14.651          (etac (LeastI RS conjunct2) 1)
  14.652          ]);
  14.653  
  14.654 -  val adm_disj_lemma9 = prove_goal Fix.thy
  14.655 +  val adm_disj_lemma9 = prove_goal thy
  14.656    "[| is_chain(Y::nat=>'a); ! i. ? j. i < j & P(Y(j)) |] ==>\
  14.657    \         lub(range(Y)) = lub(range(%m. Y(Least(%j. m<j & P(Y(j))))))"
  14.658   (fn prems =>
  14.659 @@ -1177,7 +1191,7 @@
  14.660          (rtac lessI 1)
  14.661          ]);
  14.662  
  14.663 -  val adm_disj_lemma10 = prove_goal Fix.thy
  14.664 +  val adm_disj_lemma10 = prove_goal thy
  14.665    "[| is_chain(Y::nat=>'a); ! i. ? j. i < j & P(Y(j)) |] ==>\
  14.666    \         ? X. is_chain(X) & (! n. P(X(n))) & lub(range(Y)) = lub(range(X))"
  14.667   (fn prems =>
  14.668 @@ -1196,7 +1210,7 @@
  14.669          (atac 1)
  14.670          ]);
  14.671  
  14.672 -  val adm_disj_lemma12 = prove_goal Fix.thy
  14.673 +  val adm_disj_lemma12 = prove_goal thy
  14.674    "[| adm(P); is_chain(Y);? i. ! j. i < j --> P(Y(j))|]==>P(lub(range(Y)))"
  14.675   (fn prems =>
  14.676          [
  14.677 @@ -1208,7 +1222,7 @@
  14.678  
  14.679  in
  14.680  
  14.681 -val adm_lemma11 = prove_goal Fix.thy
  14.682 +val adm_lemma11 = prove_goal thy
  14.683  "[| adm(P); is_chain(Y); ! i. ? j. i < j & P(Y(j)) |]==>P(lub(range(Y)))"
  14.684   (fn prems =>
  14.685          [
  14.686 @@ -1218,7 +1232,7 @@
  14.687          (atac 1)
  14.688          ]);
  14.689  
  14.690 -val adm_disj = prove_goal Fix.thy  
  14.691 +val adm_disj = prove_goal thy  
  14.692          "[| adm P; adm Q |] ==> adm(%x.P x | Q x)"
  14.693   (fn prems =>
  14.694          [
  14.695 @@ -1242,7 +1256,7 @@
  14.696  bind_thm("adm_lemma11",adm_lemma11);
  14.697  bind_thm("adm_disj",adm_disj);
  14.698  
  14.699 -qed_goal "adm_imp"  Fix.thy  
  14.700 +qed_goal "adm_imp"  thy  
  14.701          "[| adm(%x.~(P x)); adm Q |] ==> adm(%x.P x --> Q x)"
  14.702   (fn prems =>
  14.703          [
  14.704 @@ -1254,7 +1268,7 @@
  14.705          (atac 1)
  14.706          ]);
  14.707  
  14.708 -qed_goal "adm_not_conj"  Fix.thy  
  14.709 +qed_goal "adm_not_conj"  thy  
  14.710  "[| adm (%x. ~ P x); adm (%x. ~ Q x) |] ==> adm (%x. ~ (P x & Q x))"(fn prems=>[
  14.711          cut_facts_tac prems 1,
  14.712          subgoal_tac 
    15.1 --- a/src/HOLCF/Fix.thy	Sat Feb 15 18:24:05 1997 +0100
    15.2 +++ b/src/HOLCF/Fix.thy	Mon Feb 17 10:57:11 1997 +0100
    15.3 @@ -1,4 +1,4 @@
    15.4 -(*  Title:      HOLCF/fix.thy
    15.5 +(*  Title:      HOLCF/Fix.thy
    15.6      ID:         $Id$
    15.7      Author:     Franz Regensburger
    15.8      Copyright   1993  Technische Universitaet Muenchen
    15.9 @@ -37,5 +37,15 @@
   15.10  
   15.11  flat_def	  "flat (x::'a) == ! x y. (x::'a) << y --> (x = UU) | (x=y)"
   15.12  
   15.13 +(* further useful class for HOLCF *)
   15.14 +
   15.15 +axclass chfin<pcpo
   15.16 +
   15.17 +ax_chfin 	"!Y.is_chain Y-->(? n.max_in_chain n Y)"
   15.18 +
   15.19 +axclass flat<pcpo
   15.20 +
   15.21 +ax_flat	 	"! x y.x << y --> (x = UU) | (x=y)"
   15.22 +
   15.23  end
   15.24  
    16.1 --- a/src/HOLCF/Fun1.ML	Sat Feb 15 18:24:05 1997 +0100
    16.2 +++ b/src/HOLCF/Fun1.ML	Mon Feb 17 10:57:11 1997 +0100
    16.3 @@ -1,4 +1,4 @@
    16.4 -(*  Title:      HOLCF/fun1.ML
    16.5 +(*  Title:      HOLCF/Fun1.ML
    16.6      ID:         $Id$
    16.7      Author:     Franz Regensburger
    16.8      Copyright   1993  Technische Universitaet Muenchen
    16.9 @@ -12,14 +12,14 @@
   16.10  (* less_fun is a partial order on 'a => 'b                                  *)
   16.11  (* ------------------------------------------------------------------------ *)
   16.12  
   16.13 -qed_goalw "refl_less_fun" Fun1.thy [less_fun_def] "less_fun f f"
   16.14 +qed_goalw "refl_less_fun" thy [less_fun_def] "less(f::'a::term =>'b::po) f"
   16.15  (fn prems =>
   16.16          [
   16.17          (fast_tac (HOL_cs addSIs [refl_less]) 1)
   16.18          ]);
   16.19  
   16.20  qed_goalw "antisym_less_fun" Fun1.thy [less_fun_def] 
   16.21 -        "[|less_fun f1 f2; less_fun f2 f1|] ==> f1 = f2"
   16.22 +        "[|less (f1::'a::term =>'b::po) f2; less f2 f1|] ==> f1 = f2"
   16.23  (fn prems =>
   16.24          [
   16.25          (cut_facts_tac prems 1),
   16.26 @@ -28,7 +28,7 @@
   16.27          ]);
   16.28  
   16.29  qed_goalw "trans_less_fun" Fun1.thy [less_fun_def] 
   16.30 -        "[|less_fun f1 f2; less_fun f2 f3 |] ==> less_fun f1 f3"
   16.31 +        "[|less (f1::'a::term =>'b::po) f2; less f2 f3 |] ==> less f1 f3"
   16.32  (fn prems =>
   16.33          [
   16.34          (cut_facts_tac prems 1),
   16.35 @@ -38,12 +38,3 @@
   16.36          (atac 1),
   16.37          ((etac allE 1) THEN (atac 1))
   16.38          ]);
   16.39 -
   16.40 -(* 
   16.41 - -------------------------------------------------------------------------- 
   16.42 -   Since less_fun :: "['a::term=>'b::po,'a::term=>'b::po] => bool" the
   16.43 -   lemmas refl_less_fun, antisym_less_fun, trans_less_fun justify
   16.44 -   the class arity fun::(term,po)po !!
   16.45 - -------------------------------------------------------------------------- 
   16.46 -*)
   16.47 -
    17.1 --- a/src/HOLCF/Fun1.thy	Sat Feb 15 18:24:05 1997 +0100
    17.2 +++ b/src/HOLCF/Fun1.thy	Mon Feb 17 10:57:11 1997 +0100
    17.3 @@ -1,4 +1,4 @@
    17.4 -(*  Title:      HOLCF/fun1.thy
    17.5 +(*  Title:      HOLCF/Fun1.thy
    17.6      ID:         $Id$
    17.7      Author:     Franz Regensburger
    17.8      Copyright   1993  Technische Universitaet Muenchen
    17.9 @@ -14,14 +14,11 @@
   17.10  
   17.11  (* default class is still term *)
   17.12  
   17.13 -consts
   17.14 -  less_fun      :: "['a=>'b::po,'a=>'b] => bool"        
   17.15 -
   17.16  defs
   17.17     (* definition of the ordering less_fun            *)
   17.18     (* in fun1.ML it is proved that less_fun is a po *)
   17.19     
   17.20 -  less_fun_def "less_fun f1 f2 == ! x. f1(x) << f2(x)"  
   17.21 +  less_fun_def "less == (%f1 f2.!x. f1 x << f2 x)"  
   17.22  
   17.23  end
   17.24  
    18.1 --- a/src/HOLCF/Fun2.ML	Sat Feb 15 18:24:05 1997 +0100
    18.2 +++ b/src/HOLCF/Fun2.ML	Mon Feb 17 10:57:11 1997 +0100
    18.3 @@ -8,23 +8,38 @@
    18.4  
    18.5  open Fun2;
    18.6  
    18.7 +(* for compatibility with old HOLCF-Version *)
    18.8 +qed_goal "inst_fun_po" thy "(op <<)=(%f g.!x.f x << g x)"
    18.9 + (fn prems => 
   18.10 +        [
   18.11 +	(fold_goals_tac [po_def,less_fun_def]),
   18.12 +	(rtac refl 1)
   18.13 +        ]);
   18.14 +
   18.15  (* ------------------------------------------------------------------------ *)
   18.16  (* Type 'a::term => 'b::pcpo is pointed                                     *)
   18.17  (* ------------------------------------------------------------------------ *)
   18.18  
   18.19 -qed_goalw "minimal_fun"  Fun2.thy [UU_fun_def] "UU_fun << f"
   18.20 +qed_goal "minimal_fun" thy "(%z.UU) << x"
   18.21  (fn prems =>
   18.22          [
   18.23 -        (stac inst_fun_po 1),
   18.24 -        (rewtac less_fun_def),
   18.25 -        (fast_tac (HOL_cs addSIs [minimal]) 1)
   18.26 +        (simp_tac (!simpset addsimps [inst_fun_po,minimal]) 1)
   18.27 +        ]);
   18.28 +
   18.29 +bind_thm ("UU_fun_def",minimal_fun RS minimal2UU RS sym);
   18.30 +
   18.31 +qed_goal "least_fun" thy "? x::'a=>'b::pcpo.!y.x<<y"
   18.32 +(fn prems =>
   18.33 +        [
   18.34 +        (res_inst_tac [("x","(%z.UU)")] exI 1),
   18.35 +        (rtac (minimal_fun RS allI) 1)
   18.36          ]);
   18.37  
   18.38  (* ------------------------------------------------------------------------ *)
   18.39  (* make the symbol << accessible for type fun                               *)
   18.40  (* ------------------------------------------------------------------------ *)
   18.41  
   18.42 -qed_goal "less_fun"  Fun2.thy  "(f1 << f2) = (! x. f1(x) << f2(x))"
   18.43 +qed_goal "less_fun" thy "(f1 << f2) = (! x. f1(x) << f2(x))"
   18.44  (fn prems =>
   18.45          [
   18.46          (stac inst_fun_po 1),
   18.47 @@ -36,8 +51,8 @@
   18.48  (* chains of functions yield chains in the po range                         *)
   18.49  (* ------------------------------------------------------------------------ *)
   18.50  
   18.51 -qed_goal "ch2ch_fun"  Fun2.thy 
   18.52 -        "is_chain(S::nat=>('a::term => 'b::po)) ==> is_chain(% i.S(i)(x))"
   18.53 +qed_goal "ch2ch_fun" thy 
   18.54 +        "is_chain(S::nat=>('a=>'b::po)) ==> is_chain(% i.S(i)(x))"
   18.55  (fn prems =>
   18.56          [
   18.57          (cut_facts_tac prems 1),
   18.58 @@ -103,4 +118,3 @@
   18.59          (rtac exI 1),
   18.60          (etac lub_fun 1)
   18.61          ]);
   18.62 -
    19.1 --- a/src/HOLCF/Fun2.thy	Sat Feb 15 18:24:05 1997 +0100
    19.2 +++ b/src/HOLCF/Fun2.thy	Mon Feb 17 10:57:11 1997 +0100
    19.3 @@ -1,34 +1,16 @@
    19.4 -(*  Title:      HOLCF/fun2.thy
    19.5 +(*  Title:      HOLCF/Fun2.thy
    19.6      ID:         $Id$
    19.7      Author:     Franz Regensburger
    19.8      Copyright   1993 Technische Universitaet Muenchen
    19.9  
   19.10  Class Instance =>::(term,po)po
   19.11 -Definiton of least element
   19.12  *)
   19.13  
   19.14  Fun2 = Fun1 + 
   19.15  
   19.16  (* default class is still term !*)
   19.17  
   19.18 -(* Witness for the above arity axiom is fun1.ML *)
   19.19 -
   19.20 -arities fun :: (term,po)po
   19.21 -
   19.22 -consts  
   19.23 -        UU_fun  :: "'a::term => 'b::pcpo"
   19.24 -
   19.25 -rules
   19.26 -
   19.27 -(* instance of << for type ['a::term => 'b::po]  *)
   19.28 -
   19.29 -inst_fun_po     "((op <<)::['a=>'b::po,'a=>'b::po ]=>bool) = less_fun"
   19.30 -
   19.31 -defs
   19.32 -
   19.33 -(* The least element in type 'a::term => 'b::pcpo *)
   19.34 -
   19.35 -UU_fun_def      "UU_fun == (% x.UU)"
   19.36 +instance fun  :: (term,po)po (refl_less_fun,antisym_less_fun,trans_less_fun)
   19.37  
   19.38  end
   19.39  
    20.1 --- a/src/HOLCF/Fun3.ML	Sat Feb 15 18:24:05 1997 +0100
    20.2 +++ b/src/HOLCF/Fun3.ML	Mon Feb 17 10:57:11 1997 +0100
    20.3 @@ -5,3 +5,10 @@
    20.4  *)
    20.5  
    20.6  open Fun3;
    20.7 +
    20.8 +(* for compatibility with old HOLCF-Version *)
    20.9 +qed_goal "inst_fun_pcpo" thy "UU = (%x.UU)"
   20.10 + (fn prems => 
   20.11 +        [
   20.12 +        (simp_tac (HOL_ss addsimps [UU_def,UU_fun_def]) 1)
   20.13 +        ]);
    21.1 --- a/src/HOLCF/Fun3.thy	Sat Feb 15 18:24:05 1997 +0100
    21.2 +++ b/src/HOLCF/Fun3.thy	Mon Feb 17 10:57:11 1997 +0100
    21.3 @@ -1,4 +1,4 @@
    21.4 -(*  Title:      HOLCF/fun3.thy
    21.5 +(*  Title:      HOLCF/Fun3.thy
    21.6      ID:         $Id$
    21.7      Author:     Franz Regensburger
    21.8      Copyright   1993 Technische Universitaet Muenchen
    21.9 @@ -11,13 +11,7 @@
   21.10  
   21.11  (* default class is still term *)
   21.12  
   21.13 -arities fun  :: (term,pcpo)pcpo         (* Witness fun2.ML *)
   21.14 -
   21.15 -rules 
   21.16 -
   21.17 -inst_fun_pcpo   "(UU::'a=>'b::pcpo) = UU_fun"
   21.18 +instance fun  :: (term,pcpo)pcpo         (least_fun,cpo_fun)
   21.19  
   21.20  end
   21.21  
   21.22 -
   21.23 -
    22.1 --- a/src/HOLCF/HOLCF.thy	Sat Feb 15 18:24:05 1997 +0100
    22.2 +++ b/src/HOLCF/HOLCF.thy	Mon Feb 17 10:57:11 1997 +0100
    22.3 @@ -8,9 +8,5 @@
    22.4  
    22.5  *)
    22.6  
    22.7 -HOLCF = Lift3 +
    22.8 +HOLCF = One + Tr
    22.9  
   22.10 -default pcpo
   22.11 -
   22.12 -end
   22.13 -
    23.1 --- a/src/HOLCF/IsaMakefile	Sat Feb 15 18:24:05 1997 +0100
    23.2 +++ b/src/HOLCF/IsaMakefile	Mon Feb 17 10:57:11 1997 +0100
    23.3 @@ -8,16 +8,19 @@
    23.4  
    23.5  OUT = $(ISABELLE_OUTPUT_DIR)
    23.6  
    23.7 -THYS = Void.thy Porder.thy Pcpo.thy \
    23.8 +THYS = Porder.thy Porder0.thy Pcpo.thy \
    23.9         Fun1.thy Fun2.thy Fun3.thy \
   23.10         Cfun1.thy Cfun2.thy Cfun3.thy Cont.thy \
   23.11         Cprod1.thy Cprod2.thy Cprod3.thy \
   23.12         Sprod0.thy Sprod1.thy Sprod2.thy Sprod3.thy \
   23.13         Ssum0.thy Ssum1.thy Ssum2.thy Ssum3.thy \
   23.14 -       Up1.thy Up2.thy Up3.thy Fix.thy ccc1.thy One.thy \
   23.15 -       Tr1.thy Tr2.thy Lift1.thy Lift2.thy Lift2.thy HOLCF.thy
   23.16 +       Up1.thy Up2.thy Up3.thy Fix.thy ccc1.thy \
   23.17 +       One.thy Tr.thy\
   23.18 +       Lift1.thy Lift2.thy Lift3.thy HOLCF.thy 
   23.19  
   23.20 -FILES = ROOT.ML Porder0.thy  $(THYS) $(THYS:.thy=.ML)
   23.21 +ONLYTHYS = Lift.thy
   23.22 +
   23.23 +FILES = ROOT.ML $(THYS) $(ONLYTHYS) $(THYS:.thy=.ML)
   23.24  
   23.25  $(OUT)/HOLCF: $(OUT)/HOL $(FILES)
   23.26  	@$(ISABELLE) -e "make_html := $(ISABELLE_HTML);" -qu -c $(OUT)/HOL HOLCF
    24.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    24.2 +++ b/src/HOLCF/Lift.thy	Mon Feb 17 10:57:11 1997 +0100
    24.3 @@ -0,0 +1,16 @@
    24.4 +(*  Title:      HOLCF/Lift.thy
    24.5 +    ID:         $Id$
    24.6 +    Author:     Oscar Slotosch
    24.7 +    Copyright   1997 Technische Universitaet Muenchen
    24.8 +*)
    24.9 +
   24.10 +Lift = Lift3 + 
   24.11 +
   24.12 +instance lift :: (term)flat (ax_flat_lift)
   24.13 +
   24.14 +default pcpo
   24.15 +
   24.16 +end
   24.17 +
   24.18 +
   24.19 +
    25.1 --- a/src/HOLCF/Lift1.ML	Sat Feb 15 18:24:05 1997 +0100
    25.2 +++ b/src/HOLCF/Lift1.ML	Mon Feb 17 10:57:11 1997 +0100
    25.3 @@ -13,16 +13,18 @@
    25.4  (* less_lift is a partial order on type 'a -> 'b                            *)
    25.5  (* ------------------------------------------------------------------------ *)
    25.6  
    25.7 -goalw Lift1.thy [less_lift_def] "less_lift x x";
    25.8 +goalw thy [less_lift_def] "less (x::'a lift) x";
    25.9  by (fast_tac HOL_cs 1);
   25.10  qed"refl_less_lift";
   25.11  
   25.12 -goalw Lift1.thy [less_lift_def] 
   25.13 -  "less_lift x1 x2 & less_lift x2 x1 --> x1 = x2";
   25.14 +val prems = goalw thy [less_lift_def] 
   25.15 +  "[|less (x1::'a lift) x2; less x2 x1|] ==> x1 = x2";
   25.16 +by (cut_facts_tac prems 1);
   25.17  by (fast_tac HOL_cs 1);
   25.18  qed"antisym_less_lift";
   25.19  
   25.20 -goalw Lift1.thy [less_lift_def] 
   25.21 -  "less_lift x1 x2 & less_lift x2 x3 --> less_lift x1 x3";
   25.22 +val prems = goalw Lift1.thy [less_lift_def] 
   25.23 +  "[|less (x1::'a lift) x2; less x2 x3|] ==> less x1 x3";
   25.24 +by (cut_facts_tac prems 1);
   25.25  by (fast_tac HOL_cs 1);
   25.26  qed"trans_less_lift";
    26.1 --- a/src/HOLCF/Lift1.thy	Sat Feb 15 18:24:05 1997 +0100
    26.2 +++ b/src/HOLCF/Lift1.thy	Mon Feb 17 10:57:11 1997 +0100
    26.3 @@ -6,21 +6,14 @@
    26.4  Lifting types of class term to flat pcpo's
    26.5  *)
    26.6  
    26.7 -Lift1 = Tr2 + 
    26.8 +Lift1 = ccc1 + 
    26.9  
   26.10  default term
   26.11  
   26.12  datatype 'a lift = Undef | Def 'a
   26.13  
   26.14 -arities "lift" :: (term)term
   26.15 -
   26.16 -consts less_lift    :: "['a lift, 'a lift] => bool"
   26.17 -       UU_lift      :: "'a lift"
   26.18 -
   26.19  defs 
   26.20   
   26.21 - less_lift_def  "less_lift x y == (x=y | x=Undef)"
   26.22 -
   26.23 + less_lift_def  "less x y == (x=y | x=Undef)"
   26.24  
   26.25  end
   26.26 -
    27.1 --- a/src/HOLCF/Lift2.ML	Sat Feb 15 18:24:05 1997 +0100
    27.2 +++ b/src/HOLCF/Lift2.ML	Mon Feb 17 10:57:11 1997 +0100
    27.3 @@ -6,20 +6,32 @@
    27.4  Theorems for Lift2.thy
    27.5  *)
    27.6  
    27.7 +open Lift2;
    27.8  
    27.9 -open Lift2;
   27.10 -Addsimps [less_lift_def];
   27.11 -
   27.12 +(* for compatibility with old HOLCF-Version *)
   27.13 +qed_goal "inst_lift_po" thy "(op <<)=(%x y.x=y|x=Undef)"
   27.14 + (fn prems => 
   27.15 +        [
   27.16 +        (fold_goals_tac [po_def,less_lift_def]),
   27.17 +        (rtac refl 1)
   27.18 +        ]);
   27.19  
   27.20  (* -------------------------------------------------------------------------*)
   27.21  (* type ('a)lift is pointed                                                *)
   27.22  (* ------------------------------------------------------------------------ *)
   27.23 - 
   27.24  
   27.25  goal Lift2.thy  "Undef << x";
   27.26  by (simp_tac (!simpset addsimps [inst_lift_po]) 1);
   27.27  qed"minimal_lift";
   27.28  
   27.29 +bind_thm ("UU_lift_def",minimal_lift RS minimal2UU RS sym);
   27.30 +
   27.31 +qed_goal "least_lift" thy "? x::'a lift.!y.x<<y"
   27.32 +(fn prems =>
   27.33 +        [
   27.34 +        (res_inst_tac [("x","Undef")] exI 1),
   27.35 +        (rtac (minimal_lift RS allI) 1)
   27.36 +        ]);
   27.37  
   27.38  (* ------------------------------------------------------------------------ *)
   27.39  (* ('a)lift is a cpo                                                       *)
    28.1 --- a/src/HOLCF/Lift2.thy	Sat Feb 15 18:24:05 1997 +0100
    28.2 +++ b/src/HOLCF/Lift2.thy	Mon Feb 17 10:57:11 1997 +0100
    28.3 @@ -8,13 +8,8 @@
    28.4  
    28.5  Lift2 = Lift1 + 
    28.6  
    28.7 -default term
    28.8 -
    28.9 -arities "lift" :: (term)po
   28.10 -
   28.11 -rules
   28.12 -
   28.13 - inst_lift_po   "((op <<)::['a lift,'a lift]=>bool) = less_lift"
   28.14 +instance "lift" :: (term)po (refl_less_lift,antisym_less_lift,trans_less_lift)
   28.15  
   28.16  end
   28.17  
   28.18 +
    29.1 --- a/src/HOLCF/Lift3.ML	Sat Feb 15 18:24:05 1997 +0100
    29.2 +++ b/src/HOLCF/Lift3.ML	Mon Feb 17 10:57:11 1997 +0100
    29.3 @@ -9,6 +9,13 @@
    29.4  
    29.5  open Lift3;
    29.6  
    29.7 +(* for compatibility with old HOLCF-Version *)
    29.8 +qed_goal "inst_lift_pcpo" thy "UU = Undef"
    29.9 + (fn prems => 
   29.10 +        [
   29.11 +        (simp_tac (HOL_ss addsimps [UU_def,UU_lift_def]) 1)
   29.12 +        ]);
   29.13 +
   29.14  (* ----------------------------------------------------------- *)
   29.15  (*                        From Undef to UU		       *)
   29.16  (* ----------------------------------------------------------- *)
   29.17 @@ -117,8 +124,6 @@
   29.18  by (fast_tac (HOL_cs addSDs [DefE]) 1);
   29.19  val DefE2 = result();
   29.20  
   29.21 -
   29.22 -
   29.23  (* ---------------------------------------------------------- *)
   29.24  (*                          Lift is flat                     *)
   29.25  (* ---------------------------------------------------------- *)
   29.26 @@ -127,7 +132,7 @@
   29.27  by (simp_tac (!simpset addsimps [less_lift]) 1);
   29.28  val flat_lift = result();
   29.29  
   29.30 -
   29.31 +bind_thm("ax_flat_lift",flat_lift RS flatE);
   29.32  
   29.33  
   29.34  (* ---------------------------------------------------------- *)
   29.35 @@ -237,89 +242,4 @@
   29.36  fun cont_tacR i = simp_tac (!simpset addsimps [flift1_def,flift2_def]) i THEN
   29.37  		  REPEAT (cont_tac i);
   29.38  
   29.39 -(* --------------------------------------------------------- *)
   29.40 -(*                Admissibility tactic and tricks            *)
   29.41 -(* --------------------------------------------------------- *)
   29.42 -
   29.43 -
   29.44 -goal Lift3.thy "x~=FF = (x=TT|x=UU)";
   29.45 -by (res_inst_tac [("p","x")] trE 1);
   29.46 -  by (TRYALL (Asm_full_simp_tac));
   29.47 -qed"adm_trick_1";
   29.48 -
   29.49 -goal Lift3.thy "x~=TT = (x=FF|x=UU)";
   29.50 -by (res_inst_tac [("p","x")] trE 1);
   29.51 -  by (TRYALL (Asm_full_simp_tac));
   29.52 -qed"adm_trick_2";
   29.53 -
   29.54 -
   29.55 -val adm_tricks = [adm_trick_1,adm_trick_2];
   29.56 -
   29.57 -(*val adm_tac = (fn i => ((resolve_tac adm_lemmas i)));*)
   29.58 -(*val adm_tacR = (fn i => (REPEAT (adm_tac i)));*)
   29.59 -(*val adm_cont_tac = (fn i => ((adm_tacR i) THEN (cont_tacR i)));*)
   29.60 -
   29.61 -(* ----------------------------------------------------------------- *)
   29.62 -(*     Relations between domains and terms using lift constructs     *)
   29.63 -(* ----------------------------------------------------------------- *)
   29.64 -
   29.65 -goal Lift3.thy
   29.66 -"!!t.[|t~=UU|]==> ((t andalso s)~=FF)=(t~=FF & s~=FF)";
   29.67 -by (rtac iffI 1);
   29.68 -(* 1 *)
   29.69 -by (res_inst_tac [("p","t")] trE 1);
   29.70 -by (fast_tac HOL_cs 1);
   29.71 -by (res_inst_tac [("p","s")] trE 1);
   29.72 -by (Asm_full_simp_tac 1);
   29.73 -by (Asm_full_simp_tac 1);
   29.74 -by (subgoal_tac "(t andalso s) = FF" 1);
   29.75 -by (fast_tac HOL_cs 1);
   29.76 -by (Asm_full_simp_tac 1);
   29.77 -by (res_inst_tac [("p","s")] trE 1);
   29.78 -by (subgoal_tac "(t andalso s) = FF" 1);
   29.79 -by (fast_tac HOL_cs 1);
   29.80 -by (Asm_full_simp_tac 1);
   29.81 -by (subgoal_tac "(t andalso s) = FF" 1);
   29.82 -by (fast_tac HOL_cs 1);
   29.83 -by (Asm_full_simp_tac 1);
   29.84 -by (subgoal_tac "(t andalso s) = FF" 1);
   29.85 -by (fast_tac HOL_cs 1);
   29.86 -by (Asm_full_simp_tac 1);
   29.87 -(* 2*)
   29.88 -by (res_inst_tac [("p","t")] trE 1);
   29.89 -by (fast_tac HOL_cs 1);
   29.90 -by (Asm_full_simp_tac 1);
   29.91 -by (fast_tac HOL_cs 1);
   29.92 -qed"andalso_and";
   29.93 -
   29.94 -
   29.95 -goal Lift3.thy "blift x ~=UU";
   29.96 -by (simp_tac (!simpset addsimps [blift_def])1);
   29.97 -by (case_tac "x" 1);
   29.98 - by (Asm_full_simp_tac 1);
   29.99 -by (Asm_full_simp_tac 1);
  29.100 -qed"blift_not_UU";
  29.101 -
  29.102 -goal Lift3.thy "(blift x ~=FF)= x";
  29.103 -by (simp_tac (!simpset addsimps [blift_def]) 1);
  29.104 -by (case_tac "x" 1); 
  29.105 - by (Asm_full_simp_tac 1);
  29.106 -by (Asm_full_simp_tac 1);
  29.107 -qed"blift_and_bool";
  29.108 -
  29.109 -goal Lift3.thy "plift P`(Def y) = blift (P y)";
  29.110 -by (simp_tac (!simpset addsimps [plift_def,flift1_def]) 1);
  29.111 -qed"plift2blift";
  29.112 -
  29.113 -goal Lift3.thy 
  29.114 -  "(If blift P then A else B fi)= (if P then A else B)";
  29.115 -by (simp_tac (!simpset addsimps [blift_def]) 1);
  29.116 -by (res_inst_tac [("P","P"),("Q","P")] impCE 1);
  29.117 -by (fast_tac HOL_cs 1);
  29.118 -by (REPEAT (Asm_full_simp_tac 1));
  29.119 -qed"If_and_if";
  29.120 -
  29.121 -
  29.122 -Addsimps [plift2blift,If_and_if,blift_not_UU,blift_and_bool];
  29.123 -
  29.124 -simpset := !simpset addsolver (K (DEPTH_SOLVE_1 o cont_tac));
  29.125 \ No newline at end of file
  29.126 +simpset := !simpset addsolver (K (DEPTH_SOLVE_1 o cont_tac));
    30.1 --- a/src/HOLCF/Lift3.thy	Sat Feb 15 18:24:05 1997 +0100
    30.2 +++ b/src/HOLCF/Lift3.thy	Mon Feb 17 10:57:11 1997 +0100
    30.3 @@ -8,40 +8,24 @@
    30.4  
    30.5  Lift3 = Lift2 + 
    30.6  
    30.7 -default term
    30.8 -
    30.9 -arities 
   30.10 - "lift" :: (term)pcpo
   30.11 +instance lift :: (term)pcpo (cpo_lift,least_lift)
   30.12  
   30.13  consts 
   30.14   flift1      :: "('a => 'b::pcpo) => ('a lift -> 'b)"
   30.15 - blift        :: "bool => tr"  
   30.16 - plift        :: "('a => bool) => 'a lift -> tr"   
   30.17   flift2      :: "('a => 'b) => ('a lift -> 'b lift)"
   30.18  
   30.19  translations
   30.20   "UU" <= "Undef"
   30.21  
   30.22  defs
   30.23 - blift_def
   30.24 -  "blift b == (if b then TT else FF)"
   30.25 -
   30.26   flift1_def
   30.27    "flift1 f  == (LAM x. (case x of 
   30.28                     Undef => UU
   30.29                   | Def y => (f y)))"
   30.30 -
   30.31   flift2_def
   30.32    "flift2 f == (LAM x. (case x of 
   30.33                                Undef => Undef
   30.34                              | Def y => Def (f y)))"
   30.35  
   30.36 - plift_def
   30.37 -  "plift p == (LAM x. flift1 (%a. blift (p a))`x)"
   30.38 -
   30.39 -
   30.40 -rules
   30.41 - inst_lift_pcpo "(UU::'a lift) = Undef"
   30.42 -
   30.43  end
   30.44  
    31.1 --- a/src/HOLCF/Makefile	Sat Feb 15 18:24:05 1997 +0100
    31.2 +++ b/src/HOLCF/Makefile	Mon Feb 17 10:57:11 1997 +0100
    31.3 @@ -21,16 +21,19 @@
    31.4  
    31.5  BIN = $(ISABELLEBIN)
    31.6  COMP = $(ISABELLECOMP)
    31.7 -THYS = Void.thy Porder.thy Pcpo.thy \
    31.8 +THYS = Porder.thy Porder0.thy Pcpo.thy \
    31.9         Fun1.thy Fun2.thy Fun3.thy \
   31.10         Cfun1.thy Cfun2.thy Cfun3.thy Cont.thy \
   31.11         Cprod1.thy Cprod2.thy Cprod3.thy \
   31.12         Sprod0.thy Sprod1.thy Sprod2.thy Sprod3.thy \
   31.13         Ssum0.thy Ssum1.thy Ssum2.thy Ssum3.thy \
   31.14 -       Up1.thy Up2.thy Up3.thy Fix.thy ccc1.thy One.thy \
   31.15 -       Tr1.thy Tr2.thy Lift1.thy Lift2.thy Lift2.thy HOLCF.thy 
   31.16 +       Up1.thy Up2.thy Up3.thy Fix.thy ccc1.thy \
   31.17 +       One.thy Tr.thy \
   31.18 +       Lift1.thy Lift2.thy Lift3.thy HOLCF.thy 
   31.19  
   31.20 -FILES = ROOT.ML Porder0.thy  $(THYS) $(THYS:.thy=.ML)
   31.21 +ONLYTHYS = Lift.thy
   31.22 +
   31.23 +FILES = ROOT.ML $(THYS) $(ONLYTHYS) $(THYS:.thy=.ML)
   31.24  
   31.25  #Uses cp rather than make_database because Poly/ML allows only 3 levels
   31.26  $(BIN)/HOLCF:	$(BIN)/HOL  $(FILES) 
    32.1 --- a/src/HOLCF/One.ML	Sat Feb 15 18:24:05 1997 +0100
    32.2 +++ b/src/HOLCF/One.ML	Mon Feb 17 10:57:11 1997 +0100
    32.3 @@ -1,9 +1,9 @@
    32.4  (*  Title:      HOLCF/One.ML
    32.5      ID:         $Id$
    32.6 -    Author:     Franz Regensburger
    32.7 -    Copyright   1993 Technische Universitaet Muenchen
    32.8 +    Author:     Oscar Slotosch
    32.9 +    Copyright   1997 Technische Universitaet Muenchen
   32.10  
   32.11 -Lemmas for One.thy 
   32.12 +Lemmas for One.thy
   32.13  *)
   32.14  
   32.15  open One;
   32.16 @@ -12,24 +12,17 @@
   32.17  (* Exhaustion and Elimination for type one                                  *)
   32.18  (* ------------------------------------------------------------------------ *)
   32.19  
   32.20 -qed_goalw "Exh_one" One.thy [one_def] "z=UU | z = one"
   32.21 +qed_goalw "Exh_one" thy [ONE_def] "t=UU | t = ONE"
   32.22   (fn prems =>
   32.23          [
   32.24 -        (res_inst_tac [("p","rep_one`z")] upE1 1),
   32.25 -        (rtac disjI1 1),
   32.26 -        (rtac ((abs_one_iso RS allI) RS ((rep_one_iso RS allI) RS iso_strict )
   32.27 -                RS conjunct2 RS subst) 1),
   32.28 -        (rtac (abs_one_iso RS subst) 1),
   32.29 -        (etac cfun_arg_cong 1),
   32.30 -        (rtac disjI2 1),
   32.31 -        (rtac (abs_one_iso RS subst) 1),
   32.32 -        (rtac cfun_arg_cong 1),
   32.33 -        (rtac (unique_void2 RS subst) 1),
   32.34 -        (atac 1)
   32.35 -        ]);
   32.36 +	(lift.induct_tac "t" 1),
   32.37 +	(fast_tac HOL_cs 1),
   32.38 +	(Simp_tac 1),
   32.39 +	(rtac unit_eq 1)
   32.40 +	]);
   32.41  
   32.42 -qed_goal "oneE" One.thy
   32.43 -        "[| p=UU ==> Q; p = one ==>Q|] ==>Q"
   32.44 +qed_goal "oneE" thy
   32.45 +        "[| p=UU ==> Q; p = ONE ==>Q|] ==>Q"
   32.46   (fn prems =>
   32.47          [
   32.48          (rtac (Exh_one RS disjE) 1),
   32.49 @@ -37,53 +30,22 @@
   32.50          (eresolve_tac prems 1)
   32.51          ]);
   32.52  
   32.53 +(* ------------------------------------------------------------------------ *) 
   32.54 +(* tactic for one-thms                                                      *)
   32.55 +(* ------------------------------------------------------------------------ *)
   32.56 +
   32.57 +fun prover t = prove_goalw thy [ONE_def] t
   32.58 + (fn prems =>
   32.59 +        [
   32.60 +	(asm_simp_tac (!simpset addsimps [inst_lift_po]) 1)
   32.61 +	]);
   32.62 +
   32.63  (* ------------------------------------------------------------------------ *)
   32.64  (* distinctness for type one : stored in a list                             *)
   32.65  (* ------------------------------------------------------------------------ *)
   32.66  
   32.67 -qed_goalw "dist_less_one" One.thy [one_def] "~one << UU" (fn prems => [
   32.68 -        (rtac classical2 1),
   32.69 -        (rtac less_up4b 1),
   32.70 -        (rtac (rep_one_iso RS subst) 1),
   32.71 -        (rtac (rep_one_iso RS subst) 1),
   32.72 -        (rtac monofun_cfun_arg 1),
   32.73 -        (etac ((abs_one_iso RS allI) RS ((rep_one_iso RS allI) RS iso_strict ) 
   32.74 -                RS conjunct2 RS ssubst) 1)]);
   32.75 -
   32.76 -qed_goal "dist_eq_one" One.thy "one~=UU" (fn prems => [
   32.77 -        (rtac not_less2not_eq 1),
   32.78 -        (rtac dist_less_one 1)]);
   32.79 -
   32.80 -(* ------------------------------------------------------------------------ *)
   32.81 -(* one is flat                                                              *)
   32.82 -(* ------------------------------------------------------------------------ *)
   32.83 +val dist_less_one = map prover ["~ONE << UU"];
   32.84  
   32.85 -qed_goalw "flat_one" One.thy [flat_def] "flat one"
   32.86 - (fn prems =>
   32.87 -        [
   32.88 -        (rtac allI 1),
   32.89 -        (rtac allI 1),
   32.90 -        (res_inst_tac [("p","x")] oneE 1),
   32.91 -        (Asm_simp_tac 1),
   32.92 -        (res_inst_tac [("p","y")] oneE 1),
   32.93 -        (asm_simp_tac (!simpset addsimps [dist_less_one]) 1),
   32.94 -        (Asm_simp_tac 1)
   32.95 -        ]);
   32.96 -
   32.97 +val dist_eq_one = map prover ["ONE~=UU","UU~=ONE"];
   32.98  
   32.99 -(* ------------------------------------------------------------------------ *)
  32.100 -(* properties of one_when                                                   *)
  32.101 -(* here I tried a generic prove procedure                                   *)
  32.102 -(* ------------------------------------------------------------------------ *)
  32.103 -
  32.104 -fun prover s =  prove_goalw One.thy [one_when_def,one_def] s
  32.105 - (fn prems =>
  32.106 -        [
  32.107 -        (simp_tac (!simpset addsimps [(rep_one_iso ),
  32.108 -        (abs_one_iso RS allI) RS ((rep_one_iso RS allI) 
  32.109 -        RS iso_strict) RS conjunct1] )1)
  32.110 -        ]);
  32.111 -
  32.112 -val one_when = map prover ["one_when`x`UU = UU","one_when`x`one = x"];
  32.113 -
  32.114 -Addsimps (dist_less_one::dist_eq_one::one_when);
  32.115 +Addsimps (dist_less_one@dist_eq_one);
    33.1 --- a/src/HOLCF/One.thy	Sat Feb 15 18:24:05 1997 +0100
    33.2 +++ b/src/HOLCF/One.thy	Mon Feb 17 10:57:11 1997 +0100
    33.3 @@ -1,47 +1,21 @@
    33.4 -(*  Title:      HOLCF/one.thy
    33.5 +(*  Title:      HOLCF/One.thy
    33.6      ID:         $Id$
    33.7 -    Author:     Franz Regensburger
    33.8 -    Copyright   1993 Technische Universitaet Muenchen
    33.9 -
   33.10 -Introduce atomic type one = (void)u
   33.11 -
   33.12 -The type is axiomatized as the least solution of a domain equation.
   33.13 -The functor term that specifies the domain equation is: 
   33.14 -
   33.15 -  FT = <U,K_{void}>
   33.16 -
   33.17 -For details see chapter 5 of:
   33.18 -
   33.19 -[Franz Regensburger] HOLCF: Eine konservative Erweiterung von HOL um LCF,
   33.20 -                     Dissertation, Technische Universit"at M"unchen, 1994
   33.21 -
   33.22 +    Author:     Oscar Slotosch
   33.23 +    Copyright   1997 Technische Universitaet Muenchen
   33.24  *)
   33.25  
   33.26 -One = ccc1+
   33.27 +One = Lift +
   33.28  
   33.29 -types one 0
   33.30 -arities one :: pcpo
   33.31 +types one = "unit lift"
   33.32  
   33.33  consts
   33.34 -        abs_one         :: "(void)u -> one"
   33.35 -        rep_one         :: "one -> (void)u"
   33.36 -        one             :: "one"
   33.37 -        one_when        :: "'c -> one -> 'c"
   33.38 +	ONE             :: "one"
   33.39 +
   33.40 +translations
   33.41 +	     "one" == (type) "unit lift" 
   33.42  
   33.43  rules
   33.44 -  abs_one_iso   "abs_one`(rep_one`u) = u"
   33.45 -  rep_one_iso   "rep_one`(abs_one`x) = x"
   33.46 -
   33.47 -defs
   33.48 -  one_def       "one == abs_one`(up`UU)"
   33.49 -  one_when_def "one_when == (LAM c u.fup`(LAM x.c)`(rep_one`u))"
   33.50 -
   33.51 -translations
   33.52 -  "case l of one => t1" == "one_when`t1`l"
   33.53 -
   33.54 +  ONE_def     "ONE == Def()"
   33.55  end
   33.56  
   33.57  
   33.58 -
   33.59 -
   33.60 -
    34.1 --- a/src/HOLCF/Pcpo.ML	Sat Feb 15 18:24:05 1997 +0100
    34.2 +++ b/src/HOLCF/Pcpo.ML	Mon Feb 17 10:57:11 1997 +0100
    34.3 @@ -8,11 +8,23 @@
    34.4   
    34.5  open Pcpo;
    34.6  
    34.7 +
    34.8 +(* ------------------------------------------------------------------------ *)
    34.9 +(* derive the old rule minimal                                              *)
   34.10 +(* ------------------------------------------------------------------------ *)
   34.11 +
   34.12 +qed_goalw "UU_least" thy [ UU_def ] "!z.UU << z"
   34.13 +(fn prems => [ 
   34.14 +        (rtac (select_eq_Ex RS iffD2) 1),
   34.15 +        (rtac least 1)]);
   34.16 +
   34.17 +bind_thm("minimal",UU_least RS spec);
   34.18 +
   34.19  (* ------------------------------------------------------------------------ *)
   34.20  (* in pcpo's everthing equal to THE lub has lub properties for every chain  *)
   34.21  (* ------------------------------------------------------------------------ *)
   34.22  
   34.23 -qed_goal "thelubE"  Pcpo.thy 
   34.24 +qed_goal "thelubE"  thy 
   34.25          "[| is_chain(S);lub(range(S)) = (l::'a::pcpo)|] ==> range(S) <<| l "
   34.26  (fn prems =>
   34.27          [
   34.28 @@ -33,7 +45,7 @@
   34.29  bind_thm ("is_lub_thelub", cpo RS lubI RS is_lub_lub);
   34.30  (* [| is_chain(?S5); range(?S5) <| ?x1 |] ==> lub(range(?S5)) << ?x1        *)
   34.31  
   34.32 -qed_goal "maxinch_is_thelub" Pcpo.thy "is_chain Y ==> \
   34.33 +qed_goal "maxinch_is_thelub" thy "is_chain Y ==> \
   34.34  \       max_in_chain i Y = (lub(range(Y)) = ((Y i)::'a::pcpo))" 
   34.35  (fn prems => 
   34.36          [
   34.37 @@ -52,7 +64,7 @@
   34.38  (* the << relation between two chains is preserved by their lubs            *)
   34.39  (* ------------------------------------------------------------------------ *)
   34.40  
   34.41 -qed_goal "lub_mono" Pcpo.thy 
   34.42 +qed_goal "lub_mono" thy 
   34.43          "[|is_chain(C1::(nat=>'a::pcpo));is_chain(C2); ! k. C1(k) << C2(k)|]\
   34.44  \           ==> lub(range(C1)) << lub(range(C2))"
   34.45  (fn prems =>
   34.46 @@ -70,7 +82,7 @@
   34.47  (* the = relation between two chains is preserved by their lubs            *)
   34.48  (* ------------------------------------------------------------------------ *)
   34.49  
   34.50 -qed_goal "lub_equal" Pcpo.thy
   34.51 +qed_goal "lub_equal" thy
   34.52  "[| is_chain(C1::(nat=>'a::pcpo));is_chain(C2);!k.C1(k)=C2(k)|]\
   34.53  \       ==> lub(range(C1))=lub(range(C2))"
   34.54  (fn prems =>
   34.55 @@ -95,7 +107,7 @@
   34.56  (* more results about mono and = of lubs of chains                          *)
   34.57  (* ------------------------------------------------------------------------ *)
   34.58  
   34.59 -qed_goal "lub_mono2" Pcpo.thy 
   34.60 +qed_goal "lub_mono2" thy 
   34.61  "[|? j.!i. j<i --> X(i::nat)=Y(i);is_chain(X::nat=>'a::pcpo);is_chain(Y)|]\
   34.62  \ ==> lub(range(X))<<lub(range(Y))"
   34.63   (fn prems =>
   34.64 @@ -124,7 +136,7 @@
   34.65          (resolve_tac prems 1)
   34.66          ]);
   34.67  
   34.68 -qed_goal "lub_equal2" Pcpo.thy 
   34.69 +qed_goal "lub_equal2" thy 
   34.70  "[|? j.!i. j<i --> X(i)=Y(i);is_chain(X::nat=>'a::pcpo);is_chain(Y)|]\
   34.71  \ ==> lub(range(X))=lub(range(Y))"
   34.72   (fn prems =>
   34.73 @@ -141,7 +153,7 @@
   34.74          (fast_tac HOL_cs 1)
   34.75          ]);
   34.76  
   34.77 -qed_goal "lub_mono3" Pcpo.thy "[|is_chain(Y::nat=>'a::pcpo);is_chain(X);\
   34.78 +qed_goal "lub_mono3" thy "[|is_chain(Y::nat=>'a::pcpo);is_chain(X);\
   34.79  \! i. ? j. Y(i)<< X(j)|]==> lub(range(Y))<<lub(range(X))"
   34.80   (fn prems =>
   34.81          [
   34.82 @@ -162,10 +174,10 @@
   34.83  (* usefull lemmas about UU                                                  *)
   34.84  (* ------------------------------------------------------------------------ *)
   34.85  
   34.86 -val eq_UU_sym = prove_goal Pcpo.thy "(UU = x) = (x = UU)" (fn _ => [
   34.87 +val eq_UU_sym = prove_goal thy "(UU = x) = (x = UU)" (fn _ => [
   34.88          fast_tac HOL_cs 1]);
   34.89  
   34.90 -qed_goal "eq_UU_iff" Pcpo.thy "(x=UU)=(x<<UU)"
   34.91 +qed_goal "eq_UU_iff" thy "(x=UU)=(x<<UU)"
   34.92   (fn prems =>
   34.93          [
   34.94          (rtac iffI 1),
   34.95 @@ -176,14 +188,14 @@
   34.96          (rtac minimal 1)
   34.97          ]);
   34.98  
   34.99 -qed_goal "UU_I" Pcpo.thy "x << UU ==> x = UU"
  34.100 +qed_goal "UU_I" thy "x << UU ==> x = UU"
  34.101   (fn prems =>
  34.102          [
  34.103          (stac eq_UU_iff 1),
  34.104          (resolve_tac prems 1)
  34.105          ]);
  34.106  
  34.107 -qed_goal "not_less2not_eq" Pcpo.thy "~x<<y ==> ~x=y"
  34.108 +qed_goal "not_less2not_eq" thy "~x<<y ==> ~x=y"
  34.109   (fn prems =>
  34.110          [
  34.111          (cut_facts_tac prems 1),
  34.112 @@ -193,7 +205,7 @@
  34.113          (rtac refl_less 1)
  34.114          ]);
  34.115  
  34.116 -qed_goal "chain_UU_I" Pcpo.thy
  34.117 +qed_goal "chain_UU_I" thy
  34.118          "[|is_chain(Y);lub(range(Y))=UU|] ==> ! i.Y(i)=UU"
  34.119   (fn prems =>
  34.120          [
  34.121 @@ -206,7 +218,7 @@
  34.122          ]);
  34.123  
  34.124  
  34.125 -qed_goal "chain_UU_I_inverse" Pcpo.thy 
  34.126 +qed_goal "chain_UU_I_inverse" thy 
  34.127          "!i.Y(i::nat)=UU ==> lub(range(Y::(nat=>'a::pcpo)))=UU"
  34.128   (fn prems =>
  34.129          [
  34.130 @@ -219,7 +231,7 @@
  34.131          (etac spec 1)
  34.132          ]);
  34.133  
  34.134 -qed_goal "chain_UU_I_inverse2" Pcpo.thy 
  34.135 +qed_goal "chain_UU_I_inverse2" thy 
  34.136          "~lub(range(Y::(nat=>'a::pcpo)))=UU ==> ? i.~ Y(i)=UU"
  34.137   (fn prems =>
  34.138          [
  34.139 @@ -232,7 +244,7 @@
  34.140          ]);
  34.141  
  34.142  
  34.143 -qed_goal "notUU_I" Pcpo.thy "[| x<<y; ~x=UU |] ==> ~y=UU"
  34.144 +qed_goal "notUU_I" thy "[| x<<y; ~x=UU |] ==> ~y=UU"
  34.145  (fn prems =>
  34.146          [
  34.147          (cut_facts_tac prems 1),
  34.148 @@ -243,7 +255,7 @@
  34.149          ]);
  34.150  
  34.151  
  34.152 -qed_goal "chain_mono2" Pcpo.thy 
  34.153 +qed_goal "chain_mono2" thy 
  34.154  "[|? j.~Y(j)=UU;is_chain(Y::nat=>'a::pcpo)|]\
  34.155  \ ==> ? j.!i.j<i-->~Y(i)=UU"
  34.156   (fn prems =>
  34.157 @@ -257,25 +269,3 @@
  34.158          (etac (chain_mono RS mp) 1),
  34.159          (atac 1)
  34.160          ]);
  34.161 -
  34.162 -
  34.163 -
  34.164 -
  34.165 -(* ------------------------------------------------------------------------ *)
  34.166 -(* uniqueness in void                                                       *)
  34.167 -(* ------------------------------------------------------------------------ *)
  34.168 -
  34.169 -qed_goal "unique_void2" Pcpo.thy "(x::void)=UU"
  34.170 - (fn prems =>
  34.171 -        [
  34.172 -        (stac inst_void_pcpo 1),
  34.173 -        (rtac (Rep_Void_inverse RS subst) 1),
  34.174 -        (rtac (Rep_Void_inverse RS subst) 1),
  34.175 -        (rtac arg_cong 1),
  34.176 -        (rtac box_equals 1),
  34.177 -        (rtac refl 1),
  34.178 -        (rtac (unique_void RS sym) 1),
  34.179 -        (rtac (unique_void RS sym) 1)
  34.180 -        ]);
  34.181 -
  34.182 -
    35.1 --- a/src/HOLCF/Pcpo.thy	Sat Feb 15 18:24:05 1997 +0100
    35.2 +++ b/src/HOLCF/Pcpo.thy	Mon Feb 17 10:57:11 1997 +0100
    35.3 @@ -1,22 +1,31 @@
    35.4 +(*  Title:      HOLCF/Pcpo.thy
    35.5 +    ID:         $Id$
    35.6 +    Author:     Franz Regensburger
    35.7 +    Copyright   1993 Technische Universitaet Muenchen
    35.8 +
    35.9 +introduction of the classes cpo and pcpo 
   35.10 +*)
   35.11  Pcpo = Porder +
   35.12  
   35.13 -classes pcpo < po
   35.14 +(* The class cpo of chain complete partial orders *)
   35.15 +(* ********************************************** *)
   35.16 +axclass cpo < po
   35.17 +        (* class axiom: *)
   35.18 +  cpo   "is_chain S ==> ? x. range(S) <<| (x::'a::po)" 
   35.19  
   35.20 -arities void :: pcpo
   35.21 +(* The class pcpo of pointed cpos *)
   35.22 +(* ****************************** *)
   35.23 +axclass pcpo < cpo
   35.24 +
   35.25 +  least         "? x.!y.x<<y"
   35.26  
   35.27  consts
   35.28 -
   35.29 -  UU		:: "'a::pcpo"        
   35.30 +  UU            :: "'a::pcpo"        
   35.31  
   35.32  syntax (symbols)
   35.33 -
   35.34 -  UU		:: "'a::pcpo"				("\\<bottom>")
   35.35 -
   35.36 -rules
   35.37 +  UU            :: "'a::pcpo"                           ("\\<bottom>")
   35.38  
   35.39 -  minimal	"UU << x"       
   35.40 -  cpo		"is_chain S ==> ? x. range(S) <<| (x::'a::pcpo)" 
   35.41 -
   35.42 -inst_void_pcpo  "(UU::void) = UU_void"
   35.43 +defs
   35.44 +  UU_def        "UU == @x.!y.x<<y"       
   35.45  
   35.46  end 
    36.1 --- a/src/HOLCF/Porder.ML	Sat Feb 15 18:24:05 1997 +0100
    36.2 +++ b/src/HOLCF/Porder.ML	Mon Feb 17 10:57:11 1997 +0100
    36.3 @@ -1,20 +1,18 @@
    36.4 -(*  Title:      HOLCF/porder.thy
    36.5 +(*  Title:      HOLCF/Porder.thy
    36.6      ID:         $Id$
    36.7      Author:     Franz Regensburger
    36.8      Copyright   1993 Technische Universitaet Muenchen
    36.9  
   36.10 -Lemmas for theory porder.thy 
   36.11 +Lemmas for theory Porder.thy 
   36.12  *)
   36.13  
   36.14 -open Porder0;
   36.15  open Porder;
   36.16  
   36.17 -
   36.18  (* ------------------------------------------------------------------------ *)
   36.19  (* the reverse law of anti--symmetrie of <<                                 *)
   36.20  (* ------------------------------------------------------------------------ *)
   36.21  
   36.22 -qed_goal "antisym_less_inverse" Porder.thy "x=y ==> x << y & y << x"
   36.23 +qed_goal "antisym_less_inverse" thy "x=y ==> x << y & y << x"
   36.24  (fn prems =>
   36.25          [
   36.26          (cut_facts_tac prems 1),
   36.27 @@ -24,7 +22,7 @@
   36.28          ]);
   36.29  
   36.30  
   36.31 -qed_goal "box_less" Porder.thy 
   36.32 +qed_goal "box_less" thy 
   36.33  "[| a << b; c << a; b << d|] ==> c << d"
   36.34   (fn prems =>
   36.35          [
   36.36 @@ -38,7 +36,7 @@
   36.37  (* lubs are unique                                                          *)
   36.38  (* ------------------------------------------------------------------------ *)
   36.39  
   36.40 -qed_goalw "unique_lub " Porder.thy [is_lub, is_ub] 
   36.41 +qed_goalw "unique_lub "thy [is_lub, is_ub] 
   36.42          "[| S <<| x ; S <<| y |] ==> x=y"
   36.43  ( fn prems =>
   36.44          [
   36.45 @@ -54,8 +52,7 @@
   36.46  (* chains are monotone functions                                            *)
   36.47  (* ------------------------------------------------------------------------ *)
   36.48  
   36.49 -qed_goalw "chain_mono" Porder.thy [is_chain]
   36.50 -        " is_chain(F) ==> x<y --> F(x)<<F(y)"
   36.51 +qed_goalw "chain_mono" thy [is_chain] "is_chain F ==> x<y --> F x<<F y"
   36.52  ( fn prems =>
   36.53          [
   36.54          (cut_facts_tac prems 1),
   36.55 @@ -74,8 +71,7 @@
   36.56          (atac 1)
   36.57          ]);
   36.58  
   36.59 -qed_goal "chain_mono3"  Porder.thy 
   36.60 -        "[| is_chain(F); x <= y |] ==> F(x) << F(y)"
   36.61 +qed_goal "chain_mono3" thy "[| is_chain F; x <= y |] ==> F x << F y"
   36.62   (fn prems =>
   36.63          [
   36.64          (cut_facts_tac prems 1),
   36.65 @@ -92,7 +88,7 @@
   36.66  (* The range of a chain is a totaly ordered     <<                           *)
   36.67  (* ------------------------------------------------------------------------ *)
   36.68  
   36.69 -qed_goalw "chain_is_tord" Porder.thy [is_tord] 
   36.70 +qed_goalw "chain_is_tord" thy [is_tord] 
   36.71  "!!F. is_chain(F) ==> is_tord(range(F))"
   36.72   (fn _ =>
   36.73          [
   36.74 @@ -103,8 +99,9 @@
   36.75  (* ------------------------------------------------------------------------ *)
   36.76  (* technical lemmas about lub and is_lub                                    *)
   36.77  (* ------------------------------------------------------------------------ *)
   36.78 +bind_thm("lub",lub_def RS meta_eq_to_obj_eq);
   36.79  
   36.80 -qed_goal "lubI" Porder.thy "(? x. M <<| x) ==> M <<| lub(M)"
   36.81 +qed_goal "lubI" thy "? x. M <<| x ==> M <<| lub(M)"
   36.82  (fn prems =>
   36.83          [
   36.84          (cut_facts_tac prems 1),
   36.85 @@ -112,15 +109,14 @@
   36.86          (etac (select_eq_Ex RS iffD2) 1)
   36.87          ]);
   36.88  
   36.89 -qed_goal "lubE" Porder.thy " M <<| lub(M) ==>  ? x. M <<| x"
   36.90 +qed_goal "lubE" thy "M <<| lub(M) ==> ? x. M <<| x"
   36.91  (fn prems =>
   36.92          [
   36.93          (cut_facts_tac prems 1),
   36.94          (etac exI 1)
   36.95          ]);
   36.96  
   36.97 -qed_goal "lub_eq" Porder.thy 
   36.98 -        "(? x. M <<| x)  = M <<| lub(M)"
   36.99 +qed_goal "lub_eq" thy "(? x. M <<| x)  = M <<| lub(M)"
  36.100  (fn prems => 
  36.101          [
  36.102          (stac lub 1),
  36.103 @@ -129,7 +125,7 @@
  36.104          ]);
  36.105  
  36.106  
  36.107 -qed_goal "thelubI"  Porder.thy " M <<| l ==> lub(M) = l"
  36.108 +qed_goal "thelubI" thy "M <<| l ==> lub(M) = l"
  36.109  (fn prems =>
  36.110          [
  36.111          (cut_facts_tac prems 1), 
  36.112 @@ -144,7 +140,7 @@
  36.113  (* access to some definition as inference rule                              *)
  36.114  (* ------------------------------------------------------------------------ *)
  36.115  
  36.116 -qed_goalw "is_lubE"  Porder.thy [is_lub]
  36.117 +qed_goalw "is_lubE" thy [is_lub]
  36.118          "S <<| x  ==> S <| x & (! u. S <| u  --> x << u)"
  36.119  (fn prems =>
  36.120          [
  36.121 @@ -152,7 +148,7 @@
  36.122          (atac 1)
  36.123          ]);
  36.124  
  36.125 -qed_goalw "is_lubI"  Porder.thy [is_lub]
  36.126 +qed_goalw "is_lubI" thy [is_lub]
  36.127          "S <| x & (! u. S <| u  --> x << u) ==> S <<| x"
  36.128  (fn prems =>
  36.129          [
  36.130 @@ -160,15 +156,13 @@
  36.131          (atac 1)
  36.132          ]);
  36.133  
  36.134 -qed_goalw "is_chainE" Porder.thy [is_chain] 
  36.135 - "is_chain(F) ==> ! i. F(i) << F(Suc(i))"
  36.136 +qed_goalw "is_chainE" thy [is_chain] "is_chain F ==> !i. F(i) << F(Suc(i))"
  36.137  (fn prems =>
  36.138          [
  36.139          (cut_facts_tac prems 1),
  36.140          (atac 1)]);
  36.141  
  36.142 -qed_goalw "is_chainI" Porder.thy [is_chain] 
  36.143 - "! i. F(i) << F(Suc(i)) ==> is_chain(F) "
  36.144 +qed_goalw "is_chainI" thy [is_chain] "!i. F i << F(Suc i) ==> is_chain F"
  36.145  (fn prems =>
  36.146          [
  36.147          (cut_facts_tac prems 1),
  36.148 @@ -178,8 +172,7 @@
  36.149  (* technical lemmas about (least) upper bounds of chains                    *)
  36.150  (* ------------------------------------------------------------------------ *)
  36.151  
  36.152 -qed_goalw "ub_rangeE"  Porder.thy [is_ub]
  36.153 -        "range(S) <| x  ==> ! i. S(i) << x"
  36.154 +qed_goalw "ub_rangeE" thy [is_ub] "range S <| x  ==> !i. S(i) << x"
  36.155  (fn prems =>
  36.156          [
  36.157          (cut_facts_tac prems 1),
  36.158 @@ -189,8 +182,7 @@
  36.159          (rtac rangeI 1)
  36.160          ]);
  36.161  
  36.162 -qed_goalw "ub_rangeI" Porder.thy [is_ub]
  36.163 -        "! i. S(i) << x  ==> range(S) <| x"
  36.164 +qed_goalw "ub_rangeI" thy [is_ub] "!i. S i << x  ==> range S <| x"
  36.165  (fn prems =>
  36.166          [
  36.167          (cut_facts_tac prems 1),
  36.168 @@ -207,85 +199,11 @@
  36.169  (* [| ?S3 <<| ?x3; ?S3 <| ?x1 |] ==> ?x3 << ?x1                             *)
  36.170  
  36.171  (* ------------------------------------------------------------------------ *)
  36.172 -(* Prototype lemmas for class pcpo                                          *)
  36.173 -(* ------------------------------------------------------------------------ *)
  36.174 -
  36.175 -(* ------------------------------------------------------------------------ *)
  36.176 -(* a technical argument about << on void                                    *)
  36.177 -(* ------------------------------------------------------------------------ *)
  36.178 -
  36.179 -qed_goal "less_void" Porder.thy "((u1::void) << u2) = (u1 = u2)"
  36.180 -(fn prems =>
  36.181 -        [
  36.182 -        (stac inst_void_po 1),
  36.183 -        (rewtac less_void_def),
  36.184 -        (rtac iffI 1),
  36.185 -        (rtac injD 1),
  36.186 -        (atac 2),
  36.187 -        (rtac inj_inverseI 1),
  36.188 -        (rtac Rep_Void_inverse 1),
  36.189 -        (etac arg_cong 1)
  36.190 -        ]);
  36.191 -
  36.192 -(* ------------------------------------------------------------------------ *)
  36.193 -(* void is pointed. The least element is UU_void                            *)
  36.194 -(* ------------------------------------------------------------------------ *)
  36.195 -
  36.196 -qed_goal "minimal_void" Porder.thy      "UU_void << x"
  36.197 -(fn prems =>
  36.198 -        [
  36.199 -        (stac inst_void_po 1),
  36.200 -        (rewtac less_void_def),
  36.201 -        (simp_tac (!simpset addsimps [unique_void]) 1)
  36.202 -        ]);
  36.203 -
  36.204 -(* ------------------------------------------------------------------------ *)
  36.205 -(* UU_void is the trivial lub of all chains in void                         *)
  36.206 -(* ------------------------------------------------------------------------ *)
  36.207 -
  36.208 -qed_goalw "lub_void"  Porder.thy [is_lub] "M <<| UU_void"
  36.209 -(fn prems =>
  36.210 -        [
  36.211 -        (rtac conjI 1),
  36.212 -        (rewtac is_ub),
  36.213 -        (strip_tac 1),
  36.214 -        (stac inst_void_po 1),
  36.215 -        (rewtac less_void_def),
  36.216 -        (simp_tac (!simpset addsimps [unique_void]) 1),
  36.217 -        (strip_tac 1),
  36.218 -        (rtac minimal_void 1)
  36.219 -        ]);
  36.220 -
  36.221 -(* ------------------------------------------------------------------------ *)
  36.222 -(* lub(?M) = UU_void                                                        *)
  36.223 -(* ------------------------------------------------------------------------ *)
  36.224 -
  36.225 -bind_thm ("thelub_void", lub_void RS thelubI);
  36.226 -
  36.227 -(* ------------------------------------------------------------------------ *)
  36.228 -(* void is a cpo wrt. countable chains                                      *)
  36.229 -(* ------------------------------------------------------------------------ *)
  36.230 -
  36.231 -qed_goal "cpo_void" Porder.thy
  36.232 -        "is_chain((S::nat=>void)) ==> ? x. range(S) <<| x "
  36.233 -(fn prems =>
  36.234 -        [
  36.235 -        (cut_facts_tac prems 1),
  36.236 -        (res_inst_tac [("x","UU_void")] exI 1),
  36.237 -        (rtac lub_void 1)
  36.238 -        ]);
  36.239 -
  36.240 -(* ------------------------------------------------------------------------ *)
  36.241 -(* end of prototype lemmas for class pcpo                                   *)
  36.242 -(* ------------------------------------------------------------------------ *)
  36.243 -
  36.244 -
  36.245 -(* ------------------------------------------------------------------------ *)
  36.246  (* results about finite chains                                              *)
  36.247  (* ------------------------------------------------------------------------ *)
  36.248  
  36.249 -qed_goalw "lub_finch1" Porder.thy [max_in_chain_def]
  36.250 -        "[| is_chain(C) ; max_in_chain i C|] ==> range(C) <<| C(i)"
  36.251 +qed_goalw "lub_finch1" thy [max_in_chain_def]
  36.252 +        "[| is_chain C; max_in_chain i C|] ==> range C <<| C i"
  36.253  (fn prems =>
  36.254          [
  36.255          (cut_facts_tac prems 1),
  36.256 @@ -306,7 +224,7 @@
  36.257          (etac (ub_rangeE RS spec) 1)
  36.258          ]);     
  36.259  
  36.260 -qed_goalw "lub_finch2" Porder.thy [finite_chain_def]
  36.261 +qed_goalw "lub_finch2" thy [finite_chain_def]
  36.262          "finite_chain(C) ==> range(C) <<| C(@ i. max_in_chain i C)"
  36.263   (fn prems=>
  36.264          [
  36.265 @@ -318,7 +236,7 @@
  36.266          ]);
  36.267  
  36.268  
  36.269 -qed_goal "bin_chain" Porder.thy "x<<y ==> is_chain (%i. if i=0 then x else y)"
  36.270 +qed_goal "bin_chain" thy "x<<y ==> is_chain (%i. if i=0 then x else y)"
  36.271   (fn prems =>
  36.272          [
  36.273          (cut_facts_tac prems 1),
  36.274 @@ -330,7 +248,7 @@
  36.275          (rtac refl_less 1)
  36.276          ]);
  36.277  
  36.278 -qed_goalw "bin_chainmax" Porder.thy [max_in_chain_def,le_def]
  36.279 +qed_goalw "bin_chainmax" thy [max_in_chain_def,le_def]
  36.280          "x<<y ==> max_in_chain (Suc 0) (%i. if (i=0) then x else y)"
  36.281  (fn prems =>
  36.282          [
  36.283 @@ -341,7 +259,7 @@
  36.284          (Asm_simp_tac 1)
  36.285          ]);
  36.286  
  36.287 -qed_goal "lub_bin_chain" Porder.thy 
  36.288 +qed_goal "lub_bin_chain" thy 
  36.289          "x << y ==> range(%i. if (i=0) then x else y) <<| y"
  36.290  (fn prems=>
  36.291          [ (cut_facts_tac prems 1),
  36.292 @@ -356,8 +274,8 @@
  36.293  (* the maximal element in a chain is its lub                                *)
  36.294  (* ------------------------------------------------------------------------ *)
  36.295  
  36.296 -qed_goal "lub_chain_maxelem" Porder.thy
  36.297 -"[|? i.Y(i)=c;!i.Y(i)<<c|] ==> lub(range(Y)) = c"
  36.298 +qed_goal "lub_chain_maxelem" thy
  36.299 +"[|? i.Y i=c;!i.Y i<<c|] ==> lub(range Y) = c"
  36.300   (fn prems =>
  36.301          [
  36.302          (cut_facts_tac prems 1),
  36.303 @@ -375,7 +293,7 @@
  36.304  (* the lub of a constant chain is the constant                              *)
  36.305  (* ------------------------------------------------------------------------ *)
  36.306  
  36.307 -qed_goal "lub_const" Porder.thy "range(%x.c) <<| c"
  36.308 +qed_goal "lub_const" thy "range(%x.c) <<| c"
  36.309   (fn prems =>
  36.310          [
  36.311          (rtac is_lubI 1),
    37.1 --- a/src/HOLCF/Porder.thy	Sat Feb 15 18:24:05 1997 +0100
    37.2 +++ b/src/HOLCF/Porder.thy	Mon Feb 17 10:57:11 1997 +0100
    37.3 @@ -33,11 +33,9 @@
    37.4  defs
    37.5  
    37.6  (* class definitions *)
    37.7 -
    37.8  is_ub           "S  <| x == ! y.y:S --> y<<x"
    37.9  is_lub          "S <<| x == S <| x & (! u. S <| u  --> x << u)"
   37.10  
   37.11 -
   37.12  (* Arbitrary chains are total orders    *)                  
   37.13  is_tord         "is_tord S == ! x y. x:S & y:S --> (x<<y | y<<x)"
   37.14  
   37.15 @@ -45,14 +43,10 @@
   37.16  is_chain        "is_chain F == (! i.F(i) << F(Suc(i)))"
   37.17  
   37.18  (* finite chains, needed for monotony of continouous functions *)
   37.19 -
   37.20  max_in_chain_def "max_in_chain i C == ! j. i <= j --> C(i) = C(j)" 
   37.21 -
   37.22  finite_chain_def "finite_chain C == is_chain(C) & (? i. max_in_chain i C)"
   37.23  
   37.24 -rules
   37.25 -
   37.26 -lub             "lub S = (@x. S <<| x)"
   37.27 +lub_def          "lub S == (@x. S <<| x)"
   37.28  
   37.29  end 
   37.30  
    38.1 --- a/src/HOLCF/Porder0.thy	Sat Feb 15 18:24:05 1997 +0100
    38.2 +++ b/src/HOLCF/Porder0.thy	Mon Feb 17 10:57:11 1997 +0100
    38.3 @@ -1,53 +1,33 @@
    38.4 -(*  Title:      HOLCF/porder0.thy
    38.5 +(*  Title:      HOLCF/Porder0.thy
    38.6      ID:         $Id$
    38.7      Author:     Franz Regensburger
    38.8      Copyright   1993 Technische Universitaet Muenchen
    38.9  
   38.10  Definition of class porder (partial order)
   38.11  
   38.12 -The prototype theory for this class is void.thy 
   38.13 -
   38.14  *)
   38.15  
   38.16 -Porder0 = Void +
   38.17 +Porder0 = Nat +
   38.18  
   38.19 -(* Introduction of new class. The witness is type void. *)
   38.20 -
   38.21 -classes po < term
   38.22 +(* first the global constant for HOLCF type classes *)
   38.23 +consts
   38.24 +  "less"        :: "['a,'a] => bool" (infixl "\\<sqsubseteq>\\<sqsubseteq>" 55)
   38.25  
   38.26 -(* default type is still term ! *)
   38.27 -(* void is the prototype in po *)
   38.28 -
   38.29 -arities void :: po
   38.30 -
   38.31 +axclass po < term
   38.32 +        (* class axioms: *)
   38.33 +ax_refl_less       "less x x"        
   38.34 +ax_antisym_less    "[|less x y; less y x |] ==> x = y"    
   38.35 +ax_trans_less      "[|less x y; less y z |] ==> less x z"
   38.36 + 
   38.37 +	(* characteristic constant << on po *)
   38.38  consts
   38.39 -
   38.40 -  "<<"		:: "['a,'a::po] => bool"	(infixl 55)
   38.41 +  "<<"          :: "['a,'a::po] => bool"        (infixl 55)
   38.42  
   38.43  syntax (symbols)
   38.44 -
   38.45 -  "op <<"	:: "['a,'a::po] => bool"	(infixl "\\<sqsubseteq>" 55)
   38.46 -
   38.47 -rules
   38.48 -
   38.49 -(* class axioms: justification is theory Void *)
   38.50 -
   38.51 -refl_less       "x<<x"        
   38.52 -                                (* witness refl_less_void    *)
   38.53 +  "op <<"       :: "['a,'a::po] => bool"        (infixl "\\<sqsubseteq>" 55)
   38.54  
   38.55 -antisym_less    "[|x<<y ; y<<x |] ==> x = y"    
   38.56 -                                (* witness antisym_less_void *)
   38.57 -
   38.58 -trans_less      "[|x<<y ; y<<z |] ==> x<<z"
   38.59 -                                (* witness trans_less_void   *)
   38.60 -
   38.61 -(* instance of << for the prototype void *)
   38.62 -
   38.63 -inst_void_po    "((op <<)::[void,void]=>bool) = less_void"
   38.64 -
   38.65 +defs
   38.66 +po_def             "(op <<) == less"
   38.67  end 
   38.68  
   38.69  
   38.70 -
   38.71 -
   38.72 -
    39.1 --- a/src/HOLCF/Sprod0.ML	Sat Feb 15 18:24:05 1997 +0100
    39.2 +++ b/src/HOLCF/Sprod0.ML	Mon Feb 17 10:57:11 1997 +0100
    39.3 @@ -19,7 +19,6 @@
    39.4          (EVERY1 [rtac CollectI, rtac exI,rtac exI, rtac refl])
    39.5          ]);
    39.6  
    39.7 -
    39.8  qed_goal "inj_onto_Abs_Sprod" Sprod0.thy 
    39.9          "inj_onto Abs_Sprod Sprod"
   39.10  (fn prems =>
   39.11 @@ -28,12 +27,10 @@
   39.12          (etac Abs_Sprod_inverse 1)
   39.13          ]);
   39.14  
   39.15 -
   39.16  (* ------------------------------------------------------------------------ *)
   39.17  (* Strictness and definedness of Spair_Rep                                  *)
   39.18  (* ------------------------------------------------------------------------ *)
   39.19  
   39.20 -
   39.21  qed_goalw "strict_Spair_Rep" Sprod0.thy [Spair_Rep_def]
   39.22   "(a=UU | b=UU) ==> (Spair_Rep a b) = (Spair_Rep UU UU)"
   39.23   (fn prems =>
   39.24 @@ -374,3 +371,13 @@
   39.25          (asm_simp_tac Sprod0_ss 1)
   39.26          ]);
   39.27  
   39.28 +qed_goal "Sel_injective_Sprod" thy 
   39.29 +        "[|Isfst x = Isfst y; Issnd x = Issnd y|] ==> x = y"
   39.30 +(fn prems =>
   39.31 +        [
   39.32 +        (cut_facts_tac prems 1),
   39.33 +        (subgoal_tac "Ispair(Isfst x)(Issnd x)=Ispair(Isfst y)(Issnd y)" 1),
   39.34 +        (rotate_tac ~1 1),
   39.35 +        (asm_full_simp_tac(HOL_ss addsimps[surjective_pairing_Sprod RS sym])1),
   39.36 +        (Asm_simp_tac 1)
   39.37 +        ]);
    40.1 --- a/src/HOLCF/Sprod0.thy	Sat Feb 15 18:24:05 1997 +0100
    40.2 +++ b/src/HOLCF/Sprod0.thy	Mon Feb 17 10:57:11 1997 +0100
    40.3 @@ -1,57 +1,36 @@
    40.4 -(*  Title:      HOLCF/sprod0.thy
    40.5 +(*  Title:      HOLCF/Sprod0.thy
    40.6      ID:         $Id$
    40.7      Author:     Franz Regensburger
    40.8      Copyright   1993  Technische Universitaet Muenchen
    40.9  
   40.10 -Strict product
   40.11 +Strict product with typedef
   40.12  *)
   40.13  
   40.14  Sprod0 = Cfun3 +
   40.15  
   40.16 -(* new type for strict product *)
   40.17 +constdefs
   40.18 +  Spair_Rep     :: ['a,'b] => ['a,'b] => bool
   40.19 + "Spair_Rep == (%a b. %x y.(~a=UU & ~b=UU --> x=a  & y=b ))"
   40.20  
   40.21 -types "**" 2        (infixr 20)
   40.22 -
   40.23 -arities "**" :: (pcpo,pcpo)term 
   40.24 +typedef (Sprod)  ('a, 'b) "**" (infixr 20) = "{f. ? a b. f = Spair_Rep a b}"
   40.25  
   40.26  syntax (symbols)
   40.27 - 
   40.28 -  "**"		:: [type, type] => type		("(_ \\<otimes>/ _)" [21,20] 20)
   40.29 +  "**"		:: [type, type] => type	 ("(_ \\<otimes>/ _)" [21,20] 20)
   40.30  
   40.31  consts
   40.32 -  Sprod         :: "('a => 'b => bool)set"
   40.33 -  Spair_Rep     :: "['a,'b] => ['a,'b] => bool"
   40.34 -  Rep_Sprod     :: "('a ** 'b) => ('a => 'b => bool)"
   40.35 -  Abs_Sprod     :: "('a => 'b => bool) => ('a ** 'b)"
   40.36    Ispair        :: "['a,'b] => ('a ** 'b)"
   40.37    Isfst         :: "('a ** 'b) => 'a"
   40.38    Issnd         :: "('a ** 'b) => 'b"  
   40.39  
   40.40  defs
   40.41 -  Spair_Rep_def         "Spair_Rep == (%a b. %x y.
   40.42 -                                (~a=UU & ~b=UU --> x=a  & y=b ))"
   40.43 -
   40.44 -  Sprod_def             "Sprod == {f. ? a b. f = Spair_Rep a b}"
   40.45 -
   40.46 -rules
   40.47 -  (*faking a type definition... *)
   40.48 -  (* "**" is isomorphic to Sprod *)
   40.49 -
   40.50 -  Rep_Sprod             "Rep_Sprod(p):Sprod"            
   40.51 -  Rep_Sprod_inverse     "Abs_Sprod(Rep_Sprod(p)) = p"   
   40.52 -  Abs_Sprod_inverse     "f:Sprod ==> Rep_Sprod(Abs_Sprod(f)) = f"
   40.53 -
   40.54 -defs
   40.55     (*defining the abstract constants*)
   40.56  
   40.57    Ispair_def    "Ispair a b == Abs_Sprod(Spair_Rep a b)"
   40.58  
   40.59 -  Isfst_def     "Isfst(p) == @z.
   40.60 -                                        (p=Ispair UU UU --> z=UU)
   40.61 +  Isfst_def     "Isfst(p) == @z.        (p=Ispair UU UU --> z=UU)
   40.62                  &(! a b. ~a=UU & ~b=UU & p=Ispair a b   --> z=a)"  
   40.63  
   40.64 -  Issnd_def     "Issnd(p) == @z.
   40.65 -                                        (p=Ispair UU UU  --> z=UU)
   40.66 +  Issnd_def     "Issnd(p) == @z.        (p=Ispair UU UU  --> z=UU)
   40.67                  &(! a b. ~a=UU & ~b=UU & p=Ispair a b    --> z=b)"  
   40.68  
   40.69  
    41.1 --- a/src/HOLCF/Sprod1.ML	Sat Feb 15 18:24:05 1997 +0100
    41.2 +++ b/src/HOLCF/Sprod1.ML	Mon Feb 17 10:57:11 1997 +0100
    41.3 @@ -1,183 +1,36 @@
    41.4 -(*  Title:      HOLCF/sprod1.ML
    41.5 +(*  Title:      HOLCF/Sprod1.ML
    41.6      ID:         $Id$
    41.7      Author:     Franz Regensburger
    41.8      Copyright   1993  Technische Universitaet Muenchen
    41.9  
   41.10 -Lemmas for theory sprod1.thy
   41.11 +Lemmas for theory Sprod1.thy
   41.12  *)
   41.13  
   41.14  open Sprod1;
   41.15  
   41.16  (* ------------------------------------------------------------------------ *)
   41.17 -(* reduction properties for less_sprod                                      *)
   41.18 -(* ------------------------------------------------------------------------ *)
   41.19 -
   41.20 -
   41.21 -qed_goalw "less_sprod1a" Sprod1.thy [less_sprod_def]
   41.22 -        "p1=Ispair UU UU ==> less_sprod p1 p2"
   41.23 - (fn prems =>
   41.24 -        [
   41.25 -        (cut_facts_tac prems 1),
   41.26 -        (asm_simp_tac HOL_ss 1)
   41.27 -        ]);
   41.28 -
   41.29 -qed_goalw "less_sprod1b" Sprod1.thy [less_sprod_def]
   41.30 - "p1~=Ispair UU UU ==> \
   41.31 -\ less_sprod p1 p2 = ( Isfst p1 << Isfst p2 & Issnd p1 << Issnd p2)"
   41.32 - (fn prems =>
   41.33 -        [
   41.34 -        (cut_facts_tac prems 1),
   41.35 -        (asm_simp_tac HOL_ss 1)
   41.36 -        ]);
   41.37 -
   41.38 -qed_goal "less_sprod2a" Sprod1.thy
   41.39 -        "less_sprod(Ispair x y)(Ispair UU UU) ==> x = UU | y = UU"
   41.40 -(fn prems =>
   41.41 -        [
   41.42 -        (cut_facts_tac prems 1),
   41.43 -        (rtac (excluded_middle RS disjE) 1),
   41.44 -        (atac 2),
   41.45 -        (rtac disjI1 1),
   41.46 -        (rtac antisym_less 1),
   41.47 -        (rtac minimal 2),
   41.48 -        (res_inst_tac [("s","Isfst(Ispair x y)"),("t","x")] subst 1),
   41.49 -        (rtac Isfst 1),
   41.50 -        (fast_tac HOL_cs 1),
   41.51 -        (fast_tac HOL_cs 1),
   41.52 -        (res_inst_tac [("s","Isfst(Ispair UU UU)"),("t","UU")] subst 1),
   41.53 -        (simp_tac Sprod0_ss 1),
   41.54 -        (rtac (defined_Ispair RS less_sprod1b RS iffD1 RS conjunct1) 1),
   41.55 -        (REPEAT (fast_tac HOL_cs 1))
   41.56 -        ]);
   41.57 -
   41.58 -qed_goal "less_sprod2b" Sprod1.thy
   41.59 - "less_sprod p (Ispair UU UU) ==> p = Ispair UU UU"
   41.60 -(fn prems =>
   41.61 -        [
   41.62 -        (cut_facts_tac prems 1),
   41.63 -        (res_inst_tac [("p","p")] IsprodE 1),
   41.64 -        (atac 1),
   41.65 -        (hyp_subst_tac 1),
   41.66 -        (rtac strict_Ispair 1),
   41.67 -        (etac less_sprod2a 1)
   41.68 -        ]);
   41.69 -
   41.70 -qed_goal "less_sprod2c" Sprod1.thy 
   41.71 - "[|less_sprod(Ispair xa ya)(Ispair x y);\
   41.72 -\  xa ~= UU ; ya ~= UU; x ~= UU ;  y ~= UU |] ==> xa << x & ya << y"
   41.73 -(fn prems =>
   41.74 -        [
   41.75 -        (rtac conjI 1),
   41.76 -        (res_inst_tac [("s","Isfst(Ispair xa ya)"),("t","xa")] subst 1),
   41.77 -        (simp_tac (Sprod0_ss addsimps prems)1),
   41.78 -        (res_inst_tac [("s","Isfst(Ispair x y)"),("t","x")] subst 1),
   41.79 -        (simp_tac (Sprod0_ss addsimps prems)1),
   41.80 -        (rtac (defined_Ispair RS less_sprod1b RS iffD1 RS conjunct1) 1),
   41.81 -        (resolve_tac prems 1),
   41.82 -        (resolve_tac prems 1),
   41.83 -        (simp_tac (Sprod0_ss addsimps prems)1),
   41.84 -        (res_inst_tac [("s","Issnd(Ispair xa ya)"),("t","ya")] subst 1),
   41.85 -        (simp_tac (Sprod0_ss addsimps prems)1),
   41.86 -        (res_inst_tac [("s","Issnd(Ispair x y)"),("t","y")] subst 1),
   41.87 -        (simp_tac (Sprod0_ss addsimps prems)1),
   41.88 -        (rtac (defined_Ispair RS less_sprod1b RS iffD1 RS conjunct2) 1),
   41.89 -        (resolve_tac prems 1),
   41.90 -        (resolve_tac prems 1),
   41.91 -        (simp_tac (Sprod0_ss addsimps prems)1)
   41.92 -        ]);
   41.93 -
   41.94 -(* ------------------------------------------------------------------------ *)
   41.95  (* less_sprod is a partial order on Sprod                                   *)
   41.96  (* ------------------------------------------------------------------------ *)
   41.97  
   41.98 -qed_goal "refl_less_sprod" Sprod1.thy "less_sprod p p"
   41.99 -(fn prems =>
  41.100 -        [
  41.101 -        (res_inst_tac [("p","p")] IsprodE 1),
  41.102 -        (etac less_sprod1a 1),
  41.103 -        (hyp_subst_tac 1),
  41.104 -        (stac less_sprod1b 1),
  41.105 -        (rtac defined_Ispair 1),
  41.106 -        (REPEAT (fast_tac (HOL_cs addIs [refl_less]) 1))
  41.107 -        ]);
  41.108 -
  41.109 +qed_goalw "refl_less_sprod" thy [less_sprod_def]"less (p::'a ** 'b) p"
  41.110 +(fn prems => [(fast_tac (HOL_cs addIs [refl_less]) 1)]);
  41.111  
  41.112 -qed_goal "antisym_less_sprod" Sprod1.thy 
  41.113 - "[|less_sprod p1 p2;less_sprod p2 p1|] ==> p1=p2"
  41.114 - (fn prems =>
  41.115 -        [
  41.116 -        (cut_facts_tac prems 1),
  41.117 -        (res_inst_tac [("p","p1")] IsprodE 1),
  41.118 -        (hyp_subst_tac 1),
  41.119 -        (res_inst_tac [("p","p2")] IsprodE 1),
  41.120 -        (hyp_subst_tac 1),
  41.121 -        (rtac refl 1),
  41.122 -        (hyp_subst_tac 1),
  41.123 -        (rtac (strict_Ispair RS sym) 1),
  41.124 -        (etac less_sprod2a 1),
  41.125 -        (hyp_subst_tac 1),
  41.126 -        (res_inst_tac [("p","p2")] IsprodE 1),
  41.127 -        (hyp_subst_tac 1),
  41.128 -        (rtac (strict_Ispair) 1),
  41.129 -        (etac less_sprod2a 1),
  41.130 -        (hyp_subst_tac 1),
  41.131 -        (res_inst_tac [("x1","x"),("y1","xa"),("x","y"),("y","ya")] (arg_cong RS cong) 1),
  41.132 -        (rtac antisym_less 1),
  41.133 -        (asm_simp_tac (HOL_ss addsimps [less_sprod2c RS conjunct1]) 1),
  41.134 -        (asm_simp_tac (HOL_ss addsimps [less_sprod2c RS conjunct1]) 1),
  41.135 -        (rtac antisym_less 1),
  41.136 -        (asm_simp_tac (HOL_ss addsimps [less_sprod2c RS conjunct2]) 1),
  41.137 -        (asm_simp_tac (HOL_ss addsimps [less_sprod2c RS conjunct2]) 1)
  41.138 -        ]);
  41.139 -
  41.140 -qed_goal "trans_less_sprod" Sprod1.thy 
  41.141 - "[|less_sprod (p1::'a**'b) p2;less_sprod p2 p3|] ==> less_sprod p1 p3"
  41.142 - (fn prems =>
  41.143 +qed_goalw "antisym_less_sprod" thy [less_sprod_def]
  41.144 +        "[|less (p1::'a ** 'b) p2;less p2 p1|] ==> p1=p2"
  41.145 +(fn prems =>
  41.146          [
  41.147          (cut_facts_tac prems 1),
  41.148 -        (res_inst_tac [("p","p1")] IsprodE 1),
  41.149 -        (etac less_sprod1a 1),
  41.150 -        (hyp_subst_tac 1),
  41.151 -        (res_inst_tac [("p","p3")] IsprodE 1),
  41.152 -        (hyp_subst_tac 1),
  41.153 -        (res_inst_tac [("s","p2"),("t","Ispair (UU::'a)(UU::'b)")] subst 1),
  41.154 -        (etac less_sprod2b 1),
  41.155 -        (atac 1),
  41.156 -        (hyp_subst_tac 1),
  41.157 -        (res_inst_tac [("Q","p2=Ispair(UU::'a)(UU::'b)")]
  41.158 -                 (excluded_middle RS disjE) 1),
  41.159 -        (stac (defined_Ispair RS less_sprod1b) 1),
  41.160 -        (REPEAT (atac 1)),
  41.161 -        (rtac conjI 1),
  41.162 -        (res_inst_tac [("y","Isfst(p2)")] trans_less 1),
  41.163 -        (rtac conjunct1 1),
  41.164 -        (rtac (less_sprod1b RS subst) 1),
  41.165 -        (rtac defined_Ispair 1),
  41.166 -        (REPEAT (atac 1)),
  41.167 -        (rtac conjunct1 1),
  41.168 -        (rtac (less_sprod1b RS subst) 1),
  41.169 -        (REPEAT (atac 1)),
  41.170 -        (res_inst_tac [("y","Issnd(p2)")] trans_less 1),
  41.171 -        (rtac conjunct2 1),
  41.172 -        (rtac (less_sprod1b RS subst) 1),
  41.173 -        (rtac defined_Ispair 1),
  41.174 -        (REPEAT (atac 1)),
  41.175 -        (rtac conjunct2 1),
  41.176 -        (rtac (less_sprod1b RS subst) 1),
  41.177 -        (REPEAT (atac 1)),
  41.178 -        (hyp_subst_tac 1),
  41.179 -        (res_inst_tac [("s","Ispair(UU::'a)(UU::'b)"),("t","Ispair x y")] 
  41.180 -                subst 1),
  41.181 -        (etac (less_sprod2b RS sym) 1),
  41.182 -        (atac 1)
  41.183 +        (rtac Sel_injective_Sprod 1),
  41.184 +        (fast_tac (HOL_cs addIs [antisym_less]) 1),
  41.185 +        (fast_tac (HOL_cs addIs [antisym_less]) 1)
  41.186          ]);
  41.187  
  41.188 -
  41.189 -
  41.190 -
  41.191 -
  41.192 -
  41.193 -
  41.194 -
  41.195 -
  41.196 -
  41.197 +qed_goalw "trans_less_sprod" thy [less_sprod_def]
  41.198 +        "[|less (p1::'a**'b) p2;less p2 p3|] ==> less p1 p3"
  41.199 +(fn prems =>
  41.200 +        [
  41.201 +        (cut_facts_tac prems 1),
  41.202 +        (rtac conjI 1),
  41.203 +        (fast_tac (HOL_cs addIs [trans_less]) 1),
  41.204 +        (fast_tac (HOL_cs addIs [trans_less]) 1)
  41.205 +        ]);
    42.1 --- a/src/HOLCF/Sprod1.thy	Sat Feb 15 18:24:05 1997 +0100
    42.2 +++ b/src/HOLCF/Sprod1.thy	Mon Feb 17 10:57:11 1997 +0100
    42.3 @@ -8,13 +8,7 @@
    42.4  
    42.5  Sprod1 = Sprod0 +
    42.6  
    42.7 -consts
    42.8 -  less_sprod    :: "[('a ** 'b),('a ** 'b)] => bool"    
    42.9 -
   42.10  defs
   42.11 -  less_sprod_def "less_sprod p1 p2 == 
   42.12 -        if p1 = Ispair UU UU
   42.13 -                then True
   42.14 -                else Isfst p1 << Isfst p2 & Issnd p1 << Issnd p2"
   42.15 +  less_sprod_def "less p1 p2 == Isfst p1 << Isfst p2 & Issnd p1 << Issnd p2"
   42.16  
   42.17  end
    43.1 --- a/src/HOLCF/Sprod2.ML	Sat Feb 15 18:24:05 1997 +0100
    43.2 +++ b/src/HOLCF/Sprod2.ML	Mon Feb 17 10:57:11 1997 +0100
    43.3 @@ -1,70 +1,38 @@
    43.4 -(*  Title:      HOLCF/sprod2.ML
    43.5 +(*  Title:      HOLCF/Sprod2.ML
    43.6      ID:         $Id$
    43.7      Author:     Franz Regensburger
    43.8      Copyright   1993 Technische Universitaet Muenchen
    43.9  
   43.10 -Lemmas for sprod2.thy
   43.11 +Lemmas for Sprod2.thy
   43.12  *)
   43.13  
   43.14 -
   43.15  open Sprod2;
   43.16  
   43.17 -(* ------------------------------------------------------------------------ *)
   43.18 -(* access to less_sprod in class po                                         *)
   43.19 -(* ------------------------------------------------------------------------ *)
   43.20 -
   43.21 -qed_goal "less_sprod3a" Sprod2.thy 
   43.22 -        "p1=Ispair UU UU ==> p1 << p2"
   43.23 -(fn prems =>
   43.24 -        [
   43.25 -        (cut_facts_tac prems 1),
   43.26 -        (stac inst_sprod_po 1),
   43.27 -        (etac less_sprod1a 1)
   43.28 -        ]);
   43.29 -
   43.30 -
   43.31 -qed_goal "less_sprod3b" Sprod2.thy
   43.32 - "p1~=Ispair UU UU ==>\
   43.33 -\       (p1<<p2) = (Isfst(p1)<<Isfst(p2) & Issnd(p1)<<Issnd(p2))" 
   43.34 -(fn prems =>
   43.35 +(* for compatibility with old HOLCF-Version *)
   43.36 +qed_goal "inst_sprod_po" thy "(op <<)=(%x y.Isfst x<<Isfst y&Issnd x<<Issnd y)"
   43.37 + (fn prems => 
   43.38          [
   43.39 -        (cut_facts_tac prems 1),
   43.40 -        (stac inst_sprod_po 1),
   43.41 -        (etac less_sprod1b 1)
   43.42 -        ]);
   43.43 -
   43.44 -qed_goal "less_sprod4b" Sprod2.thy 
   43.45 -        "p << Ispair UU UU ==> p = Ispair UU UU"
   43.46 -(fn prems =>
   43.47 -        [
   43.48 -        (cut_facts_tac prems 1),
   43.49 -        (rtac less_sprod2b 1),
   43.50 -        (etac (inst_sprod_po RS subst) 1)
   43.51 -        ]);
   43.52 -
   43.53 -bind_thm ("less_sprod4a", less_sprod4b RS defined_Ispair_rev);
   43.54 -(* Ispair ?a ?b << Ispair UU UU ==> ?a = UU | ?b = UU *)
   43.55 -
   43.56 -qed_goal "less_sprod4c" Sprod2.thy
   43.57 - "[|Ispair xa ya << Ispair x y; xa~=UU; ya~=UU; x~=UU; y~=UU|] ==>\
   43.58 -\               xa<<x & ya << y"
   43.59 -(fn prems =>
   43.60 -        [
   43.61 -        (cut_facts_tac prems 1),
   43.62 -        (rtac less_sprod2c 1),
   43.63 -        (etac (inst_sprod_po RS subst) 1),
   43.64 -        (REPEAT (atac 1))
   43.65 +	(fold_goals_tac [po_def,less_sprod_def]),
   43.66 +	(rtac refl 1)
   43.67          ]);
   43.68  
   43.69  (* ------------------------------------------------------------------------ *)
   43.70  (* type sprod is pointed                                                    *)
   43.71  (* ------------------------------------------------------------------------ *)
   43.72  
   43.73 -qed_goal "minimal_sprod" Sprod2.thy  "Ispair UU UU << p"
   43.74 +qed_goal "minimal_sprod" thy "Ispair UU UU << p"
   43.75  (fn prems =>
   43.76          [
   43.77 -        (rtac less_sprod3a 1),
   43.78 -        (rtac refl 1)
   43.79 +        (simp_tac(Sprod0_ss addsimps[inst_sprod_po,minimal])1)
   43.80 +        ]);
   43.81 +
   43.82 +bind_thm ("UU_sprod_def",minimal_sprod RS minimal2UU RS sym);
   43.83 +
   43.84 +qed_goal "least_sprod" thy "? x::'a**'b.!y.x<<y"
   43.85 +(fn prems =>
   43.86 +        [
   43.87 +        (res_inst_tac [("x","Ispair UU UU")] exI 1),
   43.88 +        (rtac (minimal_sprod RS allI) 1)
   43.89          ]);
   43.90  
   43.91  (* ------------------------------------------------------------------------ *)
   43.92 @@ -77,77 +45,27 @@
   43.93          (strip_tac 1),
   43.94          (rtac (less_fun RS iffD2) 1),
   43.95          (strip_tac 1),
   43.96 -        (res_inst_tac [("Q",
   43.97 -        " Ispair y xa = Ispair UU UU")] (excluded_middle RS disjE) 1),
   43.98 -        (res_inst_tac [("Q",
   43.99 -        " Ispair x xa = Ispair UU UU")] (excluded_middle RS disjE) 1),
  43.100 -        (rtac (less_sprod3b RS iffD2) 1),
  43.101 -        (atac 1),
  43.102 -        (rtac conjI 1),
  43.103 -        (stac Isfst 1),
  43.104 -        (etac (strict_Ispair_rev RS conjunct1) 1),
  43.105 -        (etac (strict_Ispair_rev RS conjunct2) 1),
  43.106 -        (stac Isfst 1),
  43.107 -        (etac (strict_Ispair_rev RS conjunct1) 1),
  43.108 -        (etac (strict_Ispair_rev RS conjunct2) 1),
  43.109 +        (res_inst_tac [("Q","xa=UU")] (excluded_middle RS disjE) 1),
  43.110 +        (res_inst_tac [("Q","x=UU")] (excluded_middle RS disjE) 1),
  43.111 +        (forward_tac [notUU_I] 1),
  43.112          (atac 1),
  43.113 -        (stac Issnd 1),
  43.114 -        (etac (strict_Ispair_rev RS conjunct1) 1),
  43.115 -        (etac (strict_Ispair_rev RS conjunct2) 1),
  43.116 -        (stac Issnd 1),
  43.117 -        (etac (strict_Ispair_rev RS conjunct1) 1),
  43.118 -        (etac (strict_Ispair_rev RS conjunct2) 1),
  43.119 -        (rtac refl_less 1),
  43.120 -        (etac less_sprod3a 1),
  43.121 -        (res_inst_tac [("Q",
  43.122 -        " Ispair x xa  = Ispair UU UU")] (excluded_middle RS disjE) 1),
  43.123 -        (etac less_sprod3a 2),
  43.124 -        (res_inst_tac [("P","Ispair y xa = Ispair UU UU")] notE 1),
  43.125 -        (atac 2),
  43.126 -        (rtac defined_Ispair 1),
  43.127 -        (etac notUU_I 1),
  43.128 -        (etac (strict_Ispair_rev RS  conjunct1) 1),
  43.129 -        (etac (strict_Ispair_rev RS  conjunct2) 1)
  43.130 +        (REPEAT(asm_simp_tac(Sprod0_ss 
  43.131 +                addsimps[inst_sprod_po,refl_less,minimal]) 1))
  43.132          ]);
  43.133  
  43.134 -
  43.135  qed_goalw "monofun_Ispair2" Sprod2.thy [monofun] "monofun(Ispair(x))"
  43.136  (fn prems =>
  43.137          [
  43.138          (strip_tac 1),
  43.139 -        (res_inst_tac [("Q",
  43.140 -        " Ispair x y = Ispair UU UU")] (excluded_middle RS disjE) 1),
  43.141 -        (res_inst_tac [("Q",
  43.142 -        " Ispair x xa = Ispair UU UU")] (excluded_middle RS disjE) 1),
  43.143 -        (rtac (less_sprod3b RS iffD2) 1),
  43.144 +        (res_inst_tac [("Q","x=UU")] (excluded_middle RS disjE) 1),
  43.145 +        (res_inst_tac [("Q","xa=UU")] (excluded_middle RS disjE) 1),
  43.146 +        (forward_tac [notUU_I] 1),
  43.147          (atac 1),
  43.148 -        (rtac conjI 1),
  43.149 -        (stac Isfst 1),
  43.150 -        (etac (strict_Ispair_rev RS conjunct1) 1),
  43.151 -        (etac (strict_Ispair_rev RS conjunct2) 1),
  43.152 -        (stac Isfst 1),
  43.153 -        (etac (strict_Ispair_rev RS conjunct1) 1),
  43.154 -        (etac (strict_Ispair_rev RS conjunct2) 1),
  43.155 -        (rtac refl_less 1),
  43.156 -        (stac Issnd 1),
  43.157 -        (etac (strict_Ispair_rev RS conjunct1) 1),
  43.158 -        (etac (strict_Ispair_rev RS conjunct2) 1),
  43.159 -        (stac Issnd 1),
  43.160 -        (etac (strict_Ispair_rev RS conjunct1) 1),
  43.161 -        (etac (strict_Ispair_rev RS conjunct2) 1),
  43.162 -        (atac 1),
  43.163 -        (etac less_sprod3a 1),
  43.164 -        (res_inst_tac [("Q",
  43.165 -        " Ispair x xa = Ispair UU UU")] (excluded_middle RS disjE) 1),
  43.166 -        (etac less_sprod3a 2),
  43.167 -        (res_inst_tac [("P","Ispair x y = Ispair UU UU")] notE 1),
  43.168 -        (atac 2),
  43.169 -        (rtac defined_Ispair 1),
  43.170 -        (etac (strict_Ispair_rev RS  conjunct1) 1),
  43.171 -        (etac notUU_I 1),
  43.172 -        (etac (strict_Ispair_rev RS  conjunct2) 1)
  43.173 +        (REPEAT(asm_simp_tac(Sprod0_ss 
  43.174 +                addsimps[inst_sprod_po,refl_less,minimal]) 1))
  43.175          ]);
  43.176  
  43.177 +
  43.178  qed_goal " monofun_Ispair" Sprod2.thy 
  43.179   "[|x1<<x2; y1<<y2|] ==> Ispair x1 y1 << Ispair x2 y2"
  43.180  (fn prems =>
  43.181 @@ -166,60 +84,11 @@
  43.182  (* Isfst and Issnd are monotone                                             *)
  43.183  (* ------------------------------------------------------------------------ *)
  43.184  
  43.185 -qed_goalw " monofun_Isfst" Sprod2.thy [monofun] "monofun(Isfst)"
  43.186 -(fn prems =>
  43.187 -        [
  43.188 -        (strip_tac 1),
  43.189 -        (res_inst_tac [("p","x")] IsprodE 1),
  43.190 -        (hyp_subst_tac 1),
  43.191 -        (rtac trans_less 1),
  43.192 -        (rtac minimal 2),
  43.193 -        (stac strict_Isfst1 1),
  43.194 -        (rtac refl_less 1),
  43.195 -        (hyp_subst_tac 1),
  43.196 -        (res_inst_tac [("p","y")] IsprodE 1),
  43.197 -        (hyp_subst_tac 1),
  43.198 -        (res_inst_tac [("t","Isfst(Ispair xa ya)")] subst 1),
  43.199 -        (rtac refl_less 2),
  43.200 -        (etac (less_sprod4b RS sym RS arg_cong) 1),
  43.201 -        (hyp_subst_tac 1),
  43.202 -        (stac Isfst 1),
  43.203 -        (atac 1),
  43.204 -        (atac 1),
  43.205 -        (stac Isfst 1),
  43.206 -        (atac 1),
  43.207 -        (atac 1),
  43.208 -        (etac (less_sprod4c RS  conjunct1) 1),
  43.209 -        (REPEAT (atac 1))
  43.210 -        ]);
  43.211 +qed_goalw "monofun_Isfst" Sprod2.thy [monofun] "monofun(Isfst)"
  43.212 +(fn prems => [(simp_tac (HOL_ss addsimps [inst_sprod_po]) 1)]);
  43.213  
  43.214  qed_goalw "monofun_Issnd" Sprod2.thy [monofun] "monofun(Issnd)"
  43.215 -(fn prems =>
  43.216 -        [
  43.217 -        (strip_tac 1),
  43.218 -        (res_inst_tac [("p","x")] IsprodE 1),
  43.219 -        (hyp_subst_tac 1),
  43.220 -        (rtac trans_less 1),
  43.221 -        (rtac minimal 2),
  43.222 -        (stac strict_Issnd1 1),
  43.223 -        (rtac refl_less 1),
  43.224 -        (hyp_subst_tac 1),
  43.225 -        (res_inst_tac [("p","y")] IsprodE 1),
  43.226 -        (hyp_subst_tac 1),
  43.227 -        (res_inst_tac [("t","Issnd(Ispair xa ya)")] subst 1),
  43.228 -        (rtac refl_less 2),
  43.229 -        (etac (less_sprod4b RS sym RS arg_cong) 1),
  43.230 -        (hyp_subst_tac 1),
  43.231 -        (stac Issnd 1),
  43.232 -        (atac 1),
  43.233 -        (atac 1),
  43.234 -        (stac Issnd 1),
  43.235 -        (atac 1),
  43.236 -        (atac 1),
  43.237 -        (etac (less_sprod4c RS  conjunct2) 1),
  43.238 -        (REPEAT (atac 1))
  43.239 -        ]);
  43.240 -
  43.241 +(fn prems => [(simp_tac (HOL_ss addsimps [inst_sprod_po]) 1)]);
  43.242  
  43.243  (* ------------------------------------------------------------------------ *)
  43.244  (* the type 'a ** 'b is a cpo                                               *)
  43.245 @@ -231,10 +100,8 @@
  43.246  (fn prems =>
  43.247          [
  43.248          (cut_facts_tac prems 1),
  43.249 -        (rtac is_lubI 1),
  43.250 -        (rtac conjI 1),
  43.251 -        (rtac ub_rangeI 1),
  43.252 -        (rtac allI 1),
  43.253 +        (rtac (conjI RS is_lubI) 1),
  43.254 +        (rtac (allI RS ub_rangeI) 1),
  43.255          (res_inst_tac [("t","S(i)")] (surjective_pairing_Sprod RS ssubst) 1),
  43.256          (rtac monofun_Ispair 1),
  43.257          (rtac is_ub_thelub 1),
    44.1 --- a/src/HOLCF/Sprod2.thy	Sat Feb 15 18:24:05 1997 +0100
    44.2 +++ b/src/HOLCF/Sprod2.thy	Mon Feb 17 10:57:11 1997 +0100
    44.3 @@ -1,4 +1,4 @@
    44.4 -(*  Title:      HOLCF/sprod2.thy
    44.5 +(*  Title:      HOLCF/Sprod2.thy
    44.6      ID:         $Id$
    44.7      Author:     Franz Regensburger
    44.8      Copyright   1993 Technische Universitaet Muenchen
    44.9 @@ -8,17 +8,8 @@
   44.10  
   44.11  Sprod2 = Sprod1 + 
   44.12  
   44.13 -arities "**" :: (pcpo,pcpo)po
   44.14 -
   44.15 -(* Witness for the above arity axiom is sprod1.ML *)
   44.16 -
   44.17 -rules
   44.18 -
   44.19 -(* instance of << for type ['a ** 'b]  *)
   44.20 -
   44.21 -inst_sprod_po   "((op <<)::['a ** 'b,'a ** 'b]=>bool) = less_sprod"
   44.22 -
   44.23 +instance "**"::(pcpo,pcpo)po 
   44.24 +		(refl_less_sprod, antisym_less_sprod, trans_less_sprod)
   44.25  end
   44.26  
   44.27  
   44.28 -
    45.1 --- a/src/HOLCF/Sprod3.ML	Sat Feb 15 18:24:05 1997 +0100
    45.2 +++ b/src/HOLCF/Sprod3.ML	Mon Feb 17 10:57:11 1997 +0100
    45.3 @@ -1,18 +1,24 @@
    45.4 -(*  Title:      HOLCF/sprod3.thy
    45.5 +(*  Title:      HOLCF/Sprod3.thy
    45.6      ID:         $Id$
    45.7      Author:     Franz Regensburger
    45.8      Copyright   1993 Technische Universitaet Muenchen
    45.9  
   45.10 -Lemmas for Sprod3.thy 
   45.11 +Lemmas for Sprod.thy 
   45.12  *)
   45.13  
   45.14  open Sprod3;
   45.15  
   45.16 +(* for compatibility with old HOLCF-Version *)
   45.17 +qed_goal "inst_sprod_pcpo" thy "UU = Ispair UU UU"
   45.18 + (fn prems => 
   45.19 +        [
   45.20 +        (simp_tac (HOL_ss addsimps [UU_def,UU_sprod_def]) 1)
   45.21 +        ]);
   45.22  (* ------------------------------------------------------------------------ *)
   45.23  (* continuity of Ispair, Isfst, Issnd                                       *)
   45.24  (* ------------------------------------------------------------------------ *)
   45.25  
   45.26 -qed_goal "sprod3_lemma1" Sprod3.thy 
   45.27 +qed_goal "sprod3_lemma1" thy 
   45.28  "[| is_chain(Y);  x~= UU;  lub(range(Y))~= UU |] ==>\
   45.29  \ Ispair (lub(range Y)) x =\
   45.30  \ Ispair (lub(range(%i. Isfst(Ispair(Y i) x)))) \
   45.31 @@ -49,7 +55,7 @@
   45.32          (rtac minimal 1)
   45.33          ]);
   45.34  
   45.35 -qed_goal "sprod3_lemma2" Sprod3.thy 
   45.36 +qed_goal "sprod3_lemma2" thy 
   45.37  "[| is_chain(Y); x ~= UU; lub(range(Y)) = UU |] ==>\
   45.38  \   Ispair (lub(range Y)) x =\
   45.39  \   Ispair (lub(range(%i. Isfst(Ispair(Y i) x))))\
   45.40 @@ -71,7 +77,7 @@
   45.41          ]);
   45.42  
   45.43  
   45.44 -qed_goal "sprod3_lemma3" Sprod3.thy 
   45.45 +qed_goal "sprod3_lemma3" thy 
   45.46  "[| is_chain(Y); x = UU |] ==>\
   45.47  \          Ispair (lub(range Y)) x =\
   45.48  \          Ispair (lub(range(%i. Isfst(Ispair (Y i) x))))\
   45.49 @@ -91,7 +97,7 @@
   45.50          ]);
   45.51  
   45.52  
   45.53 -qed_goal "contlub_Ispair1" Sprod3.thy "contlub(Ispair)"
   45.54 +qed_goal "contlub_Ispair1" thy "contlub(Ispair)"
   45.55  (fn prems =>
   45.56          [
   45.57          (rtac contlubI 1),
   45.58 @@ -117,7 +123,7 @@
   45.59          (atac 1)
   45.60          ]);
   45.61  
   45.62 -qed_goal "sprod3_lemma4" Sprod3.thy 
   45.63 +qed_goal "sprod3_lemma4" thy 
   45.64  "[| is_chain(Y); x ~= UU; lub(range(Y)) ~= UU |] ==>\
   45.65  \         Ispair x (lub(range Y)) =\
   45.66  \         Ispair (lub(range(%i. Isfst (Ispair x (Y i)))))\
   45.67 @@ -153,7 +159,7 @@
   45.68          (asm_simp_tac Sprod0_ss 1)
   45.69          ]);
   45.70  
   45.71 -qed_goal "sprod3_lemma5" Sprod3.thy 
   45.72 +qed_goal "sprod3_lemma5" thy 
   45.73  "[| is_chain(Y); x ~= UU; lub(range(Y)) = UU |] ==>\
   45.74  \         Ispair x (lub(range Y)) =\
   45.75  \         Ispair (lub(range(%i. Isfst(Ispair x (Y i)))))\
   45.76 @@ -174,7 +180,7 @@
   45.77          (atac 1)
   45.78          ]);
   45.79  
   45.80 -qed_goal "sprod3_lemma6" Sprod3.thy 
   45.81 +qed_goal "sprod3_lemma6" thy 
   45.82  "[| is_chain(Y); x = UU |] ==>\
   45.83  \         Ispair x (lub(range Y)) =\
   45.84  \         Ispair (lub(range(%i. Isfst (Ispair x (Y i)))))\
   45.85 @@ -193,7 +199,7 @@
   45.86          (simp_tac Sprod0_ss  1)
   45.87          ]);
   45.88  
   45.89 -qed_goal "contlub_Ispair2" Sprod3.thy "contlub(Ispair(x))"
   45.90 +qed_goal "contlub_Ispair2" thy "contlub(Ispair(x))"
   45.91  (fn prems =>
   45.92          [
   45.93          (rtac contlubI 1),
   45.94 @@ -215,7 +221,7 @@
   45.95          ]);
   45.96  
   45.97  
   45.98 -qed_goal "cont_Ispair1" Sprod3.thy "cont(Ispair)"
   45.99 +qed_goal "cont_Ispair1" thy "cont(Ispair)"
  45.100  (fn prems =>
  45.101          [
  45.102          (rtac monocontlub2cont 1),
  45.103 @@ -224,7 +230,7 @@
  45.104          ]);
  45.105  
  45.106  
  45.107 -qed_goal "cont_Ispair2" Sprod3.thy "cont(Ispair(x))"
  45.108 +qed_goal "cont_Ispair2" thy "cont(Ispair(x))"
  45.109  (fn prems =>
  45.110          [
  45.111          (rtac monocontlub2cont 1),
  45.112 @@ -232,7 +238,7 @@
  45.113          (rtac contlub_Ispair2 1)
  45.114          ]);
  45.115  
  45.116 -qed_goal "contlub_Isfst" Sprod3.thy "contlub(Isfst)"
  45.117 +qed_goal "contlub_Isfst" thy "contlub(Isfst)"
  45.118   (fn prems =>
  45.119          [
  45.120          (rtac contlubI 1),
  45.121 @@ -257,7 +263,7 @@
  45.122                                    chain_UU_I RS spec]) 1)
  45.123          ]);
  45.124  
  45.125 -qed_goal "contlub_Issnd" Sprod3.thy "contlub(Issnd)"
  45.126 +qed_goal "contlub_Issnd" thy "contlub(Issnd)"
  45.127  (fn prems =>
  45.128          [
  45.129          (rtac contlubI 1),
  45.130 @@ -281,7 +287,7 @@
  45.131                                    chain_UU_I RS spec]) 1)
  45.132          ]);
  45.133  
  45.134 -qed_goal "cont_Isfst" Sprod3.thy "cont(Isfst)"
  45.135 +qed_goal "cont_Isfst" thy "cont(Isfst)"
  45.136  (fn prems =>
  45.137          [
  45.138          (rtac monocontlub2cont 1),
  45.139 @@ -289,7 +295,7 @@
  45.140          (rtac contlub_Isfst 1)
  45.141          ]);
  45.142  
  45.143 -qed_goal "cont_Issnd" Sprod3.thy "cont(Issnd)"
  45.144 +qed_goal "cont_Issnd" thy "cont(Issnd)"
  45.145  (fn prems =>
  45.146          [
  45.147          (rtac monocontlub2cont 1),
  45.148 @@ -297,14 +303,7 @@
  45.149          (rtac contlub_Issnd 1)
  45.150          ]);
  45.151  
  45.152 -(* 
  45.153 - -------------------------------------------------------------------------- 
  45.154 - more lemmas for Sprod3.thy 
  45.155 - 
  45.156 - -------------------------------------------------------------------------- 
  45.157 -*)
  45.158 -
  45.159 -qed_goal "spair_eq" Sprod3.thy "[|x1=x2;y1=y2|] ==> (|x1,y1|) = (|x2,y2|)"
  45.160 +qed_goal "spair_eq" thy "[|x1=x2;y1=y2|] ==> (|x1,y1|) = (|x2,y2|)"
  45.161   (fn prems =>
  45.162          [
  45.163          (cut_facts_tac prems 1),
  45.164 @@ -315,7 +314,7 @@
  45.165  (* convert all lemmas to the continuous versions                            *)
  45.166  (* ------------------------------------------------------------------------ *)
  45.167  
  45.168 -qed_goalw "beta_cfun_sprod" Sprod3.thy [spair_def]
  45.169 +qed_goalw "beta_cfun_sprod" thy [spair_def]
  45.170          "(LAM x y.Ispair x y)`a`b = Ispair a b"
  45.171   (fn prems =>
  45.172          [
  45.173 @@ -327,7 +326,7 @@
  45.174          (rtac refl 1)
  45.175          ]);
  45.176  
  45.177 -qed_goalw "inject_spair" Sprod3.thy [spair_def]
  45.178 +qed_goalw "inject_spair" thy [spair_def]
  45.179          "[| aa~=UU ; ba~=UU ; (|a,b|)=(|aa,ba|) |] ==> a=aa & b=ba"
  45.180   (fn prems =>
  45.181          [
  45.182 @@ -339,7 +338,7 @@
  45.183          (rtac beta_cfun_sprod 1)
  45.184          ]);
  45.185  
  45.186 -qed_goalw "inst_sprod_pcpo2" Sprod3.thy [spair_def] "UU = (|UU,UU|)"
  45.187 +qed_goalw "inst_sprod_pcpo2" thy [spair_def] "UU = (|UU,UU|)"
  45.188   (fn prems =>
  45.189          [
  45.190          (rtac sym 1),
  45.191 @@ -349,7 +348,7 @@
  45.192          (rtac inst_sprod_pcpo 1)
  45.193          ]);
  45.194  
  45.195 -qed_goalw "strict_spair" Sprod3.thy [spair_def] 
  45.196 +qed_goalw "strict_spair" thy [spair_def] 
  45.197          "(a=UU | b=UU) ==> (|a,b|)=UU"
  45.198   (fn prems =>
  45.199          [
  45.200 @@ -361,7 +360,7 @@
  45.201          (etac strict_Ispair 1)
  45.202          ]);
  45.203  
  45.204 -qed_goalw "strict_spair1" Sprod3.thy [spair_def] "(|UU,b|) = UU"
  45.205 +qed_goalw "strict_spair1" thy [spair_def] "(|UU,b|) = UU"
  45.206   (fn prems =>
  45.207          [
  45.208          (stac beta_cfun_sprod 1),
  45.209 @@ -370,7 +369,7 @@
  45.210          (rtac strict_Ispair1 1)
  45.211          ]);
  45.212  
  45.213 -qed_goalw "strict_spair2" Sprod3.thy [spair_def] "(|a,UU|) = UU"
  45.214 +qed_goalw "strict_spair2" thy [spair_def] "(|a,UU|) = UU"
  45.215   (fn prems =>
  45.216          [
  45.217          (stac beta_cfun_sprod 1),
  45.218 @@ -379,7 +378,7 @@
  45.219          (rtac strict_Ispair2 1)
  45.220          ]);
  45.221  
  45.222 -qed_goalw "strict_spair_rev" Sprod3.thy [spair_def]
  45.223 +qed_goalw "strict_spair_rev" thy [spair_def]
  45.224          "(|x,y|)~=UU ==> ~x=UU & ~y=UU"
  45.225   (fn prems =>
  45.226          [
  45.227 @@ -390,7 +389,7 @@
  45.228          (atac 1)
  45.229          ]);
  45.230  
  45.231 -qed_goalw "defined_spair_rev" Sprod3.thy [spair_def]
  45.232 +qed_goalw "defined_spair_rev" thy [spair_def]
  45.233   "(|a,b|) = UU ==> (a = UU | b = UU)"
  45.234   (fn prems =>
  45.235          [
  45.236 @@ -401,7 +400,7 @@
  45.237          (atac 1)
  45.238          ]);
  45.239  
  45.240 -qed_goalw "defined_spair" Sprod3.thy [spair_def]
  45.241 +qed_goalw "defined_spair" thy [spair_def]
  45.242          "[|a~=UU; b~=UU|] ==> (|a,b|) ~= UU"
  45.243   (fn prems =>
  45.244          [
  45.245 @@ -412,7 +411,7 @@
  45.246          (atac 1)
  45.247          ]);
  45.248  
  45.249 -qed_goalw "Exh_Sprod2" Sprod3.thy [spair_def]
  45.250 +qed_goalw "Exh_Sprod2" thy [spair_def]
  45.251          "z=UU | (? a b. z=(|a,b|) & a~=UU & b~=UU)"
  45.252   (fn prems =>
  45.253          [
  45.254 @@ -432,7 +431,7 @@
  45.255          ]);
  45.256  
  45.257  
  45.258 -qed_goalw "sprodE" Sprod3.thy [spair_def]
  45.259 +qed_goalw "sprodE" thy [spair_def]
  45.260  "[|p=UU ==> Q;!!x y. [|p=(|x,y|);x~=UU ; y~=UU|] ==> Q|] ==> Q"
  45.261  (fn prems =>
  45.262          [
  45.263 @@ -448,7 +447,7 @@
  45.264          ]);
  45.265  
  45.266  
  45.267 -qed_goalw "strict_sfst" Sprod3.thy [sfst_def] 
  45.268 +qed_goalw "strict_sfst" thy [sfst_def] 
  45.269          "p=UU==>sfst`p=UU"
  45.270   (fn prems =>
  45.271          [
  45.272 @@ -460,7 +459,7 @@
  45.273          (atac 1)
  45.274          ]);
  45.275  
  45.276 -qed_goalw "strict_sfst1" Sprod3.thy [sfst_def,spair_def] 
  45.277 +qed_goalw "strict_sfst1" thy [sfst_def,spair_def] 
  45.278          "sfst`(|UU,y|) = UU"
  45.279   (fn prems =>
  45.280          [
  45.281 @@ -470,7 +469,7 @@
  45.282          (rtac strict_Isfst1 1)
  45.283          ]);
  45.284   
  45.285 -qed_goalw "strict_sfst2" Sprod3.thy [sfst_def,spair_def] 
  45.286 +qed_goalw "strict_sfst2" thy [sfst_def,spair_def] 
  45.287          "sfst`(|x,UU|) = UU"
  45.288   (fn prems =>
  45.289          [
  45.290 @@ -480,7 +479,7 @@
  45.291          (rtac strict_Isfst2 1)
  45.292          ]);
  45.293  
  45.294 -qed_goalw "strict_ssnd" Sprod3.thy [ssnd_def] 
  45.295 +qed_goalw "strict_ssnd" thy [ssnd_def] 
  45.296          "p=UU==>ssnd`p=UU"
  45.297   (fn prems =>
  45.298          [
  45.299 @@ -492,7 +491,7 @@
  45.300          (atac 1)
  45.301          ]);
  45.302  
  45.303 -qed_goalw "strict_ssnd1" Sprod3.thy [ssnd_def,spair_def] 
  45.304 +qed_goalw "strict_ssnd1" thy [ssnd_def,spair_def] 
  45.305          "ssnd`(|UU,y|) = UU"
  45.306   (fn prems =>
  45.307          [
  45.308 @@ -502,7 +501,7 @@
  45.309          (rtac strict_Issnd1 1)
  45.310          ]);
  45.311  
  45.312 -qed_goalw "strict_ssnd2" Sprod3.thy [ssnd_def,spair_def] 
  45.313 +qed_goalw "strict_ssnd2" thy [ssnd_def,spair_def] 
  45.314          "ssnd`(|x,UU|) = UU"
  45.315   (fn prems =>
  45.316          [
  45.317 @@ -512,7 +511,7 @@
  45.318          (rtac strict_Issnd2 1)
  45.319          ]);
  45.320  
  45.321 -qed_goalw "sfst2" Sprod3.thy [sfst_def,spair_def] 
  45.322 +qed_goalw "sfst2" thy [sfst_def,spair_def] 
  45.323          "y~=UU ==>sfst`(|x,y|)=x"
  45.324   (fn prems =>
  45.325          [
  45.326 @@ -523,7 +522,7 @@
  45.327          (etac Isfst2 1)
  45.328          ]);
  45.329  
  45.330 -qed_goalw "ssnd2" Sprod3.thy [ssnd_def,spair_def] 
  45.331 +qed_goalw "ssnd2" thy [ssnd_def,spair_def] 
  45.332          "x~=UU ==>ssnd`(|x,y|)=y"
  45.333   (fn prems =>
  45.334          [
  45.335 @@ -535,7 +534,7 @@
  45.336          ]);
  45.337  
  45.338  
  45.339 -qed_goalw "defined_sfstssnd" Sprod3.thy [sfst_def,ssnd_def,spair_def]
  45.340 +qed_goalw "defined_sfstssnd" thy [sfst_def,ssnd_def,spair_def]
  45.341          "p~=UU ==> sfst`p ~=UU & ssnd`p ~=UU"
  45.342   (fn prems =>
  45.343          [
  45.344 @@ -550,7 +549,7 @@
  45.345          ]);
  45.346   
  45.347  
  45.348 -qed_goalw "surjective_pairing_Sprod2" Sprod3.thy 
  45.349 +qed_goalw "surjective_pairing_Sprod2" thy 
  45.350          [sfst_def,ssnd_def,spair_def] "(|sfst`p , ssnd`p|) = p"
  45.351   (fn prems =>
  45.352          [
  45.353 @@ -563,38 +562,7 @@
  45.354          ]);
  45.355  
  45.356  
  45.357 -qed_goalw "less_sprod5b" Sprod3.thy [sfst_def,ssnd_def,spair_def]
  45.358 - "p1~=UU ==> (p1<<p2) = (sfst`p1<<sfst`p2 & ssnd`p1<<ssnd`p2)"
  45.359 - (fn prems =>
  45.360 -        [
  45.361 -        (cut_facts_tac prems 1),
  45.362 -        (stac beta_cfun 1),
  45.363 -        (rtac cont_Issnd 1),
  45.364 -        (stac beta_cfun 1),
  45.365 -        (rtac cont_Issnd 1),
  45.366 -        (stac beta_cfun 1),
  45.367 -        (rtac cont_Isfst 1),
  45.368 -        (stac beta_cfun 1),
  45.369 -        (rtac cont_Isfst 1),
  45.370 -        (rtac less_sprod3b 1),
  45.371 -        (rtac (inst_sprod_pcpo RS subst) 1),
  45.372 -        (atac 1)
  45.373 -        ]);
  45.374 -
  45.375 - 
  45.376 -qed_goalw "less_sprod5c" Sprod3.thy [sfst_def,ssnd_def,spair_def]
  45.377 - "[|(|xa,ya|) << (|x,y|);xa~=UU;ya~=UU;x~=UU;y~=UU|] ==>xa<<x & ya << y"
  45.378 - (fn prems =>
  45.379 -        [
  45.380 -        (cut_facts_tac prems 1),
  45.381 -        (rtac less_sprod4c 1),
  45.382 -        (REPEAT (atac 2)),
  45.383 -        (rtac (beta_cfun_sprod RS subst) 1),
  45.384 -        (rtac (beta_cfun_sprod RS subst) 1),
  45.385 -        (atac 1)
  45.386 -        ]);
  45.387 -
  45.388 -qed_goalw "lub_sprod2" Sprod3.thy [sfst_def,ssnd_def,spair_def]
  45.389 +qed_goalw "lub_sprod2" thy [sfst_def,ssnd_def,spair_def]
  45.390  "[|is_chain(S)|] ==> range(S) <<| \
  45.391  \ (| lub(range(%i.sfst`(S i))), lub(range(%i.ssnd`(S i))) |)"
  45.392   (fn prems =>
  45.393 @@ -617,7 +585,7 @@
  45.394   (|lub (range (%i. sfst`(?S1 i))), lub (range (%i. ssnd`(?S1 i)))|)" : thm
  45.395  *)
  45.396  
  45.397 -qed_goalw "ssplit1" Sprod3.thy [ssplit_def]
  45.398 +qed_goalw "ssplit1" thy [ssplit_def]
  45.399          "ssplit`f`UU=UU"
  45.400   (fn prems =>
  45.401          [
  45.402 @@ -627,7 +595,7 @@
  45.403          (rtac refl 1)
  45.404          ]);
  45.405  
  45.406 -qed_goalw "ssplit2" Sprod3.thy [ssplit_def]
  45.407 +qed_goalw "ssplit2" thy [ssplit_def]
  45.408          "[|x~=UU;y~=UU|] ==> ssplit`f`(|x,y|)= f`x`y"
  45.409   (fn prems =>
  45.410          [
  45.411 @@ -647,7 +615,7 @@
  45.412          ]);
  45.413  
  45.414  
  45.415 -qed_goalw "ssplit3" Sprod3.thy [ssplit_def]
  45.416 +qed_goalw "ssplit3" thy [ssplit_def]
  45.417    "ssplit`spair`z=z"
  45.418   (fn prems =>
  45.419          [
  45.420 @@ -664,7 +632,6 @@
  45.421          (rtac surjective_pairing_Sprod2 1)
  45.422          ]);
  45.423  
  45.424 -
  45.425  (* ------------------------------------------------------------------------ *)
  45.426  (* install simplifier for Sprod                                             *)
  45.427  (* ------------------------------------------------------------------------ *)
  45.428 @@ -672,7 +639,5 @@
  45.429  val Sprod_rews = [strict_spair1,strict_spair2,strict_sfst1,strict_sfst2,
  45.430                  strict_ssnd1,strict_ssnd2,sfst2,ssnd2,defined_spair,
  45.431                  ssplit1,ssplit2];
  45.432 +Addsimps Sprod_rews;
  45.433  
  45.434 -Addsimps [strict_spair1,strict_spair2,strict_sfst1,strict_sfst2,
  45.435 -          strict_ssnd1,strict_ssnd2,sfst2,ssnd2,defined_spair,
  45.436 -          ssplit1,ssplit2];
    46.1 --- a/src/HOLCF/Sprod3.thy	Sat Feb 15 18:24:05 1997 +0100
    46.2 +++ b/src/HOLCF/Sprod3.thy	Mon Feb 17 10:57:11 1997 +0100
    46.3 @@ -8,7 +8,7 @@
    46.4  
    46.5  Sprod3 = Sprod2 +
    46.6  
    46.7 -arities "**" :: (pcpo,pcpo)pcpo                 (* Witness sprod2.ML *)
    46.8 +instance "**" :: (pcpo,pcpo)pcpo  (least_sprod,cpo_sprod)
    46.9  
   46.10  consts  
   46.11    spair		:: "'a -> 'b -> ('a**'b)" (* continuous strict pairing *)
   46.12 @@ -17,18 +17,14 @@
   46.13    ssplit	:: "('a->'b->'c)->('a**'b)->'c"
   46.14  
   46.15  syntax  
   46.16 -  "@stuple"	:: "['a, args] => 'a ** 'b"		("(1'(|_,/ _|'))")
   46.17 +  "@stuple"	:: "['a, args] => 'a ** 'b"	("(1'(|_,/ _|'))")
   46.18  
   46.19  translations
   46.20          "(|x, y, z|)"   == "(|x, (|y, z|)|)"
   46.21          "(|x, y|)"      == "spair`x`y"
   46.22  
   46.23  syntax (symbols)
   46.24 -  "@stuple"	:: "['a, args] => 'a ** 'b"		("(1\\<lparr>_,/ _\\<rparr>)")
   46.25 -
   46.26 -rules 
   46.27 -
   46.28 -inst_sprod_pcpo "(UU::'a**'b) = Ispair UU UU"
   46.29 +  "@stuple"	:: "['a, args] => 'a ** 'b"	("(1\\<lparr>_,/ _\\<rparr>)")
   46.30  
   46.31  defs
   46.32  spair_def       "spair  == (LAM x y.Ispair x y)"
   46.33 @@ -36,7 +32,6 @@
   46.34  ssnd_def        "ssnd   == (LAM p.Issnd p)"     
   46.35  ssplit_def      "ssplit == (LAM f. strictify`(LAM p.f`(sfst`p)`(ssnd`p)))"
   46.36  
   46.37 -
   46.38  end
   46.39  
   46.40  
    47.1 --- a/src/HOLCF/Ssum0.thy	Sat Feb 15 18:24:05 1997 +0100
    47.2 +++ b/src/HOLCF/Ssum0.thy	Mon Feb 17 10:57:11 1997 +0100
    47.3 @@ -1,51 +1,30 @@
    47.4 -(*  Title:      HOLCF/ssum0.thy
    47.5 +(*  Title:      HOLCF/Ssum0.thy
    47.6      ID:         $Id$
    47.7      Author:     Franz Regensburger
    47.8      Copyright   1993  Technische Universitaet Muenchen
    47.9  
   47.10 -Strict sum
   47.11 +Strict sum with typedef
   47.12  *)
   47.13  
   47.14  Ssum0 = Cfun3 +
   47.15  
   47.16 -(* new type for strict sum *)
   47.17 +constdefs
   47.18 +  Sinl_Rep      :: ['a,'a,'b,bool]=>bool
   47.19 + "Sinl_Rep == (%a.%x y p. (a~=UU --> x=a & p))"
   47.20 +  Sinr_Rep      :: ['b,'a,'b,bool]=>bool
   47.21 + "Sinr_Rep == (%b.%x y p.(b~=UU --> y=b & ~p))"
   47.22  
   47.23 -types "++" 2        (infixr 10)
   47.24 -
   47.25 -arities "++" :: (pcpo,pcpo)term 
   47.26 +typedef (Ssum)  ('a, 'b) "++" (infixr 10) = 
   47.27 +	"{f.(? a.f=Sinl_Rep(a))|(? b.f=Sinr_Rep(b))}"
   47.28  
   47.29  syntax (symbols)
   47.30 -
   47.31 -  "++"		:: [type, type] => type		("(_ \\<oplus>/ _)" [21, 20] 20)
   47.32 +  "++"		:: [type, type] => type	("(_ \\<oplus>/ _)" [21, 20] 20)
   47.33  
   47.34  consts
   47.35 -  Ssum          :: "(['a,'b,bool]=>bool)set"
   47.36 -  Sinl_Rep      :: "['a,'a,'b,bool]=>bool"
   47.37 -  Sinr_Rep      :: "['b,'a,'b,bool]=>bool"
   47.38 -  Rep_Ssum      :: "('a ++ 'b) => (['a,'b,bool]=>bool)"
   47.39 -  Abs_Ssum      :: "(['a,'b,bool]=>bool) => ('a ++ 'b)"
   47.40    Isinl         :: "'a => ('a ++ 'b)"
   47.41    Isinr         :: "'b => ('a ++ 'b)"
   47.42    Iwhen         :: "('a->'c)=>('b->'c)=>('a ++ 'b)=> 'c"
   47.43  
   47.44 -defs
   47.45 -
   47.46 -  Sinl_Rep_def          "Sinl_Rep == (%a.%x y p.
   47.47 -                                (a~=UU --> x=a  & p))"
   47.48 -
   47.49 -  Sinr_Rep_def          "Sinr_Rep == (%b.%x y p.
   47.50 -                                (b~=UU --> y=b  & ~p))"
   47.51 -
   47.52 -  Ssum_def              "Ssum =={f.(? a.f=Sinl_Rep(a))|(? b.f=Sinr_Rep(b))}"
   47.53 -
   47.54 -rules
   47.55 -  (*faking a type definition... *)
   47.56 -  (* "++" is isomorphic to Ssum *)
   47.57 -
   47.58 -  Rep_Ssum              "Rep_Ssum(p):Ssum"              
   47.59 -  Rep_Ssum_inverse      "Abs_Ssum(Rep_Ssum(p)) = p"     
   47.60 -  Abs_Ssum_inverse      "f:Ssum ==> Rep_Ssum(Abs_Ssum(f)) = f"
   47.61 -
   47.62  defs   (*defining the abstract constants*)
   47.63    Isinl_def     "Isinl(a) == Abs_Ssum(Sinl_Rep(a))"
   47.64    Isinr_def     "Isinr(b) == Abs_Ssum(Sinr_Rep(b))"
    48.1 --- a/src/HOLCF/Ssum1.ML	Sat Feb 15 18:24:05 1997 +0100
    48.2 +++ b/src/HOLCF/Ssum1.ML	Mon Feb 17 10:57:11 1997 +0100
    48.3 @@ -1,9 +1,9 @@
    48.4 -(*  Title:      HOLCF/ssum1.ML
    48.5 +(*  Title:      HOLCF/Ssum1.ML
    48.6      ID:         $Id$
    48.7      Author:     Franz Regensburger
    48.8      Copyright   1993  Technische Universitaet Muenchen
    48.9  
   48.10 -Lemmas for theory ssum1.thy
   48.11 +Lemmas for theory Ssum1.thy
   48.12  *)
   48.13  
   48.14  open Ssum1;
   48.15 @@ -40,8 +40,8 @@
   48.16  
   48.17  in
   48.18  
   48.19 -val less_ssum1a = prove_goalw Ssum1.thy [less_ssum_def]
   48.20 -"[|s1=Isinl(x::'a); s2=Isinl(y::'a)|] ==> less_ssum s1 s2 = (x << y)"
   48.21 +val less_ssum1a = prove_goalw thy [less_ssum_def]
   48.22 +"[|s1=Isinl(x::'a); s2=Isinl(y::'a)|] ==> less s1 s2 = (x << y)"
   48.23   (fn prems =>
   48.24          [
   48.25          (cut_facts_tac prems 1),
   48.26 @@ -81,8 +81,8 @@
   48.27          ]);
   48.28  
   48.29  
   48.30 -val less_ssum1b = prove_goalw Ssum1.thy [less_ssum_def]
   48.31 -"[|s1=Isinr(x::'b); s2=Isinr(y::'b)|] ==> less_ssum s1 s2 = (x << y)"
   48.32 +val less_ssum1b = prove_goalw thy [less_ssum_def]
   48.33 +"[|s1=Isinr(x::'b); s2=Isinr(y::'b)|] ==> less s1 s2 = (x << y)"
   48.34   (fn prems =>
   48.35          [
   48.36          (cut_facts_tac prems 1),
   48.37 @@ -123,8 +123,8 @@
   48.38          ]);
   48.39  
   48.40  
   48.41 -val less_ssum1c = prove_goalw Ssum1.thy [less_ssum_def]
   48.42 -"[|s1=Isinl(x::'a); s2=Isinr(y::'b)|] ==> less_ssum s1 s2 = ((x::'a) = UU)"
   48.43 +val less_ssum1c = prove_goalw thy [less_ssum_def]
   48.44 +"[|s1=Isinl(x::'a); s2=Isinr(y::'b)|] ==> less s1 s2 = ((x::'a) = UU)"
   48.45   (fn prems =>
   48.46          [
   48.47          (cut_facts_tac prems 1),
   48.48 @@ -165,8 +165,8 @@
   48.49          ]);
   48.50  
   48.51  
   48.52 -val less_ssum1d = prove_goalw Ssum1.thy [less_ssum_def]
   48.53 -"[|s1=Isinr(x); s2=Isinl(y)|] ==> less_ssum s1 s2 = (x = UU)"
   48.54 +val less_ssum1d = prove_goalw thy [less_ssum_def]
   48.55 +"[|s1=Isinr(x); s2=Isinl(y)|] ==> less s1 s2 = (x = UU)"
   48.56   (fn prems =>
   48.57          [
   48.58          (cut_facts_tac prems 1),
   48.59 @@ -212,8 +212,8 @@
   48.60  (* optimize lemmas about less_ssum                                          *)
   48.61  (* ------------------------------------------------------------------------ *)
   48.62  
   48.63 -qed_goal "less_ssum2a" Ssum1.thy 
   48.64 -        "less_ssum (Isinl x) (Isinl y) = (x << y)"
   48.65 +qed_goal "less_ssum2a" thy 
   48.66 +        "less (Isinl x) (Isinl y) = (x << y)"
   48.67   (fn prems =>
   48.68          [
   48.69          (rtac less_ssum1a 1),
   48.70 @@ -221,8 +221,8 @@
   48.71          (rtac refl 1)
   48.72          ]);
   48.73  
   48.74 -qed_goal "less_ssum2b" Ssum1.thy 
   48.75 -        "less_ssum (Isinr x) (Isinr y) = (x << y)"
   48.76 +qed_goal "less_ssum2b" thy 
   48.77 +        "less (Isinr x) (Isinr y) = (x << y)"
   48.78   (fn prems =>
   48.79          [
   48.80          (rtac less_ssum1b 1),
   48.81 @@ -230,8 +230,8 @@
   48.82          (rtac refl 1)
   48.83          ]);
   48.84  
   48.85 -qed_goal "less_ssum2c" Ssum1.thy 
   48.86 -        "less_ssum (Isinl x) (Isinr y) = (x = UU)"
   48.87 +qed_goal "less_ssum2c" thy 
   48.88 +        "less (Isinl x) (Isinr y) = (x = UU)"
   48.89   (fn prems =>
   48.90          [
   48.91          (rtac less_ssum1c 1),
   48.92 @@ -239,8 +239,8 @@
   48.93          (rtac refl 1)
   48.94          ]);
   48.95  
   48.96 -qed_goal "less_ssum2d" Ssum1.thy 
   48.97 -        "less_ssum (Isinr x) (Isinl y) = (x = UU)"
   48.98 +qed_goal "less_ssum2d" thy 
   48.99 +        "less (Isinr x) (Isinl y) = (x = UU)"
  48.100   (fn prems =>
  48.101          [
  48.102          (rtac less_ssum1d 1),
  48.103 @@ -253,7 +253,7 @@
  48.104  (* less_ssum is a partial order on ++                                     *)
  48.105  (* ------------------------------------------------------------------------ *)
  48.106  
  48.107 -qed_goal "refl_less_ssum" Ssum1.thy "less_ssum p p"
  48.108 +qed_goal "refl_less_ssum" thy "less (p::'a++'b) p"
  48.109   (fn prems =>
  48.110          [
  48.111          (res_inst_tac [("p","p")] IssumE2 1),
  48.112 @@ -265,8 +265,8 @@
  48.113          (rtac refl_less 1)
  48.114          ]);
  48.115  
  48.116 -qed_goal "antisym_less_ssum" Ssum1.thy 
  48.117 - "[|less_ssum p1 p2; less_ssum p2 p1|] ==> p1=p2"
  48.118 +qed_goal "antisym_less_ssum" thy 
  48.119 + "[|less (p1::'a++'b) p2; less p2 p1|] ==> p1=p2"
  48.120   (fn prems =>
  48.121          [
  48.122          (cut_facts_tac prems 1),
  48.123 @@ -295,8 +295,8 @@
  48.124          (etac (less_ssum2b RS iffD1) 1)
  48.125          ]);
  48.126  
  48.127 -qed_goal "trans_less_ssum" Ssum1.thy 
  48.128 - "[|less_ssum p1 p2; less_ssum p2 p3|] ==> less_ssum p1 p3"
  48.129 +qed_goal "trans_less_ssum" thy 
  48.130 + "[|less (p1::'a++'b) p2; less p2 p3|] ==> less p1 p3"
  48.131   (fn prems =>
  48.132          [
  48.133          (cut_facts_tac prems 1),
    49.1 --- a/src/HOLCF/Ssum1.thy	Sat Feb 15 18:24:05 1997 +0100
    49.2 +++ b/src/HOLCF/Ssum1.thy	Mon Feb 17 10:57:11 1997 +0100
    49.3 @@ -1,4 +1,4 @@
    49.4 -(*  Title:      HOLCF/ssum1.thy
    49.5 +(*  Title:      HOLCF/Ssum1.thy
    49.6      ID:         $Id$
    49.7      Author:     Franz Regensburger
    49.8      Copyright   1993  Technische Universitaet Muenchen
    49.9 @@ -8,17 +8,12 @@
   49.10  
   49.11  Ssum1 = Ssum0 +
   49.12  
   49.13 -consts
   49.14 -
   49.15 -  less_ssum     :: "[('a ++ 'b),('a ++ 'b)] => bool"    
   49.16 -
   49.17 -rules
   49.18 -
   49.19 -  less_ssum_def "less_ssum s1 s2 == (@z.
   49.20 -         (! u x.s1=Isinl(u) & s2=Isinl(x) --> z = (u << x))
   49.21 -        &(! v y.s1=Isinr(v) & s2=Isinr(y) --> z = (v << y))
   49.22 -        &(! u y.s1=Isinl(u) & s2=Isinr(y) --> z = (u = UU))
   49.23 -        &(! v x.s1=Isinr(v) & s2=Isinl(x) --> z = (v = UU)))"
   49.24 +defs
   49.25 +  less_ssum_def "less == (%s1 s2.@z.
   49.26 +         (! u x.s1=Isinl u & s2=Isinl x --> z = u << x)
   49.27 +        &(! v y.s1=Isinr v & s2=Isinr y --> z = v << y)
   49.28 +        &(! u y.s1=Isinl u & s2=Isinr y --> z = (u = UU))
   49.29 +        &(! v x.s1=Isinr v & s2=Isinl x --> z = (v = UU)))"
   49.30  
   49.31  end
   49.32  
    50.1 --- a/src/HOLCF/Ssum2.ML	Sat Feb 15 18:24:05 1997 +0100
    50.2 +++ b/src/HOLCF/Ssum2.ML	Mon Feb 17 10:57:11 1997 +0100
    50.3 @@ -1,55 +1,58 @@
    50.4 -(*  Title:      HOLCF/ssum2.ML
    50.5 +(*  Title:      HOLCF/Ssum2.ML
    50.6      ID:         $Id$
    50.7      Author:     Franz Regensburger
    50.8      Copyright   1993 Technische Universitaet Muenchen
    50.9  
   50.10 -Lemmas for ssum2.thy
   50.11 +Lemmas for Ssum2.thy
   50.12  *)
   50.13  
   50.14  open Ssum2;
   50.15  
   50.16 +(* for compatibility with old HOLCF-Version *)
   50.17 +qed_goal "inst_ssum_po" thy "(op <<)=(%s1 s2.@z.\
   50.18 +\         (! u x.s1=Isinl u & s2=Isinl x --> z = u << x)\
   50.19 +\        &(! v y.s1=Isinr v & s2=Isinr y --> z = v << y)\
   50.20 +\        &(! u y.s1=Isinl u & s2=Isinr y --> z = (u = UU))\
   50.21 +\        &(! v x.s1=Isinr v & s2=Isinl x --> z = (v = UU)))"
   50.22 + (fn prems => 
   50.23 +        [
   50.24 +        (fold_goals_tac [po_def,less_ssum_def]),
   50.25 +        (rtac refl 1)
   50.26 +        ]);
   50.27 +
   50.28  (* ------------------------------------------------------------------------ *)
   50.29  (* access to less_ssum in class po                                          *)
   50.30  (* ------------------------------------------------------------------------ *)
   50.31  
   50.32 -qed_goal "less_ssum3a" Ssum2.thy 
   50.33 -        "(Isinl(x) << Isinl(y)) = (x << y)"
   50.34 +qed_goal "less_ssum3a" thy "Isinl x << Isinl y = x << y"
   50.35   (fn prems =>
   50.36          [
   50.37 -        (stac inst_ssum_po 1),
   50.38 -        (rtac less_ssum2a 1)
   50.39 +        (simp_tac (!simpset addsimps [po_def,less_ssum2a]) 1)
   50.40          ]);
   50.41  
   50.42 -qed_goal "less_ssum3b" Ssum2.thy 
   50.43 -        "(Isinr(x) << Isinr(y)) = (x << y)"
   50.44 +qed_goal "less_ssum3b" thy "Isinr x << Isinr y = x << y"
   50.45   (fn prems =>
   50.46          [
   50.47 -        (stac inst_ssum_po 1),
   50.48 -        (rtac less_ssum2b 1)
   50.49 +        (simp_tac (!simpset addsimps [po_def,less_ssum2b]) 1)
   50.50          ]);
   50.51  
   50.52 -qed_goal "less_ssum3c" Ssum2.thy 
   50.53 -        "(Isinl(x) << Isinr(y)) = (x = UU)"
   50.54 +qed_goal "less_ssum3c" thy "Isinl x << Isinr y = (x = UU)"
   50.55   (fn prems =>
   50.56          [
   50.57 -        (stac inst_ssum_po 1),
   50.58 -        (rtac less_ssum2c 1)
   50.59 +        (simp_tac (!simpset addsimps [po_def,less_ssum2c]) 1)
   50.60          ]);
   50.61  
   50.62 -qed_goal "less_ssum3d" Ssum2.thy 
   50.63 -        "(Isinr(x) << Isinl(y)) = (x = UU)"
   50.64 +qed_goal "less_ssum3d" thy "Isinr x << Isinl y = (x = UU)"
   50.65   (fn prems =>
   50.66          [
   50.67 -        (stac inst_ssum_po 1),
   50.68 -        (rtac less_ssum2d 1)
   50.69 +        (simp_tac (!simpset addsimps [po_def,less_ssum2d]) 1)
   50.70          ]);
   50.71  
   50.72 -
   50.73  (* ------------------------------------------------------------------------ *)
   50.74  (* type ssum ++ is pointed                                                  *)
   50.75  (* ------------------------------------------------------------------------ *)
   50.76  
   50.77 -qed_goal "minimal_ssum" Ssum2.thy "Isinl(UU) << s"
   50.78 +qed_goal "minimal_ssum" thy "Isinl UU << s"
   50.79   (fn prems =>
   50.80          [
   50.81          (res_inst_tac [("p","s")] IssumE2 1),
   50.82 @@ -62,19 +65,27 @@
   50.83          (rtac minimal 1)
   50.84          ]);
   50.85  
   50.86 +bind_thm ("UU_ssum_def",minimal_ssum RS minimal2UU RS sym);
   50.87 +
   50.88 +qed_goal "least_ssum" thy "? x::'a++'b.!y.x<<y"
   50.89 +(fn prems =>
   50.90 +        [
   50.91 +        (res_inst_tac [("x","Isinl UU")] exI 1),
   50.92 +        (rtac (minimal_ssum RS allI) 1)
   50.93 +        ]);
   50.94  
   50.95  (* ------------------------------------------------------------------------ *)
   50.96  (* Isinl, Isinr are monotone                                                *)
   50.97  (* ------------------------------------------------------------------------ *)
   50.98  
   50.99 -qed_goalw "monofun_Isinl" Ssum2.thy [monofun] "monofun(Isinl)"
  50.100 +qed_goalw "monofun_Isinl" thy [monofun] "monofun(Isinl)"
  50.101   (fn prems =>
  50.102          [
  50.103          (strip_tac 1),
  50.104          (etac (less_ssum3a RS iffD2) 1)
  50.105          ]);
  50.106  
  50.107 -qed_goalw "monofun_Isinr" Ssum2.thy [monofun] "monofun(Isinr)"
  50.108 +qed_goalw "monofun_Isinr" thy [monofun] "monofun(Isinr)"
  50.109   (fn prems =>
  50.110          [
  50.111          (strip_tac 1),
  50.112 @@ -87,7 +98,7 @@
  50.113  (* ------------------------------------------------------------------------ *)
  50.114  
  50.115  
  50.116 -qed_goalw "monofun_Iwhen1" Ssum2.thy [monofun] "monofun(Iwhen)"
  50.117 +qed_goalw "monofun_Iwhen1" thy [monofun] "monofun(Iwhen)"
  50.118   (fn prems =>
  50.119          [
  50.120          (strip_tac 1),
  50.121 @@ -103,7 +114,7 @@
  50.122          (asm_simp_tac Ssum0_ss 1)
  50.123          ]);
  50.124  
  50.125 -qed_goalw "monofun_Iwhen2" Ssum2.thy [monofun] "monofun(Iwhen(f))"
  50.126 +qed_goalw "monofun_Iwhen2" thy [monofun] "monofun(Iwhen(f))"
  50.127   (fn prems =>
  50.128          [
  50.129          (strip_tac 1),
  50.130 @@ -117,7 +128,7 @@
  50.131          (etac monofun_cfun_fun 1)
  50.132          ]);
  50.133  
  50.134 -qed_goalw "monofun_Iwhen3" Ssum2.thy [monofun] "monofun(Iwhen(f)(g))"
  50.135 +qed_goalw "monofun_Iwhen3" thy [monofun] "monofun(Iwhen(f)(g))"
  50.136   (fn prems =>
  50.137          [
  50.138          (strip_tac 1),
  50.139 @@ -158,14 +169,11 @@
  50.140          ]);
  50.141  
  50.142  
  50.143 -
  50.144 -
  50.145  (* ------------------------------------------------------------------------ *)
  50.146  (* some kind of exhaustion rules for chains in 'a ++ 'b                     *)
  50.147  (* ------------------------------------------------------------------------ *)
  50.148  
  50.149 -
  50.150 -qed_goal "ssum_lemma1" Ssum2.thy 
  50.151 +qed_goal "ssum_lemma1" thy 
  50.152  "[|~(!i.? x.Y(i::nat)=Isinl(x))|] ==> (? i.! x.Y(i)~=Isinl(x))"
  50.153   (fn prems =>
  50.154          [
  50.155 @@ -173,7 +181,7 @@
  50.156          (fast_tac HOL_cs 1)
  50.157          ]);
  50.158  
  50.159 -qed_goal "ssum_lemma2" Ssum2.thy 
  50.160 +qed_goal "ssum_lemma2" thy 
  50.161  "[|(? i.!x.(Y::nat => 'a++'b)(i::nat)~=Isinl(x::'a))|] ==>\
  50.162  \   (? i y. (Y::nat => 'a++'b)(i::nat)=Isinr(y::'b) & y~=UU)"
  50.163   (fn prems =>
  50.164 @@ -189,7 +197,7 @@
  50.165          ]);
  50.166  
  50.167  
  50.168 -qed_goal "ssum_lemma3" Ssum2.thy 
  50.169 +qed_goal "ssum_lemma3" thy 
  50.170  "[|is_chain(Y);(? i x. Y(i)=Isinr(x::'b) & (x::'b)~=UU)|] ==>\
  50.171  \ (!i.? y.Y(i)=Isinr(y))"
  50.172   (fn prems =>
  50.173 @@ -222,7 +230,7 @@
  50.174          (atac 1)
  50.175          ]);
  50.176  
  50.177 -qed_goal "ssum_lemma4" Ssum2.thy 
  50.178 +qed_goal "ssum_lemma4" thy 
  50.179  "is_chain(Y) ==> (!i.? x.Y(i)=Isinl(x))|(!i.? y.Y(i)=Isinr(y))"
  50.180   (fn prems =>
  50.181          [
  50.182 @@ -240,7 +248,7 @@
  50.183  (* restricted surjectivity of Isinl                                         *)
  50.184  (* ------------------------------------------------------------------------ *)
  50.185  
  50.186 -qed_goal "ssum_lemma5" Ssum2.thy 
  50.187 +qed_goal "ssum_lemma5" thy 
  50.188  "z=Isinl(x)==> Isinl((Iwhen (LAM x.x) (LAM y.UU))(z)) = z"
  50.189   (fn prems =>
  50.190          [
  50.191 @@ -255,7 +263,7 @@
  50.192  (* restricted surjectivity of Isinr                                         *)
  50.193  (* ------------------------------------------------------------------------ *)
  50.194  
  50.195 -qed_goal "ssum_lemma6" Ssum2.thy 
  50.196 +qed_goal "ssum_lemma6" thy 
  50.197  "z=Isinr(x)==> Isinr((Iwhen (LAM y.UU) (LAM x.x))(z)) = z"
  50.198   (fn prems =>
  50.199          [
  50.200 @@ -270,7 +278,7 @@
  50.201  (* technical lemmas                                                         *)
  50.202  (* ------------------------------------------------------------------------ *)
  50.203  
  50.204 -qed_goal "ssum_lemma7" Ssum2.thy 
  50.205 +qed_goal "ssum_lemma7" thy 
  50.206  "[|Isinl(x) << z; x~=UU|] ==> ? y.z=Isinl(y) & y~=UU"
  50.207   (fn prems =>
  50.208          [
  50.209 @@ -288,7 +296,7 @@
  50.210          (atac 1)
  50.211          ]);
  50.212  
  50.213 -qed_goal "ssum_lemma8" Ssum2.thy 
  50.214 +qed_goal "ssum_lemma8" thy 
  50.215  "[|Isinr(x) << z; x~=UU|] ==> ? y.z=Isinr(y) & y~=UU"
  50.216   (fn prems =>
  50.217          [
  50.218 @@ -308,7 +316,7 @@
  50.219  (* the type 'a ++ 'b is a cpo in three steps                                *)
  50.220  (* ------------------------------------------------------------------------ *)
  50.221  
  50.222 -qed_goal "lub_ssum1a" Ssum2.thy 
  50.223 +qed_goal "lub_ssum1a" thy 
  50.224  "[|is_chain(Y);(!i.? x.Y(i)=Isinl(x))|] ==>\
  50.225  \ range(Y) <<|\
  50.226  \ Isinl(lub(range(%i.(Iwhen (LAM x.x) (LAM y.UU))(Y i))))"
  50.227 @@ -349,7 +357,7 @@
  50.228          ]);
  50.229  
  50.230  
  50.231 -qed_goal "lub_ssum1b" Ssum2.thy 
  50.232 +qed_goal "lub_ssum1b" thy 
  50.233  "[|is_chain(Y);(!i.? x.Y(i)=Isinr(x))|] ==>\
  50.234  \ range(Y) <<|\
  50.235  \ Isinr(lub(range(%i.(Iwhen (LAM y.UU) (LAM x.x))(Y i))))"
  50.236 @@ -404,7 +412,7 @@
  50.237   (lub (range (%i. Iwhen (LAM y. UU) (LAM x. x) (?Y1 i))))
  50.238  *)
  50.239  
  50.240 -qed_goal "cpo_ssum" Ssum2.thy 
  50.241 +qed_goal "cpo_ssum" thy 
  50.242          "is_chain(Y::nat=>'a ++'b) ==> ? x.range(Y) <<|x"
  50.243   (fn prems =>
  50.244          [
    51.1 --- a/src/HOLCF/Ssum2.thy	Sat Feb 15 18:24:05 1997 +0100
    51.2 +++ b/src/HOLCF/Ssum2.thy	Mon Feb 17 10:57:11 1997 +0100
    51.3 @@ -8,14 +8,7 @@
    51.4  
    51.5  Ssum2 = Ssum1 + 
    51.6  
    51.7 -arities "++" :: (pcpo,pcpo)po
    51.8 -(* Witness for the above arity axiom is ssum1.ML *)
    51.9 -
   51.10 -rules
   51.11 -
   51.12 -(* instance of << for type ['a ++ 'b]  *)
   51.13 -
   51.14 -inst_ssum_po    "((op <<)::['a ++ 'b,'a ++ 'b]=>bool) = less_ssum"
   51.15 +instance "++"::(pcpo,pcpo)po (refl_less_ssum,antisym_less_ssum,trans_less_ssum)
   51.16  
   51.17  end
   51.18  
    52.1 --- a/src/HOLCF/Ssum3.ML	Sat Feb 15 18:24:05 1997 +0100
    52.2 +++ b/src/HOLCF/Ssum3.ML	Mon Feb 17 10:57:11 1997 +0100
    52.3 @@ -8,11 +8,17 @@
    52.4  
    52.5  open Ssum3;
    52.6  
    52.7 +(* for compatibility with old HOLCF-Version *)
    52.8 +qed_goal "inst_ssum_pcpo" thy "UU = Isinl UU"
    52.9 + (fn prems => 
   52.10 +        [
   52.11 +        (simp_tac (HOL_ss addsimps [UU_def,UU_ssum_def]) 1)
   52.12 +        ]);
   52.13 +
   52.14  (* ------------------------------------------------------------------------ *)
   52.15  (* continuity for Isinl and Isinr                                           *)
   52.16  (* ------------------------------------------------------------------------ *)
   52.17  
   52.18 -
   52.19  qed_goal "contlub_Isinl" Ssum3.thy "contlub(Isinl)"
   52.20   (fn prems =>
   52.21          [
    53.1 --- a/src/HOLCF/Ssum3.thy	Sat Feb 15 18:24:05 1997 +0100
    53.2 +++ b/src/HOLCF/Ssum3.thy	Mon Feb 17 10:57:11 1997 +0100
    53.3 @@ -8,18 +8,13 @@
    53.4  
    53.5  Ssum3 = Ssum2 +
    53.6  
    53.7 -arities "++" :: (pcpo,pcpo)pcpo                 (* Witness ssum2.ML *)
    53.8 +instance "++" :: (pcpo,pcpo)pcpo (least_ssum,cpo_ssum)
    53.9  
   53.10  consts  
   53.11          sinl    :: "'a -> ('a++'b)" 
   53.12          sinr    :: "'b -> ('a++'b)" 
   53.13          sswhen  :: "('a->'c)->('b->'c)->('a ++ 'b)-> 'c"
   53.14  
   53.15 -rules 
   53.16 -
   53.17 -inst_ssum_pcpo  "(UU::'a++'b) = Isinl(UU)"
   53.18 -
   53.19 -
   53.20  defs
   53.21  
   53.22  sinl_def        "sinl   == (LAM x.Isinl(x))"
    54.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    54.2 +++ b/src/HOLCF/Tr.ML	Mon Feb 17 10:57:11 1997 +0100
    54.3 @@ -0,0 +1,187 @@
    54.4 +(*  Title:      HOLCF/Tr.ML
    54.5 +    ID:         $Id$
    54.6 +    Author:     Franz Regensburger
    54.7 +    Copyright   1993 Technische Universitaet Muenchen
    54.8 +
    54.9 +Lemmas for Tr.thy
   54.10 +*)
   54.11 +
   54.12 +open Tr;
   54.13 +
   54.14 +(* ------------------------------------------------------------------------ *)
   54.15 +(* Exhaustion and Elimination for type one                                  *)
   54.16 +(* ------------------------------------------------------------------------ *)
   54.17 +qed_goalw "Exh_tr" thy [FF_def,TT_def] "t=UU | t = TT | t = FF"
   54.18 + (fn prems =>
   54.19 +        [
   54.20 +	(lift.induct_tac "t" 1),
   54.21 +	(fast_tac HOL_cs 1),
   54.22 +	(fast_tac (HOL_cs addss !simpset) 1)
   54.23 +	]);
   54.24 +
   54.25 +qed_goal "trE" thy
   54.26 +        "[| p=UU ==> Q; p = TT ==>Q; p = FF ==>Q|] ==>Q"
   54.27 + (fn prems =>
   54.28 +        [
   54.29 +        (rtac (Exh_tr RS disjE) 1),
   54.30 +        (eresolve_tac prems 1),
   54.31 +        (etac disjE 1),
   54.32 +        (eresolve_tac prems 1),
   54.33 +        (eresolve_tac prems 1)
   54.34 +        ]);
   54.35 +
   54.36 +(* ------------------------------------------------------------------------ *) 
   54.37 +(* tactic for tr-thms with case split                                       *)
   54.38 +(* ------------------------------------------------------------------------ *)
   54.39 +
   54.40 +val tr_defs = [andalso_def,orelse_def,neg_def,ifte_def,TT_def,FF_def];
   54.41 +
   54.42 +fun prover t =  prove_goal thy t
   54.43 + (fn prems =>
   54.44 +        [
   54.45 +        (res_inst_tac [("p","y")] trE 1),
   54.46 +	(REPEAT(asm_simp_tac (!simpset addsimps 
   54.47 +		[o_def,flift1_def,flift2_def,inst_lift_po]@tr_defs) 1))
   54.48 +	]);
   54.49 +
   54.50 +(* ------------------------------------------------------------------------ *) 
   54.51 +(* distinctness for type tr                                                 *) 
   54.52 +(* ------------------------------------------------------------------------ *)
   54.53 +
   54.54 +val dist_less_tr = map prover [
   54.55 +			"~TT << UU",
   54.56 +			"~FF << UU",
   54.57 +			"~TT << FF",
   54.58 +			"~FF << TT"
   54.59 +                        ];
   54.60 +
   54.61 +val dist_eq_tr = map prover ["TT~=UU","FF~=UU","TT~=FF"];
   54.62 +val dist_eq_tr = dist_eq_tr @ (map (fn thm => (thm RS not_sym)) dist_eq_tr);
   54.63 +
   54.64 +(* ------------------------------------------------------------------------ *) 
   54.65 +(* lemmas about andalso, orelse, neg and if                                 *) 
   54.66 +(* ------------------------------------------------------------------------ *)
   54.67 +
   54.68 +val andalso_thms = map prover [
   54.69 +                        "(TT andalso y) = y",
   54.70 +                        "(FF andalso y) = FF",
   54.71 +                        "(UU andalso y) = UU",
   54.72 +			"(y andalso TT) = y",
   54.73 +		  	"(y andalso y) = y"
   54.74 +                        ];
   54.75 +
   54.76 +val orelse_thms = map prover [
   54.77 +                        "(TT orelse y) = TT",
   54.78 +                        "(FF orelse y) = y",
   54.79 +                        "(UU orelse y) = UU",
   54.80 +                        "(y orelse FF) = y",
   54.81 +			"(y orelse y) = y"];
   54.82 +
   54.83 +val neg_thms = map prover [
   54.84 +                        "neg`TT = FF",
   54.85 +                        "neg`FF = TT",
   54.86 +                        "neg`UU = UU"
   54.87 +                        ];
   54.88 +
   54.89 +val ifte_thms = map prover [
   54.90 +                        "If UU then e1 else e2 fi = UU",
   54.91 +                        "If FF then e1 else e2 fi = e2",
   54.92 +                        "If TT then e1 else e2 fi = e1"];
   54.93 +
   54.94 +Addsimps (dist_less_tr @ dist_eq_tr @ andalso_thms @ 
   54.95 +	  orelse_thms @ neg_thms @ ifte_thms);
   54.96 +
   54.97 +
   54.98 +                
   54.99 +(* --------------------------------------------------------- *)
  54.100 +(*                Theroems for the liftings                  *)
  54.101 +(* --------------------------------------------------------- *)
  54.102 +
  54.103 +
  54.104 +(* --------------------------------------------------------- *)
  54.105 +(*                Admissibility tactic and tricks            *)
  54.106 +(* --------------------------------------------------------- *)
  54.107 +
  54.108 +
  54.109 +goal thy "x~=FF = (x=TT|x=UU)";
  54.110 +by (res_inst_tac [("p","x")] trE 1);
  54.111 +  by (TRYALL (Asm_full_simp_tac));
  54.112 +qed"adm_trick_1";
  54.113 +
  54.114 +goal thy "x~=TT = (x=FF|x=UU)";
  54.115 +by (res_inst_tac [("p","x")] trE 1);
  54.116 +  by (TRYALL (Asm_full_simp_tac));
  54.117 +qed"adm_trick_2";
  54.118 +
  54.119 +val adm_tricks = [adm_trick_1,adm_trick_2];
  54.120 +
  54.121 +(*val adm_tac = (fn i => ((resolve_tac adm_lemmas i)));*)
  54.122 +(*val adm_tacR = (fn i => (REPEAT (adm_tac i)));*)
  54.123 +(*val adm_cont_tac = (fn i => ((adm_tacR i) THEN (cont_tacR i)));*)
  54.124 +
  54.125 +(* ----------------------------------------------------------------- *)
  54.126 +(*     Relations between domains and terms using lift constructs     *)
  54.127 +(* ----------------------------------------------------------------- *)
  54.128 +
  54.129 +goal thy "!!t.[|t~=UU|]==> ((t andalso s)~=FF)=(t~=FF & s~=FF)";
  54.130 +by (rtac iffI 1);
  54.131 +(* 1 *)
  54.132 +by (res_inst_tac [("p","t")] trE 1);
  54.133 +by (fast_tac HOL_cs 1);
  54.134 +by (res_inst_tac [("p","s")] trE 1);
  54.135 +by (Asm_full_simp_tac 1);
  54.136 +by (Asm_full_simp_tac 1);
  54.137 +by (subgoal_tac "(t andalso s) = FF" 1);
  54.138 +by (fast_tac HOL_cs 1);
  54.139 +by (Asm_full_simp_tac 1);
  54.140 +by (res_inst_tac [("p","s")] trE 1);
  54.141 +by (subgoal_tac "(t andalso s) = FF" 1);
  54.142 +by (fast_tac HOL_cs 1);
  54.143 +by (Asm_full_simp_tac 1);
  54.144 +by (subgoal_tac "(t andalso s) = FF" 1);
  54.145 +by (fast_tac HOL_cs 1);
  54.146 +by (Asm_full_simp_tac 1);
  54.147 +by (subgoal_tac "(t andalso s) = FF" 1);
  54.148 +by (fast_tac HOL_cs 1);
  54.149 +by (Asm_full_simp_tac 1);
  54.150 +(* 2*)
  54.151 +by (res_inst_tac [("p","t")] trE 1);
  54.152 +by (fast_tac HOL_cs 1);
  54.153 +by (Asm_full_simp_tac 1);
  54.154 +by (fast_tac HOL_cs 1);
  54.155 +qed"andalso_and";
  54.156 +
  54.157 +goal thy "Def x ~=UU";
  54.158 +by (Simp_tac 1);
  54.159 +qed"blift_not_UU";
  54.160 +
  54.161 +goal thy "(Def x ~=FF)= x";
  54.162 +by (simp_tac (!simpset addsimps [FF_def]) 1);
  54.163 +qed"blift_and_bool";
  54.164 +
  54.165 +goal thy "(Def x = TT) = x";
  54.166 +by (simp_tac (!simpset addsimps [TT_def]) 1);
  54.167 +qed"blift_and_bool2";
  54.168 +
  54.169 +goal thy "(Def x = FF) = (~x)";
  54.170 +by (simp_tac (!simpset addsimps [FF_def]) 1);
  54.171 +by (fast_tac HOL_cs 1);
  54.172 +qed"blift_and_bool3";
  54.173 +
  54.174 +goal thy "plift P`(Def y) = Def (P y)";
  54.175 +by (simp_tac (!simpset addsimps [plift_def,flift1_def]) 1);
  54.176 +qed"plift2blift";
  54.177 +
  54.178 +goal thy 
  54.179 +  "(If Def P then A else B fi)= (if P then A else B)";
  54.180 +by (res_inst_tac [("p","Def P")]  trE 1);
  54.181 +by (Asm_full_simp_tac 1);
  54.182 +by (asm_full_simp_tac (!simpset addsimps tr_defs@[flift1_def,o_def]) 1);
  54.183 +by (asm_full_simp_tac (!simpset addsimps tr_defs@[flift1_def,o_def]) 1);
  54.184 +qed"If_and_if";
  54.185 +
  54.186 +Addsimps [plift2blift,If_and_if,blift_not_UU,
  54.187 +	blift_and_bool,blift_and_bool2,blift_and_bool3];
  54.188 +
  54.189 +simpset := !simpset addsolver (K (DEPTH_SOLVE_1 o cont_tac));
  54.190 +
    55.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    55.2 +++ b/src/HOLCF/Tr.thy	Mon Feb 17 10:57:11 1997 +0100
    55.3 @@ -0,0 +1,54 @@
    55.4 +(*  Title:      HOLCF/Tr.thy
    55.5 +    ID:         $Id$
    55.6 +    Author:     Franz Regensburger
    55.7 +    Copyright   1993 Technische Universitaet Muenchen
    55.8 +
    55.9 +Introduce infix if_then_else_fi and boolean connectives andalso, orelse
   55.10 +*)
   55.11 +
   55.12 +Tr = Lift +
   55.13 +
   55.14 +types tr = "bool lift"
   55.15 +
   55.16 +consts
   55.17 +	TT,FF           :: "tr"
   55.18 +        Icifte          :: "tr -> 'c -> 'c -> 'c"
   55.19 +        trand           :: "tr -> tr -> tr"
   55.20 +        tror            :: "tr -> tr -> tr"
   55.21 +        neg             :: "tr -> tr"
   55.22 +        plift           :: "('a => bool) => 'a lift -> tr"
   55.23 +
   55.24 +syntax  "@cifte"        :: "tr=>'c=>'c=>'c" ("(3If _/ (then _/ else _) fi)" 60)
   55.25 +        "@andalso"      :: "tr => tr => tr" ("_ andalso _" [36,35] 35)
   55.26 +        "@orelse"       :: "tr => tr => tr" ("_ orelse _"  [31,30] 30)
   55.27 + 
   55.28 +translations 
   55.29 +	     "tr" ==(type) "bool lift" 
   55.30 +	     "x andalso y" == "trand`x`y"
   55.31 +             "x orelse y"  == "tror`x`y"
   55.32 +             "If b then e1 else e2 fi" == "Icifte`b`e1`e2"
   55.33 +defs
   55.34 +  TT_def      "TT==Def True"
   55.35 +  FF_def      "FF==Def False"
   55.36 +  neg_def     "neg == flift2 not"
   55.37 +  ifte_def    "Icifte == (LAM b t e.flift1(%b.if b then t else e)`b)"
   55.38 +  andalso_def "trand == (LAM x y.If x then y else FF fi)"
   55.39 +  orelse_def  "tror == (LAM x y.If x then TT else y fi)"
   55.40 +(* andalso, orelse are different from strict functions 
   55.41 +  andalso_def "trand == flift1(flift2 o (op &))"
   55.42 +  orelse_def  "tror == flift1(flift2 o (op |))"
   55.43 +*)
   55.44 +  plift_def   "plift p == (LAM x. flift1(%a.Def(p a))`x)"
   55.45 +
   55.46 +(* start 8bit 1 *)
   55.47 +syntax
   55.48 +  "GeqTT"        :: "tr => bool"               ("(\\<lceil>_\\<rceil>)")
   55.49 +  "GeqFF"        :: "tr => bool"               ("(\\<lfloor>_\\<rfloor>)")
   55.50 +
   55.51 +translations
   55.52 +  "\\<lceil>x\\<rceil>" == "x = TT"
   55.53 +  "\\<lfloor>x\\<rfloor>" == "x = FF"
   55.54 +(* end 8bit 1 *)
   55.55 +
   55.56 +end
   55.57 +
    56.1 --- a/src/HOLCF/Tr1.ML	Sat Feb 15 18:24:05 1997 +0100
    56.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    56.3 @@ -1,159 +0,0 @@
    56.4 -(*  Title:      HOLCF/tr1.ML
    56.5 -    ID:         $Id$
    56.6 -    Author:     Franz Regensburger
    56.7 -    Copyright   1993 Technische Universitaet Muenchen
    56.8 -
    56.9 -Lemmas for tr1.thy
   56.10 -*)
   56.11 -
   56.12 -open Tr1;
   56.13 -
   56.14 -(* -------------------------------------------------------------------------- *) 
   56.15 -(* distinctness for type tr                                                   *) 
   56.16 -(* -------------------------------------------------------------------------- *)
   56.17 -
   56.18 -val dist_less_tr = [
   56.19 -prove_goalw Tr1.thy [TT_def] "~TT << UU"
   56.20 - (fn prems =>
   56.21 -        [
   56.22 -        (rtac classical2 1),
   56.23 -        (rtac defined_sinl 1),
   56.24 -        (rtac not_less2not_eq 1),
   56.25 -        (rtac dist_less_one 1),
   56.26 -        (rtac (rep_tr_iso RS subst) 1),
   56.27 -        (rtac (rep_tr_iso RS subst) 1),
   56.28 -        (rtac cfun_arg_cong 1),
   56.29 -        (stac ((abs_tr_iso RS allI) RS ((rep_tr_iso RS allI) RS iso_strict )            RS conjunct2) 1),
   56.30 -        (etac (eq_UU_iff RS ssubst) 1)
   56.31 -        ]),
   56.32 -prove_goalw Tr1.thy [FF_def] "~FF << UU"
   56.33 - (fn prems =>
   56.34 -        [
   56.35 -        (rtac classical2 1),
   56.36 -        (rtac defined_sinr 1),
   56.37 -        (rtac not_less2not_eq 1),
   56.38 -        (rtac dist_less_one 1),
   56.39 -        (rtac (rep_tr_iso RS subst) 1),
   56.40 -        (rtac (rep_tr_iso RS subst) 1),
   56.41 -        (rtac cfun_arg_cong 1),
   56.42 -        (stac ((abs_tr_iso RS allI) RS ((rep_tr_iso RS allI) RS iso_strict )            RS conjunct2) 1),
   56.43 -        (etac (eq_UU_iff RS ssubst) 1)
   56.44 -        ]),
   56.45 -prove_goalw Tr1.thy [FF_def,TT_def] "~TT << FF"
   56.46 - (fn prems =>
   56.47 -        [
   56.48 -        (rtac classical2 1),
   56.49 -        (rtac (less_ssum4c RS iffD1) 2),
   56.50 -        (rtac not_less2not_eq 1),
   56.51 -        (rtac dist_less_one 1),
   56.52 -        (rtac (rep_tr_iso RS subst) 1),
   56.53 -        (rtac (rep_tr_iso RS subst) 1),
   56.54 -        (etac monofun_cfun_arg 1)
   56.55 -        ]),
   56.56 -prove_goalw Tr1.thy [FF_def,TT_def] "~FF << TT"
   56.57 - (fn prems =>
   56.58 -        [
   56.59 -        (rtac classical2 1),
   56.60 -        (rtac (less_ssum4d RS iffD1) 2),
   56.61 -        (rtac not_less2not_eq 1),
   56.62 -        (rtac dist_less_one 1),
   56.63 -        (rtac (rep_tr_iso RS subst) 1),
   56.64 -        (rtac (rep_tr_iso RS subst) 1),
   56.65 -        (etac monofun_cfun_arg 1)
   56.66 -        ])
   56.67 -];
   56.68 -
   56.69 -fun prover s =  prove_goal Tr1.thy s
   56.70 - (fn prems =>
   56.71 -        [
   56.72 -        (rtac not_less2not_eq 1),
   56.73 -        (resolve_tac dist_less_tr 1)
   56.74 -        ]);
   56.75 -
   56.76 -val dist_eq_tr = map prover ["TT~=UU","FF~=UU","TT~=FF"];
   56.77 -val dist_eq_tr = dist_eq_tr @ (map (fn thm => (thm RS not_sym)) dist_eq_tr);
   56.78 -
   56.79 -(* ------------------------------------------------------------------------ *) 
   56.80 -(* Exhaustion and elimination for type tr                                   *) 
   56.81 -(* ------------------------------------------------------------------------ *)
   56.82 -
   56.83 -qed_goalw "Exh_tr" Tr1.thy [FF_def,TT_def] "t=UU | t = TT | t = FF"
   56.84 - (fn prems =>
   56.85 -        [
   56.86 -        (res_inst_tac [("p","rep_tr`t")] ssumE 1),
   56.87 -        (rtac disjI1 1),
   56.88 -        (rtac ((abs_tr_iso RS allI) RS ((rep_tr_iso RS allI) RS iso_strict )
   56.89 -                  RS conjunct2 RS subst) 1),
   56.90 -        (rtac (abs_tr_iso RS subst) 1),
   56.91 -        (etac cfun_arg_cong 1),
   56.92 -        (rtac disjI2 1),
   56.93 -        (rtac disjI1 1),
   56.94 -        (rtac (abs_tr_iso RS subst) 1),
   56.95 -        (rtac cfun_arg_cong 1),
   56.96 -        (etac trans 1),
   56.97 -        (rtac cfun_arg_cong 1),
   56.98 -        (rtac (Exh_one RS disjE) 1),
   56.99 -        (contr_tac 1),
  56.100 -        (atac 1),
  56.101 -        (rtac disjI2 1),
  56.102 -        (rtac disjI2 1),
  56.103 -        (rtac (abs_tr_iso RS subst) 1),
  56.104 -        (rtac cfun_arg_cong 1),
  56.105 -        (etac trans 1),
  56.106 -        (rtac cfun_arg_cong 1),
  56.107 -        (rtac (Exh_one RS disjE) 1),
  56.108 -        (contr_tac 1),
  56.109 -        (atac 1)
  56.110 -        ]);
  56.111 -
  56.112 -
  56.113 -qed_goal "trE" Tr1.thy
  56.114 -        "[| p=UU ==> Q; p = TT ==>Q; p = FF ==>Q|] ==>Q"
  56.115 - (fn prems =>
  56.116 -        [
  56.117 -        (rtac (Exh_tr RS disjE) 1),
  56.118 -        (eresolve_tac prems 1),
  56.119 -        (etac disjE 1),
  56.120 -        (eresolve_tac prems 1),
  56.121 -        (eresolve_tac prems 1)
  56.122 -        ]);
  56.123 -
  56.124 -
  56.125 -(* ------------------------------------------------------------------------ *) 
  56.126 -(* type tr is flat                                                          *) 
  56.127 -(* ------------------------------------------------------------------------ *)
  56.128 -
  56.129 -qed_goalw "flat_tr" Tr1.thy [flat_def] "flat TT"
  56.130 - (fn prems =>
  56.131 -        [
  56.132 -        (rtac allI 1),
  56.133 -        (rtac allI 1),
  56.134 -        (res_inst_tac [("p","x")] trE 1),
  56.135 -        (Asm_simp_tac 1),
  56.136 -        (res_inst_tac [("p","y")] trE 1),
  56.137 -        (asm_simp_tac (!simpset addsimps dist_less_tr) 1),
  56.138 -        (asm_simp_tac (!simpset addsimps dist_less_tr) 1),
  56.139 -        (asm_simp_tac (!simpset addsimps dist_less_tr) 1),
  56.140 -        (res_inst_tac [("p","y")] trE 1),
  56.141 -        (asm_simp_tac (!simpset addsimps dist_less_tr) 1),
  56.142 -        (asm_simp_tac (!simpset addsimps dist_less_tr) 1),
  56.143 -        (asm_simp_tac (!simpset addsimps dist_less_tr) 1)
  56.144 -        ]);
  56.145 -
  56.146 -
  56.147 -(* ------------------------------------------------------------------------ *) 
  56.148 -(* properties of tr_when                                                    *) 
  56.149 -(* ------------------------------------------------------------------------ *)
  56.150 -
  56.151 -fun prover s = prove_goalw Tr1.thy [tr_when_def,TT_def,FF_def] s (fn prems => [
  56.152 -        (Simp_tac 1),
  56.153 -        (simp_tac (!simpset addsimps [rep_tr_iso,
  56.154 -                (abs_tr_iso RS allI) RS ((rep_tr_iso RS allI) 
  56.155 -                RS iso_strict) RS conjunct1]) 1)]);
  56.156 -
  56.157 -val tr_when = map prover [
  56.158 -                        "tr_when`x`y`UU = UU",
  56.159 -                        "tr_when`x`y`TT = x",
  56.160 -                        "tr_when`x`y`FF = y"
  56.161 -                        ];
  56.162 -
    57.1 --- a/src/HOLCF/Tr1.thy	Sat Feb 15 18:24:05 1997 +0100
    57.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    57.3 @@ -1,45 +0,0 @@
    57.4 -(*  Title:      HOLCF/tr1.thy
    57.5 -    ID:         $Id$
    57.6 -    Author:     Franz Regensburger
    57.7 -    Copyright   1993 Technische Universitaet Muenchen
    57.8 -
    57.9 -Introduce the domain of truth values tr = one ++ one
   57.10 -
   57.11 -The type is axiomatized as the least solution of a domain equation.
   57.12 -The functor term that specifies the domain equation is: 
   57.13 -
   57.14 -  FT = <++,K_{one},K_{one}>
   57.15 -
   57.16 -For details see chapter 5 of:
   57.17 -
   57.18 -[Franz Regensburger] HOLCF: Eine konservative Erweiterung von HOL um LCF,
   57.19 -                     Dissertation, Technische Universit"at M"unchen, 1994
   57.20 -
   57.21 -*)
   57.22 -
   57.23 -Tr1 = One +
   57.24 -
   57.25 -types tr 0
   57.26 -arities tr :: pcpo
   57.27 -
   57.28 -consts
   57.29 -        abs_tr          :: "one ++ one -> tr"
   57.30 -        rep_tr          :: "tr -> one ++ one"
   57.31 -        TT              :: "tr"
   57.32 -        FF              :: "tr"
   57.33 -        tr_when         :: "'c -> 'c -> tr -> 'c"
   57.34 -
   57.35 -rules
   57.36 -
   57.37 -  abs_tr_iso    "abs_tr`(rep_tr`u) = u"
   57.38 -  rep_tr_iso    "rep_tr`(abs_tr`x) = x"
   57.39 -
   57.40 -defs
   57.41 -
   57.42 -  TT_def        "TT == abs_tr`(sinl`one)"
   57.43 -  FF_def        "FF == abs_tr`(sinr`one)"
   57.44 -
   57.45 -  tr_when_def "tr_when == 
   57.46 -        (LAM e1 e2 t. sswhen`(LAM x.e1)`(LAM y.e2)`(rep_tr`t))"
   57.47 -
   57.48 -end
    58.1 --- a/src/HOLCF/Tr2.ML	Sat Feb 15 18:24:05 1997 +0100
    58.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    58.3 @@ -1,99 +0,0 @@
    58.4 -(*  Title:      HOLCF/tr2.ML
    58.5 -    ID:         $Id$
    58.6 -    Author:     Franz Regensburger
    58.7 -    Copyright   1993 Technische Universitaet Muenchen
    58.8 -
    58.9 -Lemmas for Tr2.thy
   58.10 -*)
   58.11 -
   58.12 -open Tr2;
   58.13 -
   58.14 -(* ------------------------------------------------------------------------ *) 
   58.15 -(* lemmas about andalso                                                     *) 
   58.16 -(* ------------------------------------------------------------------------ *)
   58.17 -
   58.18 -fun prover s =  prove_goalw Tr2.thy [andalso_def] s
   58.19 - (fn prems =>
   58.20 -        [
   58.21 -        (simp_tac (!simpset addsimps tr_when) 1)
   58.22 -        ]);
   58.23 -
   58.24 -val andalso_thms = map prover [
   58.25 -                        "(TT andalso y) = y",
   58.26 -                        "(FF andalso y) = FF",
   58.27 -                        "(UU andalso y) = UU"
   58.28 -                        ];
   58.29 -
   58.30 -val andalso_thms = andalso_thms @ 
   58.31 - [prove_goalw Tr2.thy [andalso_def] "(x andalso TT) =  x"
   58.32 - (fn prems =>
   58.33 -        [
   58.34 -        (res_inst_tac [("p","x")] trE 1),
   58.35 -        (asm_simp_tac (!simpset addsimps tr_when) 1),
   58.36 -        (asm_simp_tac (!simpset addsimps tr_when) 1),
   58.37 -        (asm_simp_tac (!simpset addsimps tr_when) 1)
   58.38 -        ])];
   58.39 -
   58.40 -(* ------------------------------------------------------------------------ *) 
   58.41 -(* lemmas about orelse                                                      *) 
   58.42 -(* ------------------------------------------------------------------------ *)
   58.43 -
   58.44 -fun prover s =  prove_goalw Tr2.thy [orelse_def] s
   58.45 - (fn prems =>
   58.46 -        [
   58.47 -        (simp_tac (!simpset addsimps tr_when) 1)
   58.48 -        ]);
   58.49 -
   58.50 -val orelse_thms = map prover [
   58.51 -                        "(TT orelse y)  = TT",
   58.52 -                        "(FF orelse y) =  y",
   58.53 -                        "(UU orelse y) = UU"
   58.54 -                        ];
   58.55 -
   58.56 -val orelse_thms = orelse_thms @ 
   58.57 - [prove_goalw Tr2.thy [orelse_def] "(x orelse FF) =  x"
   58.58 - (fn prems =>
   58.59 -        [
   58.60 -        (res_inst_tac [("p","x")] trE 1),
   58.61 -        (asm_simp_tac (!simpset addsimps tr_when) 1),
   58.62 -        (asm_simp_tac (!simpset addsimps tr_when) 1),
   58.63 -        (asm_simp_tac (!simpset addsimps tr_when) 1)
   58.64 -        ])];
   58.65 -
   58.66 -
   58.67 -(* ------------------------------------------------------------------------ *) 
   58.68 -(* lemmas about neg                                                         *) 
   58.69 -(* ------------------------------------------------------------------------ *)
   58.70 -
   58.71 -fun prover s =  prove_goalw Tr2.thy [neg_def] s
   58.72 - (fn prems =>
   58.73 -        [
   58.74 -        (simp_tac (!simpset addsimps tr_when) 1)
   58.75 -        ]);
   58.76 -
   58.77 -val neg_thms = map prover [
   58.78 -                        "neg`TT = FF",
   58.79 -                        "neg`FF = TT",
   58.80 -                        "neg`UU = UU"
   58.81 -                        ];
   58.82 -
   58.83 -(* ------------------------------------------------------------------------ *) 
   58.84 -(* lemmas about If_then_else_fi                                             *) 
   58.85 -(* ------------------------------------------------------------------------ *)
   58.86 -
   58.87 -fun prover s =  prove_goalw Tr2.thy [ifte_def] s
   58.88 - (fn prems =>
   58.89 -        [
   58.90 -        (simp_tac (!simpset addsimps tr_when) 1)
   58.91 -        ]);
   58.92 -
   58.93 -val ifte_thms = map prover [
   58.94 -                        "If UU then e1 else e2 fi = UU",
   58.95 -                        "If FF then e1 else e2 fi = e2",
   58.96 -                        "If TT then e1 else e2 fi = e1"];
   58.97 -
   58.98 -Addsimps (dist_less_tr @ dist_eq_tr @ tr_when @ andalso_thms @ 
   58.99 -	  orelse_thms @ neg_thms @ ifte_thms);
  58.100 -
  58.101 -
  58.102 -                
    59.1 --- a/src/HOLCF/Tr2.thy	Sat Feb 15 18:24:05 1997 +0100
    59.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    59.3 @@ -1,33 +0,0 @@
    59.4 -(*  Title:      HOLCF/tr2.thy
    59.5 -    ID:         $Id$
    59.6 -    Author:     Franz Regensburger
    59.7 -    Copyright   1993 Technische Universitaet Muenchen
    59.8 -
    59.9 -Introduce infix if_then_else_fi and boolean connectives andalso, orelse
   59.10 -*)
   59.11 -
   59.12 -Tr2 = Tr1 +
   59.13 -
   59.14 -consts
   59.15 -        Icifte          :: "tr -> 'c -> 'c -> 'c"
   59.16 -        trand           :: "tr -> tr -> tr"
   59.17 -        tror            :: "tr -> tr -> tr"
   59.18 -        neg             :: "tr -> tr"
   59.19 -
   59.20 -syntax  "@cifte"        :: "tr=>'c=>'c=>'c"
   59.21 -                             ("(3If _/ (then _/ else _) fi)" 60)
   59.22 -        "@andalso"      :: "tr => tr => tr" ("_ andalso _" [36,35] 35)
   59.23 -        "@orelse"       :: "tr => tr => tr" ("_ orelse _"  [31,30] 30)
   59.24 - 
   59.25 -translations "x andalso y" == "trand`x`y"
   59.26 -             "x orelse y"  == "tror`x`y"
   59.27 -             "If b then e1 else e2 fi" == "Icifte`b`e1`e2"
   59.28 -              
   59.29 -defs
   59.30 -
   59.31 -  ifte_def    "Icifte == (LAM t e1 e2.tr_when`e1`e2`t)"
   59.32 -  andalso_def "trand == (LAM t1 t2.tr_when`t2`FF`t1)"
   59.33 -  orelse_def  "tror  == (LAM t1 t2.tr_when`TT`t2`t1)"
   59.34 -  neg_def     "neg == (LAM t. tr_when`FF`TT`t)"
   59.35 -
   59.36 -end
    60.1 --- a/src/HOLCF/Up1.ML	Sat Feb 15 18:24:05 1997 +0100
    60.2 +++ b/src/HOLCF/Up1.ML	Mon Feb 17 10:57:11 1997 +0100
    60.3 @@ -6,15 +6,21 @@
    60.4  
    60.5  open Up1;
    60.6  
    60.7 -qed_goalw "Exh_Up" Up1.thy [UU_up_def,Iup_def ]
    60.8 -        "z = UU_up | (? x. z = Iup(x))"
    60.9 +qed_goal "Abs_Up_inverse2" thy "Rep_Up (Abs_Up y) = y"
   60.10 + (fn prems =>
   60.11 +        [
   60.12 +	(simp_tac (!simpset addsimps [Up_def,Abs_Up_inverse]) 1)
   60.13 +	]);
   60.14 +
   60.15 +qed_goalw "Exh_Up" thy [Iup_def ]
   60.16 +        "z = Abs_Up(Inl ()) | (? x. z = Iup x)"
   60.17   (fn prems =>
   60.18          [
   60.19          (rtac (Rep_Up_inverse RS subst) 1),
   60.20 -        (res_inst_tac [("s","Rep_Up(z)")] sumE 1),
   60.21 +        (res_inst_tac [("s","Rep_Up z")] sumE 1),
   60.22          (rtac disjI1 1),
   60.23          (res_inst_tac [("f","Abs_Up")] arg_cong 1),
   60.24 -        (rtac (unique_void2 RS subst) 1),
   60.25 +        (rtac (unit_eq RS subst) 1),
   60.26          (atac 1),
   60.27          (rtac disjI2 1),
   60.28          (rtac exI 1),
   60.29 @@ -22,21 +28,21 @@
   60.30          (atac 1)
   60.31          ]);
   60.32  
   60.33 -qed_goal "inj_Abs_Up" Up1.thy "inj(Abs_Up)"
   60.34 +qed_goal "inj_Abs_Up" thy "inj(Abs_Up)"
   60.35   (fn prems =>
   60.36          [
   60.37          (rtac inj_inverseI 1),
   60.38 -        (rtac Abs_Up_inverse 1)
   60.39 +        (rtac Abs_Up_inverse2 1)
   60.40          ]);
   60.41  
   60.42 -qed_goal "inj_Rep_Up" Up1.thy "inj(Rep_Up)"
   60.43 +qed_goal "inj_Rep_Up" thy "inj(Rep_Up)"
   60.44   (fn prems =>
   60.45          [
   60.46          (rtac inj_inverseI 1),
   60.47          (rtac Rep_Up_inverse 1)
   60.48          ]);
   60.49  
   60.50 -qed_goalw "inject_Iup" Up1.thy [Iup_def] "Iup(x)=Iup(y) ==> x=y"
   60.51 +qed_goalw "inject_Iup" thy [Iup_def] "Iup x=Iup y ==> x=y"
   60.52   (fn prems =>
   60.53          [
   60.54          (cut_facts_tac prems 1),
   60.55 @@ -45,7 +51,7 @@
   60.56          (atac 1)
   60.57          ]);
   60.58  
   60.59 -qed_goalw "defined_Iup" Up1.thy [Iup_def,UU_up_def] "Iup(x)~=UU_up"
   60.60 +qed_goalw "defined_Iup" thy [Iup_def] "Iup x~=Abs_Up(Inl ())"
   60.61   (fn prems =>
   60.62          [
   60.63          (rtac notI 1),
   60.64 @@ -56,8 +62,8 @@
   60.65          ]);
   60.66  
   60.67  
   60.68 -qed_goal "upE"  Up1.thy
   60.69 -        "[| p=UU_up ==> Q; !!x. p=Iup(x)==>Q|] ==>Q"
   60.70 +qed_goal "upE"  thy
   60.71 +        "[| p=Abs_Up(Inl ()) ==> Q; !!x. p=Iup(x)==>Q|] ==>Q"
   60.72   (fn prems =>
   60.73          [
   60.74          (rtac (Exh_Up RS disjE) 1),
   60.75 @@ -66,62 +72,62 @@
   60.76          (eresolve_tac prems 1)
   60.77          ]);
   60.78  
   60.79 -qed_goalw "Ifup1"  Up1.thy [Ifup_def,UU_up_def]
   60.80 -        "Ifup(f)(UU_up)=UU"
   60.81 +qed_goalw "Ifup1"  thy [Ifup_def]
   60.82 +        "Ifup(f)(Abs_Up(Inl ()))=UU"
   60.83   (fn prems =>
   60.84          [
   60.85 -        (stac Abs_Up_inverse 1),
   60.86 +        (stac Abs_Up_inverse2 1),
   60.87          (stac sum_case_Inl 1),
   60.88          (rtac refl 1)
   60.89          ]);
   60.90  
   60.91 -qed_goalw "Ifup2"  Up1.thy [Ifup_def,Iup_def]
   60.92 +qed_goalw "Ifup2"  thy [Ifup_def,Iup_def]
   60.93          "Ifup(f)(Iup(x))=f`x"
   60.94   (fn prems =>
   60.95          [
   60.96 -        (stac Abs_Up_inverse 1),
   60.97 +        (stac Abs_Up_inverse2 1),
   60.98          (stac sum_case_Inr 1),
   60.99          (rtac refl 1)
  60.100          ]);
  60.101  
  60.102  val Up0_ss = (simpset_of "Cfun3") addsimps [Ifup1,Ifup2];
  60.103  
  60.104 -qed_goalw "less_up1a"  Up1.thy [less_up_def,UU_up_def]
  60.105 -        "less_up(UU_up)(z)"
  60.106 +qed_goalw "less_up1a"  thy [less_up_def]
  60.107 +        "less(Abs_Up(Inl ()))(z)"
  60.108   (fn prems =>
  60.109          [
  60.110 -        (stac Abs_Up_inverse 1),
  60.111 +        (stac Abs_Up_inverse2 1),
  60.112          (stac sum_case_Inl 1),
  60.113          (rtac TrueI 1)
  60.114          ]);
  60.115  
  60.116 -qed_goalw "less_up1b"  Up1.thy [Iup_def,less_up_def,UU_up_def]
  60.117 -        "~less_up (Iup x) UU_up"
  60.118 +qed_goalw "less_up1b" thy [Iup_def,less_up_def]
  60.119 +        "~less (Iup x) (Abs_Up(Inl ()))"
  60.120   (fn prems =>
  60.121          [
  60.122          (rtac notI 1),
  60.123          (rtac iffD1 1),
  60.124          (atac 2),
  60.125 -        (stac Abs_Up_inverse 1),
  60.126 -        (stac Abs_Up_inverse 1),
  60.127 +        (stac Abs_Up_inverse2 1),
  60.128 +        (stac Abs_Up_inverse2 1),
  60.129          (stac sum_case_Inr 1),
  60.130          (stac sum_case_Inl 1),
  60.131          (rtac refl 1)
  60.132          ]);
  60.133  
  60.134 -qed_goalw "less_up1c"  Up1.thy [Iup_def,less_up_def,UU_up_def]
  60.135 -        "less_up (Iup x) (Iup y)=(x<<y)"
  60.136 +qed_goalw "less_up1c"  thy [Iup_def,less_up_def]
  60.137 +        "less (Iup x) (Iup y)=(x<<y)"
  60.138   (fn prems =>
  60.139          [
  60.140 -        (stac Abs_Up_inverse 1),
  60.141 -        (stac Abs_Up_inverse 1),
  60.142 +        (stac Abs_Up_inverse2 1),
  60.143 +        (stac Abs_Up_inverse2 1),
  60.144          (stac sum_case_Inr 1),
  60.145          (stac sum_case_Inr 1),
  60.146          (rtac refl 1)
  60.147          ]);
  60.148  
  60.149  
  60.150 -qed_goal "refl_less_up"  Up1.thy "less_up p p"
  60.151 +qed_goal "refl_less_up"  thy "less (p::'a u) p"
  60.152   (fn prems =>
  60.153          [
  60.154          (res_inst_tac [("p","p")] upE 1),
  60.155 @@ -132,8 +138,8 @@
  60.156          (rtac refl_less 1)
  60.157          ]);
  60.158  
  60.159 -qed_goal "antisym_less_up"  Up1.thy 
  60.160 -        "!!p1. [|less_up p1 p2;less_up p2 p1|] ==> p1=p2"
  60.161 +qed_goal "antisym_less_up"  thy 
  60.162 +        "!!p1.[|less(p1::'a u) p2;less p2 p1|] ==> p1=p2"
  60.163   (fn _ =>
  60.164          [
  60.165          (res_inst_tac [("p","p1")] upE 1),
  60.166 @@ -141,13 +147,13 @@
  60.167          (res_inst_tac [("p","p2")] upE 1),
  60.168          (etac sym 1),
  60.169          (hyp_subst_tac 1),
  60.170 -        (res_inst_tac [("P","less_up (Iup x) UU_up")] notE 1),
  60.171 +        (res_inst_tac [("P","less (Iup x) (Abs_Up(Inl ()))")] notE 1),
  60.172          (rtac less_up1b 1),
  60.173          (atac 1),
  60.174          (hyp_subst_tac 1),
  60.175          (res_inst_tac [("p","p2")] upE 1),
  60.176          (hyp_subst_tac 1),
  60.177 -        (res_inst_tac [("P","less_up (Iup x) UU_up")] notE 1),
  60.178 +        (res_inst_tac [("P","less (Iup x) (Abs_Up(Inl ()))")] notE 1),
  60.179          (rtac less_up1b 1),
  60.180          (atac 1),
  60.181          (hyp_subst_tac 1),
  60.182 @@ -157,8 +163,8 @@
  60.183          (etac (less_up1c RS iffD1) 1)
  60.184          ]);
  60.185  
  60.186 -qed_goal "trans_less_up"  Up1.thy 
  60.187 -        "[|less_up p1 p2;less_up p2 p3|] ==> less_up p1 p3"
  60.188 +qed_goal "trans_less_up"  thy 
  60.189 +        "[|less (p1::'a u) p2;less p2 p3|] ==> less p1 p3"
  60.190   (fn prems =>
  60.191          [
  60.192          (cut_facts_tac prems 1),
    61.1 --- a/src/HOLCF/Up1.thy	Sat Feb 15 18:24:05 1997 +0100
    61.2 +++ b/src/HOLCF/Up1.thy	Mon Feb 17 10:57:11 1997 +0100
    61.3 @@ -12,40 +12,17 @@
    61.4  
    61.5  (* new type for lifting *)
    61.6  
    61.7 -types "u" 1
    61.8 -
    61.9 -arities "u" :: (pcpo)term       
   61.10 +typedef (Up) ('a) "u" = "{x::(unit + 'a).True}"
   61.11  
   61.12  consts
   61.13 -
   61.14 -  Rep_Up      :: "('a)u => (void + 'a)"
   61.15 -  Abs_Up      :: "(void + 'a) => ('a)u"
   61.16 -
   61.17    Iup         :: "'a => ('a)u"
   61.18 -  UU_up       :: "('a)u"
   61.19    Ifup        :: "('a->'b)=>('a)u => 'b"
   61.20 -  less_up     :: "('a)u => ('a)u => bool"
   61.21 -
   61.22 -rules
   61.23 -
   61.24 -  (*faking a type definition... *)
   61.25 -  (* ('a)u is isomorphic to void + 'a  *)
   61.26 -
   61.27 -  Rep_Up_inverse  "Abs_Up(Rep_Up(p)) = p"     
   61.28 -  Abs_Up_inverse  "Rep_Up(Abs_Up(p)) = p"
   61.29 -
   61.30 -   (*defining the abstract constants*)
   61.31  
   61.32  defs
   61.33 -
   61.34 -  UU_up_def   "UU_up == Abs_Up(Inl(UU))"
   61.35    Iup_def     "Iup x == Abs_Up(Inr(x))"
   61.36 -
   61.37    Ifup_def    "Ifup(f)(x)== case Rep_Up(x) of Inl(y) => UU | Inr(z) => f`z"
   61.38 - 
   61.39 -  less_up_def "less_up(x1)(x2) == (case Rep_Up(x1) of                 
   61.40 +  less_up_def "less == (%x1 x2.case Rep_Up(x1) of                 
   61.41                 Inl(y1) => True          
   61.42               | Inr(y2) => (case Rep_Up(x2) of Inl(z1) => False       
   61.43                                              | Inr(z2) => y2<<z2))"
   61.44 -
   61.45  end
    62.1 --- a/src/HOLCF/Up2.ML	Sat Feb 15 18:24:05 1997 +0100
    62.2 +++ b/src/HOLCF/Up2.ML	Mon Feb 17 10:57:11 1997 +0100
    62.3 @@ -3,52 +3,69 @@
    62.4      Author:     Franz Regensburger
    62.5      Copyright   1993 Technische Universitaet Muenchen
    62.6  
    62.7 -Lemmas for up2.thy 
    62.8 +Lemmas for Up2.thy 
    62.9  *)
   62.10  
   62.11  open Up2;
   62.12  
   62.13 +(* for compatibility with old HOLCF-Version *)
   62.14 +qed_goal "inst_up_po" thy "(op <<)=(%x1 x2.case Rep_Up(x1) of \               
   62.15 +\               Inl(y1) => True \
   62.16 +\             | Inr(y2) => (case Rep_Up(x2) of Inl(z1) => False \
   62.17 +\                                            | Inr(z2) => y2<<z2))"
   62.18 + (fn prems => 
   62.19 +        [
   62.20 +        (fold_goals_tac [po_def,less_up_def]),
   62.21 +        (rtac refl 1)
   62.22 +        ]);
   62.23 +
   62.24  (* -------------------------------------------------------------------------*)
   62.25  (* type ('a)u is pointed                                                    *)
   62.26  (* ------------------------------------------------------------------------ *)
   62.27  
   62.28 -qed_goal "minimal_up" Up2.thy "UU_up << z"
   62.29 +qed_goal "minimal_up" thy "Abs_Up(Inl ()) << z"
   62.30   (fn prems =>
   62.31          [
   62.32 -        (stac inst_up_po 1),
   62.33 -        (rtac less_up1a 1)
   62.34 +        (simp_tac (!simpset addsimps [po_def,less_up1a]) 1)
   62.35 +        ]);
   62.36 +
   62.37 +bind_thm ("UU_up_def",minimal_up RS minimal2UU RS sym);
   62.38 +
   62.39 +qed_goal "least_up" thy "? x::'a u.!y.x<<y"
   62.40 +(fn prems =>
   62.41 +        [
   62.42 +        (res_inst_tac [("x","Abs_Up(Inl ())")] exI 1),
   62.43 +        (rtac (minimal_up RS allI) 1)
   62.44          ]);
   62.45  
   62.46  (* -------------------------------------------------------------------------*)
   62.47  (* access to less_up in class po                                          *)
   62.48  (* ------------------------------------------------------------------------ *)
   62.49  
   62.50 -qed_goal "less_up2b" Up2.thy "~ Iup(x) << UU_up"
   62.51 +qed_goal "less_up2b" thy "~ Iup(x) << Abs_Up(Inl ())"
   62.52   (fn prems =>
   62.53          [
   62.54 -        (stac inst_up_po 1),
   62.55 -        (rtac less_up1b 1)
   62.56 +        (simp_tac (!simpset addsimps [po_def,less_up1b]) 1)
   62.57          ]);
   62.58  
   62.59 -qed_goal "less_up2c" Up2.thy "(Iup(x)<<Iup(y)) = (x<<y)"
   62.60 +qed_goal "less_up2c" thy "(Iup(x)<<Iup(y)) = (x<<y)"
   62.61   (fn prems =>
   62.62          [
   62.63 -        (stac inst_up_po 1),
   62.64 -        (rtac less_up1c 1)
   62.65 +        (simp_tac (!simpset addsimps [po_def,less_up1c]) 1)
   62.66          ]);
   62.67  
   62.68  (* ------------------------------------------------------------------------ *)
   62.69  (* Iup and Ifup are monotone                                               *)
   62.70  (* ------------------------------------------------------------------------ *)
   62.71  
   62.72 -qed_goalw "monofun_Iup" Up2.thy [monofun] "monofun(Iup)"
   62.73 +qed_goalw "monofun_Iup" thy [monofun] "monofun(Iup)"
   62.74   (fn prems =>
   62.75          [
   62.76          (strip_tac 1),
   62.77          (etac (less_up2c RS iffD2) 1)
   62.78          ]);
   62.79  
   62.80 -qed_goalw "monofun_Ifup1" Up2.thy [monofun] "monofun(Ifup)"
   62.81 +qed_goalw "monofun_Ifup1" thy [monofun] "monofun(Ifup)"
   62.82   (fn prems =>
   62.83          [
   62.84          (strip_tac 1),
   62.85 @@ -60,7 +77,7 @@
   62.86          (etac monofun_cfun_fun 1)
   62.87          ]);
   62.88  
   62.89 -qed_goalw "monofun_Ifup2" Up2.thy [monofun] "monofun(Ifup(f))"
   62.90 +qed_goalw "monofun_Ifup2" thy [monofun] "monofun(Ifup(f))"
   62.91   (fn prems =>
   62.92          [
   62.93          (strip_tac 1),
   62.94 @@ -82,8 +99,7 @@
   62.95  (* Some kind of surjectivity lemma                                          *)
   62.96  (* ------------------------------------------------------------------------ *)
   62.97  
   62.98 -
   62.99 -qed_goal "up_lemma1" Up2.thy  "z=Iup(x) ==> Iup(Ifup(LAM x.x)(z)) = z"
  62.100 +qed_goal "up_lemma1" thy  "z=Iup(x) ==> Iup(Ifup(LAM x.x)(z)) = z"
  62.101   (fn prems =>
  62.102          [
  62.103          (cut_facts_tac prems 1),
  62.104 @@ -94,7 +110,7 @@
  62.105  (* ('a)u is a cpo                                                           *)
  62.106  (* ------------------------------------------------------------------------ *)
  62.107  
  62.108 -qed_goal "lub_up1a" Up2.thy 
  62.109 +qed_goal "lub_up1a" thy 
  62.110  "[|is_chain(Y);? i x.Y(i)=Iup(x)|] ==>\
  62.111  \ range(Y) <<| Iup(lub(range(%i.(Ifup (LAM x.x) (Y(i))))))"
  62.112   (fn prems =>
  62.113 @@ -105,7 +121,7 @@
  62.114          (rtac ub_rangeI 1),
  62.115          (rtac allI 1),
  62.116          (res_inst_tac [("p","Y(i)")] upE 1),
  62.117 -        (res_inst_tac [("s","UU_up"),("t","Y(i)")] subst 1),
  62.118 +        (res_inst_tac [("s","Abs_Up (Inl ())"),("t","Y(i)")] subst 1),
  62.119          (etac sym 1),
  62.120          (rtac minimal_up 1),
  62.121          (res_inst_tac [("t","Y(i)")] (up_lemma1 RS subst) 1),
  62.122 @@ -117,7 +133,7 @@
  62.123          (res_inst_tac [("p","u")] upE 1),
  62.124          (etac exE 1),
  62.125          (etac exE 1),
  62.126 -        (res_inst_tac [("P","Y(i)<<UU_up")] notE 1),
  62.127 +        (res_inst_tac [("P","Y(i)<<Abs_Up (Inl ())")] notE 1),
  62.128          (res_inst_tac [("s","Iup(x)"),("t","Y(i)")] ssubst 1),
  62.129          (atac 1),
  62.130          (rtac less_up2b 1),
  62.131 @@ -131,9 +147,9 @@
  62.132          (etac (monofun_Ifup2 RS ub2ub_monofun) 1)
  62.133          ]);
  62.134  
  62.135 -qed_goal "lub_up1b" Up2.thy 
  62.136 +qed_goal "lub_up1b" thy 
  62.137  "[|is_chain(Y);!i x. Y(i)~=Iup(x)|] ==>\
  62.138 -\ range(Y) <<| UU_up"
  62.139 +\ range(Y) <<| Abs_Up (Inl ())"
  62.140   (fn prems =>
  62.141          [
  62.142          (cut_facts_tac prems 1),
  62.143 @@ -142,7 +158,7 @@
  62.144          (rtac ub_rangeI 1),
  62.145          (rtac allI 1),
  62.146          (res_inst_tac [("p","Y(i)")] upE 1),
  62.147 -        (res_inst_tac [("s","UU_up"),("t","Y(i)")] ssubst 1),
  62.148 +        (res_inst_tac [("s","Abs_Up (Inl ())"),("t","Y(i)")] ssubst 1),
  62.149          (atac 1),
  62.150          (rtac refl_less 1),
  62.151          (rtac notE 1),
  62.152 @@ -166,7 +182,7 @@
  62.153   lub (range ?Y1) = UU_up
  62.154  *)
  62.155  
  62.156 -qed_goal "cpo_up" Up2.thy 
  62.157 +qed_goal "cpo_up" thy 
  62.158          "is_chain(Y::nat=>('a)u) ==> ? x.range(Y) <<|x"
  62.159   (fn prems =>
  62.160          [
    63.1 --- a/src/HOLCF/Up2.thy	Sat Feb 15 18:24:05 1997 +0100
    63.2 +++ b/src/HOLCF/Up2.thy	Mon Feb 17 10:57:11 1997 +0100
    63.3 @@ -9,15 +9,7 @@
    63.4  
    63.5  Up2 = Up1 + 
    63.6  
    63.7 -(* Witness for the above arity axiom is up1.ML *)
    63.8 -
    63.9 -arities "u" :: (pcpo)po
   63.10 -
   63.11 -rules
   63.12 -
   63.13 -(* instance of << for type ('a)u  *)
   63.14 -
   63.15 -inst_up_po    "((op <<)::[('a)u,('a)u]=>bool) = less_up"
   63.16 +instance u :: (pcpo)po (refl_less_up,antisym_less_up,trans_less_up)
   63.17  
   63.18  end
   63.19  
    64.1 --- a/src/HOLCF/Up3.ML	Sat Feb 15 18:24:05 1997 +0100
    64.2 +++ b/src/HOLCF/Up3.ML	Mon Feb 17 10:57:11 1997 +0100
    64.3 @@ -8,18 +8,25 @@
    64.4  
    64.5  open Up3;
    64.6  
    64.7 +(* for compatibility with old HOLCF-Version *)
    64.8 +qed_goal "inst_up_pcpo" thy "UU = Abs_Up(Inl ())"
    64.9 + (fn prems => 
   64.10 +        [
   64.11 +        (simp_tac (HOL_ss addsimps [UU_def,UU_up_def]) 1)
   64.12 +        ]);
   64.13 +
   64.14  (* -------------------------------------------------------------------------*)
   64.15  (* some lemmas restated for class pcpo                                      *)
   64.16  (* ------------------------------------------------------------------------ *)
   64.17  
   64.18 -qed_goal "less_up3b" Up3.thy "~ Iup(x) << UU"
   64.19 +qed_goal "less_up3b" thy "~ Iup(x) << UU"
   64.20   (fn prems =>
   64.21          [
   64.22          (stac inst_up_pcpo 1),
   64.23          (rtac less_up2b 1)
   64.24          ]);
   64.25  
   64.26 -qed_goal "defined_Iup2" Up3.thy "Iup(x) ~= UU"
   64.27 +qed_goal "defined_Iup2" thy "Iup(x) ~= UU"
   64.28   (fn prems =>
   64.29          [
   64.30          (stac inst_up_pcpo 1),
   64.31 @@ -30,7 +37,7 @@
   64.32  (* continuity for Iup                                                       *)
   64.33  (* ------------------------------------------------------------------------ *)
   64.34  
   64.35 -qed_goal "contlub_Iup" Up3.thy "contlub(Iup)"
   64.36 +qed_goal "contlub_Iup" thy "contlub(Iup)"
   64.37   (fn prems =>
   64.38          [
   64.39          (rtac contlubI 1),
   64.40 @@ -47,7 +54,7 @@
   64.41          (asm_simp_tac Up0_ss 1)
   64.42          ]);
   64.43  
   64.44 -qed_goal "cont_Iup" Up3.thy "cont(Iup)"
   64.45 +qed_goal "cont_Iup" thy "cont(Iup)"
   64.46   (fn prems =>
   64.47          [
   64.48          (rtac monocontlub2cont 1),
   64.49 @@ -60,7 +67,7 @@
   64.50  (* continuity for Ifup                                                     *)
   64.51  (* ------------------------------------------------------------------------ *)
   64.52  
   64.53 -qed_goal "contlub_Ifup1" Up3.thy "contlub(Ifup)"
   64.54 +qed_goal "contlub_Ifup1" thy "contlub(Ifup)"
   64.55   (fn prems =>
   64.56          [
   64.57          (rtac contlubI 1),
   64.58 @@ -77,7 +84,7 @@
   64.59          ]);
   64.60  
   64.61  
   64.62 -qed_goal "contlub_Ifup2" Up3.thy "contlub(Ifup(f))"
   64.63 +qed_goal "contlub_Ifup2" thy "contlub(Ifup(f))"
   64.64   (fn prems =>
   64.65          [
   64.66          (rtac contlubI 1),
   64.67 @@ -124,7 +131,7 @@
   64.68          (atac 1)
   64.69          ]);
   64.70  
   64.71 -qed_goal "cont_Ifup1" Up3.thy "cont(Ifup)"
   64.72 +qed_goal "cont_Ifup1" thy "cont(Ifup)"
   64.73   (fn prems =>
   64.74          [
   64.75          (rtac monocontlub2cont 1),
   64.76 @@ -132,7 +139,7 @@
   64.77          (rtac contlub_Ifup1 1)
   64.78          ]);
   64.79  
   64.80 -qed_goal "cont_Ifup2" Up3.thy "cont(Ifup(f))"
   64.81 +qed_goal "cont_Ifup2" thy "cont(Ifup(f))"
   64.82   (fn prems =>
   64.83          [
   64.84          (rtac monocontlub2cont 1),
   64.85 @@ -145,7 +152,7 @@
   64.86  (* continuous versions of lemmas for ('a)u                                  *)
   64.87  (* ------------------------------------------------------------------------ *)
   64.88  
   64.89 -qed_goalw "Exh_Up1" Up3.thy [up_def] "z = UU | (? x. z = up`x)"
   64.90 +qed_goalw "Exh_Up1" thy [up_def] "z = UU | (? x. z = up`x)"
   64.91   (fn prems =>
   64.92          [
   64.93          (simp_tac (Up0_ss addsimps [cont_Iup]) 1),
   64.94 @@ -153,7 +160,7 @@
   64.95          (rtac Exh_Up 1)
   64.96          ]);
   64.97  
   64.98 -qed_goalw "inject_up" Up3.thy [up_def] "up`x=up`y ==> x=y"
   64.99 +qed_goalw "inject_up" thy [up_def] "up`x=up`y ==> x=y"
  64.100   (fn prems =>
  64.101          [
  64.102          (cut_facts_tac prems 1),
  64.103 @@ -163,14 +170,14 @@
  64.104          (simp_tac (Up0_ss addsimps [cont_Iup]) 1)
  64.105          ]);
  64.106  
  64.107 -qed_goalw "defined_up" Up3.thy [up_def] " up`x ~= UU"
  64.108 +qed_goalw "defined_up" thy [up_def] " up`x ~= UU"
  64.109   (fn prems =>
  64.110          [
  64.111          (simp_tac (Up0_ss addsimps [cont_Iup]) 1),
  64.112          (rtac defined_Iup2 1)
  64.113          ]);
  64.114  
  64.115 -qed_goalw "upE1" Up3.thy [up_def] 
  64.116 +qed_goalw "upE1" thy [up_def] 
  64.117          "[| p=UU ==> Q; !!x. p=up`x==>Q|] ==>Q"
  64.118   (fn prems =>
  64.119          [
  64.120 @@ -184,7 +191,7 @@
  64.121  val tac = (simp_tac (!simpset addsimps [cont_Iup,cont_Ifup1,
  64.122                  cont_Ifup2,cont2cont_CF1L]) 1);
  64.123  
  64.124 -qed_goalw "fup1" Up3.thy [up_def,fup_def] "fup`f`UU=UU"
  64.125 +qed_goalw "fup1" thy [up_def,fup_def] "fup`f`UU=UU"
  64.126   (fn prems =>
  64.127          [
  64.128          (stac inst_up_pcpo 1),
  64.129 @@ -195,7 +202,7 @@
  64.130          (simp_tac (Up0_ss addsimps [cont_Iup,cont_Ifup1,cont_Ifup2]) 1)
  64.131          ]);
  64.132  
  64.133 -qed_goalw "fup2" Up3.thy [up_def,fup_def] "fup`f`(up`x)=f`x"
  64.134 +qed_goalw "fup2" thy [up_def,fup_def] "fup`f`(up`x)=f`x"
  64.135   (fn prems =>
  64.136          [
  64.137          (stac beta_cfun 1),
  64.138 @@ -207,14 +214,14 @@
  64.139          (simp_tac (Up0_ss addsimps [cont_Iup,cont_Ifup1,cont_Ifup2]) 1)
  64.140          ]);
  64.141  
  64.142 -qed_goalw "less_up4b" Up3.thy [up_def,fup_def] "~ up`x << UU"
  64.143 +qed_goalw "less_up4b" thy [up_def,fup_def] "~ up`x << UU"
  64.144   (fn prems =>
  64.145          [
  64.146          (simp_tac (Up0_ss addsimps [cont_Iup]) 1),
  64.147          (rtac less_up3b 1)
  64.148          ]);
  64.149  
  64.150 -qed_goalw "less_up4c" Up3.thy [up_def,fup_def]
  64.151 +qed_goalw "less_up4c" thy [up_def,fup_def]
  64.152           "(up`x << up`y) = (x<<y)"
  64.153   (fn prems =>
  64.154          [
  64.155 @@ -222,7 +229,7 @@
  64.156          (rtac less_up2c 1)
  64.157          ]);
  64.158  
  64.159 -qed_goalw "thelub_up2a" Up3.thy [up_def,fup_def] 
  64.160 +qed_goalw "thelub_up2a" thy [up_def,fup_def] 
  64.161  "[| is_chain(Y); ? i x. Y(i) = up`x |] ==>\
  64.162  \      lub(range(Y)) = up`(lub(range(%i. fup`(LAM x. x)`(Y i))))"
  64.163   (fn prems =>
  64.164 @@ -247,7 +254,7 @@
  64.165  
  64.166  
  64.167  
  64.168 -qed_goalw "thelub_up2b" Up3.thy [up_def,fup_def] 
  64.169 +qed_goalw "thelub_up2b" thy [up_def,fup_def] 
  64.170  "[| is_chain(Y); ! i x. Y(i) ~= up`x |] ==> lub(range(Y)) = UU"
  64.171   (fn prems =>
  64.172          [
  64.173 @@ -267,7 +274,7 @@
  64.174          ]);
  64.175  
  64.176  
  64.177 -qed_goal "up_lemma2" Up3.thy  " (? x.z = up`x) = (z~=UU)"
  64.178 +qed_goal "up_lemma2" thy  " (? x.z = up`x) = (z~=UU)"
  64.179   (fn prems =>
  64.180          [
  64.181          (rtac iffI 1),
  64.182 @@ -281,7 +288,7 @@
  64.183          ]);
  64.184  
  64.185  
  64.186 -qed_goal "thelub_up2a_rev" Up3.thy  
  64.187 +qed_goal "thelub_up2a_rev" thy  
  64.188  "[| is_chain(Y); lub(range(Y)) = up`x |] ==> ? i x. Y(i) = up`x"
  64.189   (fn prems =>
  64.190          [
  64.191 @@ -295,7 +302,7 @@
  64.192          (atac 1)
  64.193          ]);
  64.194  
  64.195 -qed_goal "thelub_up2b_rev" Up3.thy  
  64.196 +qed_goal "thelub_up2b_rev" thy  
  64.197  "[| is_chain(Y); lub(range(Y)) = UU |] ==> ! i x.  Y(i) ~= up`x"
  64.198   (fn prems =>
  64.199          [
  64.200 @@ -308,7 +315,7 @@
  64.201          ]);
  64.202  
  64.203  
  64.204 -qed_goal "thelub_up3" Up3.thy  
  64.205 +qed_goal "thelub_up3" thy  
  64.206  "is_chain(Y) ==> lub(range(Y)) = UU |\
  64.207  \                lub(range(Y)) = up`(lub(range(%i. fup`(LAM x.x)`(Y i))))"
  64.208   (fn prems =>
  64.209 @@ -326,7 +333,7 @@
  64.210          (fast_tac HOL_cs 1)
  64.211          ]);
  64.212  
  64.213 -qed_goal "fup3" Up3.thy "fup`up`x=x"
  64.214 +qed_goal "fup3" thy "fup`up`x=x"
  64.215   (fn prems =>
  64.216          [
  64.217          (res_inst_tac [("p","x")] upE1 1),
    65.1 --- a/src/HOLCF/Up3.thy	Sat Feb 15 18:24:05 1997 +0100
    65.2 +++ b/src/HOLCF/Up3.thy	Mon Feb 17 10:57:11 1997 +0100
    65.3 @@ -10,22 +10,15 @@
    65.4  
    65.5  Up3 = Up2 +
    65.6  
    65.7 -arities "u" :: (pcpo)pcpo                       (* Witness up2.ML *)
    65.8 -
    65.9 -consts  
   65.10 -        up  :: "'a -> ('a)u" 
   65.11 -        fup :: "('a->'c)-> ('a)u -> 'c"
   65.12 +instance u :: (pcpo)pcpo      (least_up,cpo_up)
   65.13  
   65.14 -rules 
   65.15 -
   65.16 -        inst_up_pcpo  "(UU::('a)u) = UU_up"
   65.17 -
   65.18 -defs
   65.19 -        up_def   "up  == (LAM x.Iup(x))"
   65.20 -        fup_def  "fup == (LAM f p.Ifup(f)(p))"
   65.21 +constdefs  
   65.22 +        up  :: "'a -> ('a)u"
   65.23 +       "up  == (LAM x.Iup(x))"
   65.24 +        fup :: "('a->'c)-> ('a)u -> 'c"
   65.25 +       "fup == (LAM f p.Ifup(f)(p))"
   65.26  
   65.27  translations
   65.28 -
   65.29  "case l of up`x => t1" == "fup`(LAM x.t1)`l"
   65.30  
   65.31  end
    66.1 --- a/src/HOLCF/Void.ML	Sat Feb 15 18:24:05 1997 +0100
    66.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    66.3 @@ -1,69 +0,0 @@
    66.4 -(*  Title:      HOLCF/void.ML
    66.5 -    ID:         $Id$
    66.6 -    Author:     Franz Regensburger
    66.7 -    Copyright   1993  Technische Universitaet Muenchen
    66.8 -
    66.9 -Lemmas for void.thy.
   66.10 -
   66.11 -These lemmas are prototype lemmas for class porder 
   66.12 -see class theory porder.thy
   66.13 -*)
   66.14 -
   66.15 -open Void;
   66.16 -
   66.17 -(* ------------------------------------------------------------------------ *)
   66.18 -(* A non-emptyness result for Void                                          *)
   66.19 -(* ------------------------------------------------------------------------ *)
   66.20 -
   66.21 -qed_goalw "VoidI" Void.thy [UU_void_Rep_def,Void_def] 
   66.22 - " UU_void_Rep : Void"
   66.23 -(fn prems =>
   66.24 -        [
   66.25 -        (stac mem_Collect_eq 1),
   66.26 -        (rtac refl 1)
   66.27 -        ]);
   66.28 -
   66.29 -(* ------------------------------------------------------------------------ *)
   66.30 -(* less_void is a partial ordering on void                                  *)
   66.31 -(* ------------------------------------------------------------------------ *)
   66.32 -
   66.33 -qed_goalw "refl_less_void" Void.thy [ less_void_def ] "less_void x x"
   66.34 -(fn prems =>
   66.35 -        [
   66.36 -        (fast_tac HOL_cs 1)
   66.37 -        ]);
   66.38 -
   66.39 -qed_goalw "antisym_less_void" Void.thy [ less_void_def ] 
   66.40 -        "[|less_void x y; less_void y x|] ==> x = y"
   66.41 -(fn prems =>
   66.42 -        [
   66.43 -        (cut_facts_tac prems 1),
   66.44 -        (rtac (Rep_Void_inverse RS subst) 1),
   66.45 -        (etac subst 1),
   66.46 -        (rtac (Rep_Void_inverse RS sym) 1)
   66.47 -        ]);
   66.48 -
   66.49 -qed_goalw "trans_less_void" Void.thy [ less_void_def ] 
   66.50 -        "[|less_void x y; less_void y z|] ==> less_void x z"
   66.51 -(fn prems =>
   66.52 -        [
   66.53 -        (cut_facts_tac prems 1),
   66.54 -        (fast_tac HOL_cs 1)
   66.55 -        ]);
   66.56 -
   66.57 -(* ------------------------------------------------------------------------ *)
   66.58 -(* a technical lemma about void:                                            *)
   66.59 -(* every element in void is represented by UU_void_Rep                      *)
   66.60 -(* ------------------------------------------------------------------------ *)
   66.61 -
   66.62 -qed_goal "unique_void" Void.thy "Rep_Void(x) = UU_void_Rep"
   66.63 -(fn prems =>
   66.64 -        [
   66.65 -        (rtac (mem_Collect_eq RS subst) 1), 
   66.66 -        (fold_goals_tac [Void_def]),
   66.67 -        (rtac Rep_Void 1)
   66.68 -        ]);
   66.69 -
   66.70 -        
   66.71 -
   66.72 -
    67.1 --- a/src/HOLCF/Void.thy	Sat Feb 15 18:24:05 1997 +0100
    67.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    67.3 @@ -1,51 +0,0 @@
    67.4 -(*  Title:      HOLCF/void.thy
    67.5 -    ID:         $Id$
    67.6 -    Author:     Franz Regensburger
    67.7 -    Copyright   1993  Technische Universitaet Muenchen
    67.8 -
    67.9 -Definition of type void with partial order. Void is the prototype for
   67.10 -all types in class 'po'
   67.11 -
   67.12 -Type void  is defined as a set Void over type bool.
   67.13 -*)
   67.14 -
   67.15 -Void = Nat +
   67.16 -
   67.17 -types void 0
   67.18 -
   67.19 -arities void :: term
   67.20 -
   67.21 -consts
   67.22 -  Void          :: "bool set"
   67.23 -  UU_void_Rep   :: "bool"       
   67.24 -  Rep_Void      :: "void => bool"
   67.25 -  Abs_Void      :: "bool => void"
   67.26 -  UU_void       :: "void"
   67.27 -  less_void     :: "[void,void] => bool"        
   67.28 -
   67.29 -defs
   67.30 -
   67.31 -  (* The unique element in Void is False:bool *)
   67.32 -
   67.33 -  UU_void_Rep_def       "UU_void_Rep == False"
   67.34 -  Void_def              "Void == {x. x = UU_void_Rep}"
   67.35 -
   67.36 -   (*defining the abstract constants*)
   67.37 -
   67.38 -  UU_void_def   "UU_void == Abs_Void(UU_void_Rep)"  
   67.39 -  less_void_def "less_void x y == (Rep_Void x = Rep_Void y)"  
   67.40 -
   67.41 -rules
   67.42 -
   67.43 -  (*faking a type definition... *)
   67.44 -  (* void is isomorphic to Void *)
   67.45 -
   67.46 -  Rep_Void              "Rep_Void(x):Void"              
   67.47 -  Rep_Void_inverse      "Abs_Void(Rep_Void(x)) = x"     
   67.48 -  Abs_Void_inverse      "y:Void ==> Rep_Void(Abs_Void(y)) = y"
   67.49 -
   67.50 -end
   67.51 -
   67.52 -
   67.53 -
   67.54 -
    68.1 --- a/src/HOLCF/ccc1.thy	Sat Feb 15 18:24:05 1997 +0100
    68.2 +++ b/src/HOLCF/ccc1.thy	Mon Feb 17 10:57:11 1997 +0100
    68.3 @@ -7,7 +7,9 @@
    68.4  define constants for categorical reasoning
    68.5  *)
    68.6  
    68.7 -ccc1 = Cprod3 + Sprod3 + Ssum3 + Up3 + Fix +
    68.8 +ccc1 = Cprod3 + Sprod3 + Ssum3 + Up3 + Fix + 
    68.9 +
   68.10 +instance flat<chfin (flat_subclass_chfin)
   68.11  
   68.12  consts
   68.13          ID      :: "'a -> 'a"