datatypes;
authorwenzelm
Mon, 03 Nov 1997 21:12:40 +0100
changeset 4105 b84e8dacae08
parent 4104 84433b1ab826
child 4106 01fa6e7e7196
datatypes;
src/HOL/thy_data.ML
--- a/src/HOL/thy_data.ML	Mon Nov 03 21:12:21 1997 +0100
+++ b/src/HOL/thy_data.ML	Mon Nov 03 21:12:40 1997 +0100
@@ -17,7 +17,9 @@
 
 signature THY_DATA =
 sig
-  val datatypesK: string
+  val get_datatypes_sg: Sign.sg -> datatype_info Symtab.table
+  val get_datatypes: theory -> datatype_info Symtab.table
+  val put_datatypes: datatype_info Symtab.table -> theory -> theory
   val hol_data: (string * (exn * (exn -> exn) * (exn * exn -> exn) * (exn -> unit))) list
 end;
 
@@ -25,14 +27,43 @@
 struct
 
 
-(** datatypes **)	(* FIXME *)
+(** datatypes **)
+
+(* data kind 'datatypes' *)
 
 val datatypesK = "datatypes";
 exception DatatypeInfo of datatype_info Symtab.table;
 
+local
+  val empty = DatatypeInfo Symtab.null;
+
+  fun prep_ext (x as DatatypeInfo _) = x;
+
+  fun merge (DatatypeInfo tab1, DatatypeInfo tab2) =
+    DatatypeInfo (Symtab.merge (K true) (tab1, tab2));
+
+  fun print (DatatypeInfo tab) =
+    Pretty.writeln (Pretty.strs ("datatypes:" :: map fst (Symtab.dest tab)));
+in
+  val datatypes_thy_data = (datatypesK, (empty, prep_ext, merge, print));
+end;
 
 
-(** records **)		(* FIXME *)
+(* get and put datatypes *)
+
+fun get_datatypes_sg sg =
+  (case Sign.get_data sg datatypesK of
+    DatatypeInfo tab => tab
+  | _ => sys_error "get_datatypes_sg");
+
+val get_datatypes = get_datatypes_sg o sign_of;
+
+fun put_datatypes tab thy =
+  Theory.put_data (datatypesK, DatatypeInfo tab) thy;
+
+
+
+(** records **)         (* FIXME *)
 
 val recordsK = "records";
 
@@ -41,7 +72,7 @@
 (** hol_data **)
 
 val hol_data =
- [Simplifier.simpset_thy_data, ClasetThyData.thy_data];
+ [Simplifier.simpset_thy_data, ClasetThyData.thy_data, datatypes_thy_data];
 
 
 end;