--- a/src/HOLCF/Tools/Domain/domain_axioms.ML Wed Mar 03 07:55:52 2010 -0800
+++ b/src/HOLCF/Tools/Domain/domain_axioms.ML Wed Mar 03 08:14:56 2010 -0800
@@ -14,9 +14,6 @@
val axiomatize_lub_take :
binding * term -> theory -> thm * theory
- val copy_of_dtyp :
- string Symtab.table -> (int -> term) -> Datatype.dtyp -> term
-
val add_axioms :
(binding * (typ * typ)) list -> theory ->
Domain_Take_Proofs.iso_info list * theory
@@ -26,32 +23,6 @@
structure Domain_Axioms : DOMAIN_AXIOMS =
struct
-(* TODO: move copy_of_dtyp somewhere else! *)
-local open Domain_Library in
-
-infixr 0 ===>;infixr 0 ==>;infix 0 == ;
-infix 1 ===; infix 1 ~= ; infix 1 <<; infix 1 ~<<;
-infix 9 ` ; infix 9 `% ; infix 9 `%%; infixr 9 oo;
-
-(* FIXME: use theory data for this *)
-val copy_tab : string Symtab.table =
- Symtab.make [(@{type_name cfun}, @{const_name "cfun_map"}),
- (@{type_name ssum}, @{const_name "ssum_map"}),
- (@{type_name sprod}, @{const_name "sprod_map"}),
- (@{type_name "*"}, @{const_name "cprod_map"}),
- (@{type_name "u"}, @{const_name "u_map"})];
-
-fun copy_of_dtyp tab r dt =
- if Datatype_Aux.is_rec_type dt then copy tab r dt else ID
-and copy tab r (Datatype_Aux.DtRec i) = r i
- | copy tab r (Datatype_Aux.DtTFree a) = ID
- | copy tab r (Datatype_Aux.DtType (c, ds)) =
- case Symtab.lookup tab c of
- SOME f => list_ccomb (%%:f, map (copy_of_dtyp tab r) ds)
- | NONE => (warning ("copy_of_dtyp: unknown type constructor " ^ c); ID);
-
-end; (* local open *)
-
open HOLCF_Library;
fun axiomatize_isomorphism
--- a/src/HOLCF/Tools/Domain/domain_theorems.ML Wed Mar 03 07:55:52 2010 -0800
+++ b/src/HOLCF/Tools/Domain/domain_theorems.ML Wed Mar 03 08:14:56 2010 -0800
@@ -160,12 +160,21 @@
fun get_deflation_take dn = PureThy.get_thm thy (dn ^ ".deflation_take");
val axs_deflation_take = map get_deflation_take dnames;
+ fun copy_of_dtyp tab r dt =
+ if Datatype_Aux.is_rec_type dt then copy tab r dt else ID
+ and copy tab r (Datatype_Aux.DtRec i) = r i
+ | copy tab r (Datatype_Aux.DtTFree a) = ID
+ | copy tab r (Datatype_Aux.DtType (c, ds)) =
+ case Symtab.lookup tab c of
+ SOME f => list_ccomb (%%:f, map (copy_of_dtyp tab r) ds)
+ | NONE => (warning ("copy_of_dtyp: unknown type constructor " ^ c); ID);
+
fun one_take_app (con, args) =
let
fun mk_take n = dc_take (List.nth (dnames, n)) $ %:"n";
fun one_rhs arg =
if Datatype_Aux.is_rec_type (dtyp_of arg)
- then Domain_Axioms.copy_of_dtyp map_tab
+ then copy_of_dtyp map_tab
mk_take (dtyp_of arg) ` (%# arg)
else (%# arg);
val lhs = (dc_take dname $ (%%:"Suc" $ %:"n"))`(con_app con args);