# HG changeset patch # User wenzelm # Date 876843382 -7200 # Node ID 3b2587c809f4bd3fccdefd6762ba50c076a273ab # Parent 97f66ba17458d529e8de178e655a949f7645e2a2 added additional generic data; diff -r 97f66ba17458 -r 3b2587c809f4 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) ::