added additional generic data;
authorwenzelm
Tue, 14 Oct 1997 17:36:22 +0200
changeset 3867 3b2587c809f4
parent 3866 97f66ba17458
child 3868 86981c4bffdb
added additional generic data;
src/Pure/sign.ML
--- a/src/Pure/sign.ML	Tue Oct 14 17:35:56 1997 +0200
+++ b/src/Pure/sign.ML	Tue Oct 14 17:36:22 1997 +0200
@@ -21,6 +21,7 @@
     syn: Syntax.syntax,
     path: string list,
     spaces: (string * NameSpace.T) list,
+    data: Data.T,
     stamps: string ref list}
   val subsig: sg * sg -> bool
   val eq_sg: sg * sg -> bool
@@ -102,6 +103,10 @@
   val add_space: string * string list -> sg -> sg
   val add_name: string -> sg -> sg
   val make_draft: sg -> sg
+  val print_data: sg -> unit
+  val init_data: string * exn * (exn * exn -> exn) * (string -> exn -> Pretty.T) -> sg -> sg
+  val get_data: sg -> string -> exn
+  val put_data: string * exn -> sg -> sg
   val merge: sg * sg -> sg
   val proto_pure: sg
   val pure: sg
@@ -122,10 +127,10 @@
     syn: Syntax.syntax,                         (*syntax for parsing and printing*)
     path: string list,                     	(*current name space entry prefix*)
     spaces: (string * NameSpace.T) list,   	(*name spaces for consts, types etc.*)
+    data: Data.T,				(*additional data*)
     stamps: string ref list};                   (*unique theory indentifier*)
-
-    (*the "ref" in stamps ensures that no two signatures are identical
-      -- it is impossible to forge a signature*)
+      (*the "ref" in stamps ensures that no two signatures are identical
+        -- it is impossible to forge a signature*)
 
 fun rep_sg (Sg args) = args;
 val tsig_of = #tsig o rep_sg;
@@ -351,7 +356,7 @@
     fun pretty_const (c, ty) = Pretty.block
       [Pretty.str (quote c ^ " ::"), Pretty.brk 1, prt_typ ty];
 
-    val Sg {tsig, const_tab, syn = _, path, spaces, stamps} = sg;
+    val Sg {tsig, const_tab, syn = _, path, spaces, data = _, stamps} = sg;
     val spaces' = sort (fn ((k1, _), (k2, _)) => k1 < k2) spaces;
     val {classes, classrel, default, tycons, abbrs, arities} =
       Type.rep_tsig tsig;
@@ -752,12 +757,13 @@
     else ref name :: stmps
   end;
 
-fun make_sign (syn, tsig, ctab, (path, spaces)) stamps name =
+fun make_sign (syn, tsig, ctab, (path, spaces)) data stamps name =
   Sg {tsig = tsig, const_tab = ctab, syn = syn, path = path, spaces = spaces,
-    stamps = ext_stamps stamps name};
+    data = data, stamps = ext_stamps stamps name};
 
-fun extend_sign extfun name decls (Sg {tsig, const_tab, syn, path, spaces, stamps}) =
-  make_sign (extfun (syn, tsig, const_tab, (path, spaces)) decls) stamps name;
+fun extend_sign extfun name decls
+    (Sg {tsig, const_tab, syn, path, spaces, data, stamps}) =
+  make_sign (extfun (syn, tsig, const_tab, (path, spaces)) decls) data stamps name;
 
 
 (* the external interfaces *)
@@ -791,6 +797,18 @@
 val make_draft = add_name "#";
 
 
+(* additional signature data *)
+
+fun print_data (Sg {data, ...}) = Data.print data;
+fun get_data (Sg {data, ...}) = Data.get data;
+
+fun map_data f (Sg {tsig, const_tab, syn, path, spaces, data, stamps}) =
+  make_sign (syn, tsig, const_tab, (path, spaces)) (f data) stamps "#";
+
+fun init_data (kind, e, mrg, prt) = map_data (fn d => Data.init d kind e mrg prt);
+fun put_data (kind, e) = map_data (fn d => Data.put d kind e);
+
+
 
 (** merge signatures **)    (*exception TERM*)
 
@@ -805,9 +823,9 @@
     (*neither is union already; must form union*)
     let
       val Sg {tsig = tsig1, const_tab = const_tab1, syn = syn1,
-        path = _, spaces = spaces1, stamps = stamps1} = sg1;
+        path = _, spaces = spaces1, data = data1, stamps = stamps1} = sg1;
       val Sg {tsig = tsig2, const_tab = const_tab2, syn = syn2,
-        path = _, spaces = spaces2, stamps = stamps2} = sg2;
+        path = _, spaces = spaces2, data = data2, stamps = stamps2} = sg2;
 
 
       val stamps = merge_rev_lists stamps1 stamps2;
@@ -830,9 +848,11 @@
         kinds ~~
           ListPair.map NameSpace.merge
             (map (space_of spaces1) kinds, map (space_of spaces2) kinds);
+
+      val data = Data.merge (data1, data2);
     in
       Sg {tsig = tsig, const_tab = const_tab, syn = syn,
-        path = [], spaces = spaces, stamps = stamps}
+        path = [], spaces = spaces, data = data, stamps = stamps}
     end;
 
 fun merge sgs =
@@ -845,7 +865,7 @@
 (** the Pure signature **)
 
 val proto_pure =
-  make_sign (Syntax.pure_syn, Type.tsig0, Symtab.null, ([], [])) [] "#"
+  make_sign (Syntax.pure_syn, Type.tsig0, Symtab.null, ([], [])) Data.empty [] "#"
   |> add_types
    (("fun", 2, NoSyn) ::
     ("prop", 0, NoSyn) ::