set up domain package in Domain.thy
authorhuffman
Fri, 10 Apr 2009 11:35:21 -0700
changeset 30910 a7cc0ef93269
parent 30887 fde434961f57
child 30911 7809cbaa1b61
set up domain package in Domain.thy
src/HOLCF/Domain.thy
src/HOLCF/HOLCF.thy
src/HOLCF/Tools/cont_consts.ML
src/HOLCF/Tools/domain/domain_library.ML
--- a/src/HOLCF/Domain.thy	Wed Apr 08 20:29:15 2009 +0200
+++ b/src/HOLCF/Domain.thy	Fri Apr 10 11:35:21 2009 -0700
@@ -6,6 +6,14 @@
 
 theory Domain
 imports Ssum Sprod Up One Tr Fixrec
+uses
+  ("Tools/cont_consts.ML")
+  ("Tools/cont_proc.ML")
+  ("Tools/domain/domain_library.ML")
+  ("Tools/domain/domain_syntax.ML")
+  ("Tools/domain/domain_axioms.ML")
+  ("Tools/domain/domain_theorems.ML")
+  ("Tools/domain/domain_extender.ML")
 begin
 
 defaultsort pcpo
@@ -193,4 +201,15 @@
 
 lemmas exh_casedists = exh_casedist1 exh_casedist2 exh_casedist3
 
+
+subsection {* Installing the domain package *}
+
+use "Tools/cont_consts.ML"
+use "Tools/cont_proc.ML"
+use "Tools/domain/domain_library.ML"
+use "Tools/domain/domain_syntax.ML"
+use "Tools/domain/domain_axioms.ML"
+use "Tools/domain/domain_theorems.ML"
+use "Tools/domain/domain_extender.ML"
+
 end
--- a/src/HOLCF/HOLCF.thy	Wed Apr 08 20:29:15 2009 +0200
+++ b/src/HOLCF/HOLCF.thy	Fri Apr 10 11:35:21 2009 -0700
@@ -9,13 +9,6 @@
   Domain ConvexPD Algebraic Universal Sum_Cpo Main
 uses
   "holcf_logic.ML"
-  "Tools/cont_consts.ML"
-  "Tools/cont_proc.ML"
-  "Tools/domain/domain_library.ML"
-  "Tools/domain/domain_syntax.ML"
-  "Tools/domain/domain_axioms.ML"
-  "Tools/domain/domain_theorems.ML"
-  "Tools/domain/domain_extender.ML"
   "Tools/adm_tac.ML"
 begin
 
--- a/src/HOLCF/Tools/cont_consts.ML	Wed Apr 08 20:29:15 2009 +0200
+++ b/src/HOLCF/Tools/cont_consts.ML	Fri Apr 10 11:35:21 2009 -0700
@@ -18,8 +18,6 @@
 
 (* misc utils *)
 
-open HOLCFLogic;
-
 fun first  (x,_,_) = x;
 fun second (_,x,_) = x;
 fun third  (_,_,x) = x;
@@ -66,7 +64,7 @@
             (c2,change_arrow n T,mx   ),
             trans_rules c2 c n mx) end;
 
-fun cfun_arity (Type(n,[_,T])) = if n = cfun_arrow then 1+cfun_arity T else 0
+fun cfun_arity (Type(n,[_,T])) = if n = @{type_name "->"} then 1+cfun_arity T else 0
 |   cfun_arity _               = 0;
 
 fun is_contconst (_,_,NoSyn   ) = false
--- a/src/HOLCF/Tools/domain/domain_library.ML	Wed Apr 08 20:29:15 2009 +0200
+++ b/src/HOLCF/Tools/domain/domain_library.ML	Fri Apr 10 11:35:21 2009 -0700
@@ -34,8 +34,6 @@
 
 structure Domain_Library = struct
 
-open HOLCFLogic;
-
 exception Impossible of string;
 fun Imposs msg = raise Impossible ("Domain:"^msg);
 
@@ -72,7 +70,7 @@
       | index_vnames([],occupied) = [];
 in index_vnames(map nonreserved ids, [("O",0),("o",0)]) end;
 
-fun pcpo_type sg t = Sign.of_sort sg (Sign.certify_typ sg t, pcpoS);
+fun pcpo_type sg t = Sign.of_sort sg (Sign.certify_typ sg t, @{sort pcpo});
 fun string_of_typ sg = Syntax.string_of_typ_global sg o Sign.certify_typ sg;
 
 (* ----- constructor list handling ----- *)
@@ -99,6 +97,17 @@
 (* ----- support for type and mixfix expressions ----- *)
 
 infixr 5 -->;
+fun mk_uT T = Type(@{type_name "u"}, [T]);
+fun mk_cfunT (T, U) = Type(@{type_name "->"}, [T, U]);
+fun mk_sprodT (T, U) = Type(@{type_name "**"}, [T, U]);
+fun mk_ssumT (T, U) = Type(@{type_name "++"}, [T, U]);
+val oneT = @{typ one};
+val trT = @{typ tr};
+
+infixr 6 ->>;
+val op ->> = mk_cfunT;
+
+fun mk_TFree s = TFree ("'" ^ s, @{sort pcpo});
 
 (* ----- support for term expressions ----- *)