abstract type Name_Space.table;
authorwenzelm
Mon, 10 Mar 2014 13:55:03 +0100
changeset 56025 d74fed45fa8b
parent 56024 0921c1dc344c
child 56026 893fe12639bc
abstract type Name_Space.table; clarified pretty_locale_deps: sort strings; clarified Proof_Context.update_cases: Name_Space.del_table hides name space entry as well;
src/HOL/Mutabelle/mutabelle.ML
src/HOL/Tools/inductive.ML
src/Pure/General/name_space.ML
src/Pure/Isar/attrib.ML
src/Pure/Isar/bundle.ML
src/Pure/Isar/locale.ML
src/Pure/Isar/method.ML
src/Pure/Isar/proof_context.ML
src/Pure/Tools/find_consts.ML
src/Pure/consts.ML
src/Pure/display.ML
src/Pure/facts.ML
src/Pure/sign.ML
src/Pure/term_sharing.ML
src/Pure/theory.ML
src/Pure/thm.ML
src/Pure/type.ML
src/Pure/variable.ML
src/Tools/Code/code_thingol.ML
--- a/src/HOL/Mutabelle/mutabelle.ML	Mon Mar 10 10:13:47 2014 +0100
+++ b/src/HOL/Mutabelle/mutabelle.ML	Mon Mar 10 13:55:03 2014 +0100
@@ -32,11 +32,11 @@
 
 fun consts_of thy =
  let
-   val (namespace, const_table) = #constants (Consts.dest (Sign.consts_of thy))
-   val consts = Symtab.dest const_table
+   val {const_space, constants, ...} = Consts.dest (Sign.consts_of thy)
+   val consts = Symtab.dest constants
  in
    map_filter (fn (s, (T, NONE)) => SOME (s, T) | _ => NONE)
-     (filter_out (fn (s, _) => Name_Space.is_concealed namespace s) consts)
+     (filter_out (fn (s, _) => Name_Space.is_concealed const_space s) consts)
  end;
 
 
--- a/src/HOL/Tools/inductive.ML	Mon Mar 10 10:13:47 2014 +0100
+++ b/src/HOL/Tools/inductive.ML	Mon Mar 10 13:55:03 2014 +0100
@@ -230,7 +230,7 @@
     [Pretty.block
       (Pretty.breaks
         (Pretty.str "(co)inductives:" ::
-          map (Pretty.mark_str o #1) (Name_Space.extern_table ctxt (space, infos)))),
+          map (Pretty.mark_str o #1) (Name_Space.extern_table' ctxt space infos))),
      Pretty.big_list "monotonicity rules:" (map (Display.pretty_thm_item ctxt) monos)]
   end |> Pretty.chunks |> Pretty.writeln;
 
--- a/src/Pure/General/name_space.ML	Mon Mar 10 10:13:47 2014 +0100
+++ b/src/Pure/General/name_space.ML	Mon Mar 10 13:55:03 2014 +0100
@@ -54,17 +54,26 @@
   val naming_of: Context.generic -> naming
   val map_naming: (naming -> naming) -> Context.generic -> Context.generic
   val declare: Context.generic -> bool -> binding -> T -> string * T
-  type 'a table = T * 'a Symtab.table
+  type 'a table
+  val space_of_table: 'a table -> T
   val check_reports: Context.generic -> 'a table ->
     xstring * Position.T list -> (string * Position.report list) * 'a
   val check: Context.generic -> 'a table -> xstring * Position.T -> string * 'a
+  val lookup_key: 'a table -> string -> (string * 'a) option
   val get: 'a table -> string -> 'a
   val define: Context.generic -> bool -> binding * 'a -> 'a table -> string * 'a table
+  val alias_table: naming -> binding -> string -> 'a table -> 'a table
+  val hide_table: bool -> string -> 'a table -> 'a table
+  val del_table: string -> 'a table -> 'a table
+  val map_table_entry: string -> ('a -> 'a) -> 'a table -> 'a table
+  val fold_table: (string * 'a -> 'b -> 'b) -> 'a table -> 'b -> 'b
   val empty_table: string -> 'a table
   val merge_tables: 'a table * 'a table -> 'a table
   val join_tables: (string -> 'a * 'a -> 'a) (*Symtab.SAME*) ->
     'a table * 'a table -> 'a table
-  val dest_table: Proof.context -> 'a table -> (string * 'a) list
+  val dest_table': Proof.context -> T -> 'a Symtab.table -> ((string * xstring) * 'a) list
+  val dest_table: Proof.context -> 'a table -> ((string * xstring) * 'a) list
+  val extern_table': Proof.context -> T -> 'a Symtab.table -> ((Markup.T * xstring) * 'a) list
   val extern_table: Proof.context -> 'a table -> ((Markup.T * xstring) * 'a) list
 end;
 
@@ -455,9 +464,11 @@
 
 (* definition in symbol table *)
 
-type 'a table = T * 'a Symtab.table;
+datatype 'a table = Table of T * 'a Symtab.table;
 
-fun check_reports context (space, tab) (xname, ps) =
+fun space_of_table (Table (space, _)) = space;
+
+fun check_reports context (Table (space, tab)) (xname, ps) =
   let val name = intern space xname in
     (case Symtab.lookup tab name of
       SOME x =>
@@ -481,31 +492,61 @@
     val _ = Position.reports reports;
   in (name, x) end;
 
-fun get (space, tab) name =
-  (case Symtab.lookup tab name of
-    SOME x => x
-  | NONE => error (undefined (kind_of space) name));
+fun lookup_key (Table (_, tab)) name = Symtab.lookup_key tab name;
+
+fun get table name =
+  (case lookup_key table name of
+    SOME (_, x) => x
+  | NONE => error (undefined (kind_of (space_of_table table)) name));
 
-fun define context strict (binding, x) (space, tab) =
-  let val (name, space') = declare context strict binding space
-  in (name, (space', Symtab.update (name, x) tab)) end;
+fun define context strict (binding, x) (Table (space, tab)) =
+  let
+    val (name, space') = declare context strict binding space;
+    val tab' = Symtab.update (name, x) tab;
+  in (name, Table (space', tab')) end;
+
+
+(* derived table operations *)
+
+fun alias_table naming binding name (Table (space, tab)) =
+  Table (alias naming binding name space, tab);
+
+fun hide_table fully name (Table (space, tab)) =
+  Table (hide fully name space, tab);
 
-fun empty_table kind = (empty kind, Symtab.empty);
+fun del_table name (Table (space, tab)) =
+  let
+    val space' = hide true name space handle ERROR _ => space;
+    val tab' = Symtab.delete_safe name tab;
+  in Table (space', tab') end;
 
-fun merge_tables ((space1, tab1), (space2, tab2)) =
-  (merge (space1, space2), Symtab.merge (K true) (tab1, tab2));
+fun map_table_entry name f (Table (space, tab)) =
+  Table (space, Symtab.map_entry name f tab);
+
+fun fold_table f (Table (_, tab)) = Symtab.fold f tab;
 
-fun join_tables f ((space1, tab1), (space2, tab2)) =
-  (merge (space1, space2), Symtab.join f (tab1, tab2));
+fun empty_table kind = Table (empty kind, Symtab.empty);
+
+fun merge_tables (Table (space1, tab1), Table (space2, tab2)) =
+  Table (merge (space1, space2), Symtab.merge (K true) (tab1, tab2));
 
-fun ext_table ctxt (space, tab) =
+fun join_tables f (Table (space1, tab1), Table (space2, tab2)) =
+  Table (merge (space1, space2), Symtab.join f (tab1, tab2));
+
+
+(* present table content *)
+
+fun dest_table' ctxt space tab =
   Symtab.fold (fn (name, x) => cons ((name, extern ctxt space name), x)) tab []
   |> Library.sort_wrt (#2 o #1);
 
-fun dest_table ctxt table = map (apfst #1) (ext_table ctxt table);
+fun dest_table ctxt (Table (space, tab)) = dest_table' ctxt space tab;
 
-fun extern_table ctxt (space, tab) =
-  map (fn ((name, xname), x) => ((markup space name, xname), x)) (ext_table ctxt (space, tab));
+fun extern_table' ctxt space tab =
+  dest_table' ctxt space tab
+  |> map (fn ((name, xname), x) => ((markup space name, xname), x));
+
+fun extern_table ctxt (Table (space, tab)) = extern_table' ctxt space tab;
 
 end;
 
--- a/src/Pure/Isar/attrib.ML	Mon Mar 10 10:13:47 2014 +0100
+++ b/src/Pure/Isar/attrib.ML	Mon Mar 10 13:55:03 2014 +0100
@@ -129,7 +129,8 @@
 
 (* pretty printing *)
 
-fun extern ctxt = Name_Space.extern ctxt (#1 (get_attributes (Context.Proof ctxt)));
+fun extern ctxt =
+  Name_Space.extern ctxt (Name_Space.space_of_table (get_attributes (Context.Proof ctxt)));
 
 fun pretty_attribs _ [] = []
   | pretty_attribs ctxt srcs =
@@ -139,12 +140,12 @@
 (* get attributes *)
 
 fun attribute_generic context =
-  let val (_, tab) = get_attributes context in
+  let val table = get_attributes context in
     fn src =>
       let val ((name, _), pos) = Args.dest_src src in
-        (case Symtab.lookup tab name of
+        (case Name_Space.lookup_key table name of
           NONE => error ("Undefined attribute: " ^ quote name ^ Position.here pos)
-        | SOME (att, _) => att src)
+        | SOME (_, (att, _)) => att src)
       end
   end;
 
@@ -349,8 +350,8 @@
         Pretty.block [Pretty.mark_str name, Pretty.str (": " ^ Config.print_type value ^ " ="),
           Pretty.brk 1, Pretty.str (Config.print_value value)]
       end;
-    val space = #1 (get_attributes (Context.Proof ctxt));
-    val configs = Name_Space.extern_table ctxt (space, Configs.get (Proof_Context.theory_of ctxt));
+    val space = Name_Space.space_of_table (get_attributes (Context.Proof ctxt));
+    val configs = Name_Space.extern_table' ctxt space (Configs.get (Proof_Context.theory_of ctxt));
   in Pretty.writeln (Pretty.big_list "configuration options" (map prt configs)) end;
 
 
--- a/src/Pure/Isar/bundle.ML	Mon Mar 10 10:13:47 2014 +0100
+++ b/src/Pure/Isar/bundle.ML	Mon Mar 10 13:55:03 2014 +0100
@@ -46,8 +46,8 @@
 val get_bundles = Data.get o Context.Proof;
 
 fun the_bundle ctxt name =
-  (case Symtab.lookup (#2 (get_bundles ctxt)) name of
-    SOME bundle => bundle
+  (case Name_Space.lookup_key (get_bundles ctxt) name of
+    SOME (_, bundle) => bundle
   | NONE => error ("Unknown bundle " ^ quote name));
 
 fun check ctxt = #1 o Name_Space.check (Context.Proof ctxt) (get_bundles ctxt);
--- a/src/Pure/Isar/locale.ML	Mon Mar 10 10:13:47 2014 +0100
+++ b/src/Pure/Isar/locale.ML	Mon Mar 10 13:55:03 2014 +0100
@@ -160,19 +160,20 @@
   val merge = Name_Space.join_tables (K merge_locale);
 );
 
-val intern = Name_Space.intern o #1 o Locales.get;
+val locale_space = Name_Space.space_of_table o Locales.get;
+val intern = Name_Space.intern o locale_space;
 fun check thy = #1 o Name_Space.check (Context.Theory thy) (Locales.get thy);
 
-fun extern thy = Name_Space.extern (Proof_Context.init_global thy) (#1 (Locales.get thy));
+fun extern thy = Name_Space.extern (Proof_Context.init_global thy) (locale_space thy);
 
 fun markup_extern ctxt =
-  Name_Space.markup_extern ctxt (#1 (Locales.get (Proof_Context.theory_of ctxt)));
+  Name_Space.markup_extern ctxt (locale_space (Proof_Context.theory_of ctxt));
 
 fun markup_name ctxt name = markup_extern ctxt name |-> Markup.markup;
 fun pretty_name ctxt name = markup_extern ctxt name |> Pretty.mark_str;
 
-val get_locale = Symtab.lookup o #2 o Locales.get;
-val defined = Symtab.defined o #2 o Locales.get;
+val get_locale = Option.map #2 oo (Name_Space.lookup_key o Locales.get);
+val defined = is_some oo get_locale;
 
 fun the_locale thy name =
   (case get_locale thy name of
@@ -189,7 +190,7 @@
           (* FIXME Morphism.identity *)
 
 fun change_locale name =
-  Locales.map o apsnd o Symtab.map_entry name o map_locale o apsnd;
+  Locales.map o Name_Space.map_table_entry name o map_locale o apsnd;
 
 
 (** Primitive operations **)
@@ -680,6 +681,7 @@
      {name = name,
       parents = map (fst o fst) (dependencies_of thy name),
       body = pretty_locale thy false name};
-  in map make_node (Symtab.keys (#2 (Locales.get thy))) end;
+    val names = sort_strings (Name_Space.fold_table (cons o #1) (Locales.get thy) []);
+  in map make_node names end;
 
 end;
--- a/src/Pure/Isar/method.ML	Mon Mar 10 10:13:47 2014 +0100
+++ b/src/Pure/Isar/method.ML	Mon Mar 10 13:55:03 2014 +0100
@@ -351,12 +351,12 @@
 (* get methods *)
 
 fun method ctxt =
-  let val (_, tab) = get_methods ctxt in
+  let val table = get_methods ctxt in
     fn src =>
       let val ((name, _), pos) = Args.dest_src src in
-        (case Symtab.lookup tab name of
+        (case Name_Space.lookup_key table name of
           NONE => error ("Undefined method: " ^ quote name ^ Position.here pos)
-        | SOME (meth, _) => meth src)
+        | SOME (_, (meth, _)) => meth src)
       end
   end;
 
--- a/src/Pure/Isar/proof_context.ML	Mon Mar 10 10:13:47 2014 +0100
+++ b/src/Pure/Isar/proof_context.ML	Mon Mar 10 13:55:03 2014 +0100
@@ -1152,16 +1152,14 @@
 (** cases **)
 
 fun dest_cases ctxt =
-  Symtab.fold (fn (a, (c, i)) => cons (i, (a, c))) (#2 (cases_of ctxt)) []
+  Name_Space.fold_table (fn (a, (c, i)) => cons (i, (a, c))) (cases_of ctxt) []
   |> sort (int_ord o pairself #1) |> map #2;
 
 local
 
 fun update_case _ _ ("", _) res = res
-  | update_case _ _ (name, NONE) ((space, tab), index) =
-      let
-        val tab' = Symtab.delete_safe name tab;
-      in ((space, tab'), index) end
+  | update_case _ _ (name, NONE) (cases, index) =
+      (Name_Space.del_table name cases, index)
   | update_case context is_proper (name, SOME c) (cases, index) =
       let
         val (_, cases') = cases |> Name_Space.define context false
@@ -1179,7 +1177,7 @@
   let
     val context = Context.Proof ctxt |> Name_Space.map_naming (K Name_Space.default_naming);
     val cases = cases_of ctxt;
-    val index = Symtab.fold (fn _ => Integer.add 1) (#2 cases) 0;
+    val index = Name_Space.fold_table (fn _ => Integer.add 1) cases 0;
     val (cases', _) = fold (update_case context is_proper) args (cases, index);
   in map_cases (K cases') ctxt end;
 
@@ -1230,14 +1228,15 @@
 
 fun pretty_abbrevs show_globals ctxt =
   let
-    val ((space, consts), (_, globals)) =
+    val space = const_space ctxt;
+    val (constants, globals) =
       pairself (#constants o Consts.dest) (#consts (rep_data ctxt));
     fun add_abbr (_, (_, NONE)) = I
       | add_abbr (c, (T, SOME t)) =
           if not show_globals andalso Symtab.defined globals c then I
           else cons (c, Logic.mk_equals (Const (c, T), t));
     val abbrevs =
-      Name_Space.extern_table ctxt (space, Symtab.make (Symtab.fold add_abbr consts []));
+      Name_Space.extern_table' ctxt space (Symtab.make (Symtab.fold add_abbr constants []));
   in
     if null abbrevs then []
     else [Pretty.big_list "abbreviations:" (map (pretty_term_abbrev ctxt o #2) abbrevs)]
--- a/src/Pure/Tools/find_consts.ML	Mon Mar 10 10:13:47 2014 +0100
+++ b/src/Pure/Tools/find_consts.ML	Mon Mar 10 13:55:03 2014 +0100
@@ -58,8 +58,8 @@
 fun pretty_const ctxt (c, ty) =
   let
     val ty' = Logic.unvarifyT_global ty;
-    val consts_space = Consts.space_of (Sign.consts_of (Proof_Context.theory_of ctxt));
-    val markup = Name_Space.markup consts_space c;
+    val const_space = Consts.space_of (Sign.consts_of (Proof_Context.theory_of ctxt));
+    val markup = Name_Space.markup const_space c;
   in
     Pretty.block
      [Pretty.mark markup (Pretty.str c), Pretty.str " ::", Pretty.brk 1,
@@ -103,13 +103,13 @@
     val criteria = map make_criterion raw_criteria;
 
     val consts = Sign.consts_of thy;
-    val (_, consts_tab) = #constants (Consts.dest consts);
+    val {constants, ...} = Consts.dest consts;
     fun eval_entry c =
       fold (filter_const c) (user_visible consts :: criteria) (SOME low_ranking);
 
     val matches =
       Symtab.fold (fn c => (case eval_entry c of NONE => I | SOME rank => cons (rank, c)))
-        consts_tab []
+        constants []
       |> sort (prod_ord (rev_order o int_ord) (string_ord o pairself fst))
       |> map (apsnd fst o snd);
   in
--- a/src/Pure/consts.ML	Mon Mar 10 10:13:47 2014 +0100
+++ b/src/Pure/consts.ML	Mon Mar 10 13:55:03 2014 +0100
@@ -11,8 +11,9 @@
   val eq_consts: T * T -> bool
   val retrieve_abbrevs: T -> string list -> term -> (term * term) list
   val dest: T ->
-   {constants: (typ * term option) Name_Space.table,
-    constraints: typ Name_Space.table}
+   {const_space: Name_Space.T,
+    constants: (typ * term option) Symtab.table,
+    constraints: typ Symtab.table}
   val the_const: T -> string -> string * typ                   (*exception TYPE*)
   val the_abbreviation: T -> string -> typ * term              (*exception TYPE*)
   val type_scheme: T -> string -> typ                          (*exception TYPE*)
@@ -80,17 +81,18 @@
 
 (* dest consts *)
 
-fun dest (Consts {decls = (space, decls), constraints, ...}) =
- {constants = (space,
-    Symtab.fold (fn (c, ({T, ...}, abbr)) =>
-      Symtab.update (c, (T, Option.map #rhs abbr))) decls Symtab.empty),
-  constraints = (space, constraints)};
+fun dest (Consts {decls, constraints, ...}) =
+ {const_space = Name_Space.space_of_table decls,
+  constants =
+    Name_Space.fold_table (fn (c, ({T, ...}, abbr)) =>
+      Symtab.update (c, (T, Option.map #rhs abbr))) decls Symtab.empty,
+  constraints = constraints};
 
 
 (* lookup consts *)
 
-fun the_entry (Consts {decls = (_, tab), ...}) c =
-  (case Symtab.lookup_key tab c of
+fun the_entry (Consts {decls, ...}) c =
+  (case Name_Space.lookup_key decls c of
     SOME entry => entry
   | NONE => raise TYPE ("Unknown constant: " ^ quote c, [], []));
 
@@ -118,10 +120,10 @@
 
 (* name space and syntax *)
 
-fun space_of (Consts {decls = (space, _), ...}) = space;
+fun space_of (Consts {decls, ...}) = Name_Space.space_of_table decls;
 
-fun alias naming binding name = map_consts (fn ((space, decls), constraints, rev_abbrevs) =>
-  ((Name_Space.alias naming binding name space, decls), constraints, rev_abbrevs));
+fun alias naming binding name = map_consts (fn (decls, constraints, rev_abbrevs) =>
+  ((Name_Space.alias_table naming binding name decls), constraints, rev_abbrevs));
 
 val is_concealed = Name_Space.is_concealed o space_of;
 
@@ -219,7 +221,7 @@
 (* name space *)
 
 fun hide fully c = map_consts (fn (decls, constraints, rev_abbrevs) =>
-  (apfst (Name_Space.hide fully c) decls, constraints, rev_abbrevs));
+  (Name_Space.hide_table fully c decls, constraints, rev_abbrevs));
 
 
 (* declarations *)
--- a/src/Pure/display.ML	Mon Mar 10 10:13:47 2014 +0100
+++ b/src/Pure/display.ML	Mon Mar 10 13:55:03 2014 +0100
@@ -145,33 +145,34 @@
     fun pretty_restrict (const, name) =
       Pretty.block ([prt_const' const, Pretty.brk 2, Pretty.str ("(from " ^ quote name ^ ")")]);
 
-    val axioms = (Theory.axiom_space thy, Theory.axiom_table thy);
     val defs = Theory.defs_of thy;
     val {restricts, reducts} = Defs.dest defs;
     val tsig = Sign.tsig_of thy;
     val consts = Sign.consts_of thy;
-    val {constants, constraints} = Consts.dest consts;
-    val extern_const = Name_Space.extern ctxt (#1 constants);
+    val {const_space, constants, constraints} = Consts.dest consts;
+    val extern_const = Name_Space.extern ctxt const_space;
     val {classes, default, types, ...} = Type.rep_tsig tsig;
     val (class_space, class_algebra) = classes;
     val classes = Sorts.classes_of class_algebra;
     val arities = Sorts.arities_of class_algebra;
 
     val clsses =
-      Name_Space.dest_table ctxt (class_space,
-        Symtab.make (map (fn ((c, _), cs) => (c, Sign.minimize_sort thy cs)) (Graph.dest classes)));
-    val tdecls = Name_Space.dest_table ctxt types;
-    val arties = Name_Space.dest_table ctxt (Type.type_space tsig, arities);
+      Name_Space.dest_table' ctxt class_space
+        (Symtab.make (map (fn ((c, _), cs) => (c, Sign.minimize_sort thy cs)) (Graph.dest classes)))
+      |> map (apfst #1);
+    val tdecls = Name_Space.dest_table ctxt types |> map (apfst #1);
+    val arties = Name_Space.dest_table' ctxt (Type.type_space tsig) arities |> map (apfst #1);
 
     fun prune_const c = not verbose andalso Consts.is_concealed consts c;
-    val cnsts = Name_Space.extern_table ctxt (#1 constants,
-      Symtab.make (filter_out (prune_const o fst) (Symtab.dest (#2 constants))));
+    val cnsts =
+      Name_Space.extern_table' ctxt const_space
+        (Symtab.make (filter_out (prune_const o fst) (Symtab.dest constants)));
 
     val log_cnsts = map_filter (fn (c, (ty, NONE)) => SOME (c, ty) | _ => NONE) cnsts;
     val abbrevs = map_filter (fn (c, (ty, SOME t)) => SOME (c, (ty, t)) | _ => NONE) cnsts;
-    val cnstrs = Name_Space.extern_table ctxt constraints;
+    val cnstrs = Name_Space.extern_table' ctxt const_space constraints;
 
-    val axms = Name_Space.extern_table ctxt axioms;
+    val axms = Name_Space.extern_table ctxt (Theory.axiom_table thy);
 
     val (reds0, (reds1, reds2)) = filter_out (prune_const o fst o fst) reducts
       |> map (fn (lhs, rhs) =>
--- a/src/Pure/facts.ML	Mon Mar 10 10:13:47 2014 +0100
+++ b/src/Pure/facts.ML	Mon Mar 10 13:55:03 2014 +0100
@@ -140,8 +140,7 @@
 
 fun facts_of (Facts {facts, ...}) = facts;
 
-val space_of = #1 o facts_of;
-val table_of = #2 o facts_of;
+val space_of = Name_Space.space_of_table o facts_of;
 
 val is_concealed = Name_Space.is_concealed o space_of;
 
@@ -157,16 +156,16 @@
 val intern = Name_Space.intern o space_of;
 fun extern ctxt = Name_Space.extern ctxt o space_of;
 
-val defined = Symtab.defined o table_of;
+val defined = is_some oo (Name_Space.lookup_key o facts_of);
 
 fun lookup context facts name =
-  (case Symtab.lookup (table_of facts) name of
+  (case Name_Space.lookup_key (facts_of facts) name of
     NONE => NONE
-  | SOME (Static ths) => SOME (true, ths)
-  | SOME (Dynamic f) => SOME (false, f context));
+  | SOME (_, Static ths) => SOME (true, ths)
+  | SOME (_, Dynamic f) => SOME (false, f context));
 
 fun fold_static f =
-  Symtab.fold (fn (name, Static ths) => f (name, ths) | _ => I) o table_of;
+  Name_Space.fold_table (fn (name, Static ths) => f (name, ths) | _ => I) o facts_of;
 
 
 (* content difference *)
@@ -221,13 +220,10 @@
 
 (* remove entries *)
 
-fun del name (Facts {facts = (space, tab), props}) =
-  let
-    val space' = Name_Space.hide true name space handle ERROR _ => space;
-    val tab' = Symtab.delete_safe name tab;
-  in make_facts (space', tab') props end;
+fun del name (Facts {facts, props}) =
+  make_facts (Name_Space.del_table name facts) props;
 
-fun hide fully name (Facts {facts = (space, tab), props}) =
-  make_facts (Name_Space.hide fully name space, tab) props;
+fun hide fully name (Facts {facts, props}) =
+  make_facts (Name_Space.hide_table fully name facts) props;
 
 end;
--- a/src/Pure/sign.ML	Mon Mar 10 10:13:47 2014 +0100
+++ b/src/Pure/sign.ML	Mon Mar 10 13:55:03 2014 +0100
@@ -192,7 +192,7 @@
 
 fun mk_const thy (c, Ts) = Const (c, const_instance thy (c, Ts));
 
-val declared_tyname = Symtab.defined o #2 o #types o Type.rep_tsig o tsig_of;
+val declared_tyname = is_some oo (Name_Space.lookup_key o #types o Type.rep_tsig o tsig_of);
 val declared_const = can o the_const_constraint;
 
 
--- a/src/Pure/term_sharing.ML	Mon Mar 10 10:13:47 2014 +0100
+++ b/src/Pure/term_sharing.ML	Mon Mar 10 13:55:03 2014 +0100
@@ -19,10 +19,10 @@
 
 fun init thy =
   let
-    val {classes = (_, algebra), types = (_, types), ...} = Type.rep_tsig (Sign.tsig_of thy);
+    val {classes = (_, algebra), types, ...} = Type.rep_tsig (Sign.tsig_of thy);
 
     val class = perhaps (try (#1 o Graph.get_entry (Sorts.classes_of algebra)));
-    val tycon = perhaps (Option.map #1 o Symtab.lookup_key types);
+    val tycon = perhaps (Option.map #1 o Name_Space.lookup_key types);
     val const = perhaps (try (#1 o Consts.the_const (Sign.consts_of thy)));
 
     val typs = Unsynchronized.ref (Typtab.empty: unit Typtab.table);
--- a/src/Pure/theory.ML	Mon Mar 10 10:13:47 2014 +0100
+++ b/src/Pure/theory.ML	Mon Mar 10 13:55:03 2014 +0100
@@ -17,8 +17,8 @@
   val requires: theory -> string -> string -> unit
   val setup: (theory -> theory) -> unit
   val get_markup: theory -> Markup.T
+  val axiom_table: theory -> term Name_Space.table
   val axiom_space: theory -> Name_Space.T
-  val axiom_table: theory -> term Symtab.table
   val axioms_of: theory -> (string * term) list
   val all_axioms_of: theory -> (string * term) list
   val defs_of: theory -> Defs.T
@@ -139,10 +139,10 @@
 
 (* basic operations *)
 
-val axiom_space = #1 o #axioms o rep_theory;
-val axiom_table = #2 o #axioms o rep_theory;
+val axiom_table = #axioms o rep_theory;
+val axiom_space = Name_Space.space_of_table o axiom_table;
 
-val axioms_of = Symtab.dest o #2 o #axioms o rep_theory;
+fun axioms_of thy = rev (Name_Space.fold_table cons (axiom_table thy) []);
 fun all_axioms_of thy = maps axioms_of (nodes_of thy);
 
 val defs_of = #defs o rep_theory;
--- a/src/Pure/thm.ML	Mon Mar 10 10:13:47 2014 +0100
+++ b/src/Pure/thm.ML	Mon Mar 10 13:55:03 2014 +0100
@@ -584,8 +584,8 @@
 fun axiom theory name =
   let
     fun get_ax thy =
-      Symtab.lookup (Theory.axiom_table thy) name
-      |> Option.map (fn prop =>
+      Name_Space.lookup_key (Theory.axiom_table thy) name
+      |> Option.map (fn (_, prop) =>
            let
              val der = deriv_rule0 (Proofterm.axm_proof name prop);
              val maxidx = maxidx_of_term prop;
@@ -602,7 +602,7 @@
 
 (*return additional axioms of this theory node*)
 fun axioms_of thy =
-  map (fn s => (s, axiom thy s)) (Symtab.keys (Theory.axiom_table thy));
+  map (fn (name, _) => (name, axiom thy name)) (Theory.axioms_of thy);
 
 
 (* tags *)
--- a/src/Pure/type.ML	Mon Mar 10 10:13:47 2014 +0100
+++ b/src/Pure/type.ML	Mon Mar 10 13:55:03 2014 +0100
@@ -177,7 +177,7 @@
 fun build_tsig (classes, default, types) =
   let
     val log_types =
-      Symtab.fold (fn (c, LogicalType n) => cons (c, n) | _ => I) (snd types) []
+      Name_Space.fold_table (fn (c, LogicalType n) => cons (c, n) | _ => I) types []
       |> Library.sort (int_ord o pairself snd) |> map fst;
   in make_tsig (classes, default, types, log_types) end;
 
@@ -237,17 +237,17 @@
 
 (* types *)
 
-val type_space = #1 o #types o rep_tsig;
+val type_space = Name_Space.space_of_table o #types o rep_tsig;
 
-fun type_alias naming binding name = map_tsig (fn (classes, default, (space, types)) =>
-  (classes, default, (Name_Space.alias naming binding name space, types)));
+fun type_alias naming binding name = map_tsig (fn (classes, default, types) =>
+  (classes, default, (Name_Space.alias_table naming binding name types)));
 
 val is_logtype = member (op =) o logical_types;
 
 
 fun undecl_type c = "Undeclared type constructor: " ^ quote c;
 
-fun lookup_type (TSig {types = (_, types), ...}) = Symtab.lookup types;
+fun lookup_type (TSig {types, ...}) = Option.map #2 o Name_Space.lookup_key types;
 
 fun check_decl context (TSig {types, ...}) (c, pos) =
   Name_Space.check_reports context types (c, [pos]);
@@ -639,14 +639,15 @@
 
 fun map_types f = map_tsig (fn (classes, default, types) =>
   let
-    val (space', tab') = f types;
-    val _ = Name_Space.intern space' "dummy" = "dummy" orelse
-      error "Illegal declaration of dummy type";
-  in (classes, default, (space', tab')) end);
+    val types' = f types;
+    val _ =
+      Name_Space.intern (Name_Space.space_of_table types') "dummy" = "dummy" orelse
+        error "Illegal declaration of dummy type";
+  in (classes, default, types') end);
 
-fun syntactic types (Type (c, Ts)) =
-      (case Symtab.lookup types c of SOME Nonterminal => true | _ => false)
-        orelse exists (syntactic types) Ts
+fun syntactic tsig (Type (c, Ts)) =
+      (case lookup_type tsig c of SOME Nonterminal => true | _ => false)
+        orelse exists (syntactic tsig) Ts
   | syntactic _ _ = false;
 
 in
@@ -669,14 +670,14 @@
       (case subtract (op =) vs (map #1 (Term.add_tfreesT rhs' [])) of
         [] => []
       | extras => err ("Extra variables on rhs: " ^ commas_quote extras));
-  in types |> new_decl context (a, Abbreviation (vs, rhs', syntactic (#2 types) rhs')) end);
+  in types |> new_decl context (a, Abbreviation (vs, rhs', syntactic tsig rhs')) end);
 
 fun add_nonterminal context = map_types o new_decl context o rpair Nonterminal;
 
 end;
 
-fun hide_type fully c = map_tsig (fn (classes, default, (space, types)) =>
-  (classes, default, (Name_Space.hide fully c space, types)));
+fun hide_type fully c = map_tsig (fn (classes, default, types) =>
+  (classes, default, Name_Space.hide_table fully c types));
 
 
 (* merge type signatures *)
--- a/src/Pure/variable.ML	Mon Mar 10 10:13:47 2014 +0100
+++ b/src/Pure/variable.ML	Mon Mar 10 13:55:03 2014 +0100
@@ -175,7 +175,7 @@
 
 val names_of = #names o rep_data;
 val fixes_of = #fixes o rep_data;
-val fixes_space = #1 o fixes_of;
+val fixes_space = Name_Space.space_of_table o fixes_of;
 val binds_of = #binds o rep_data;
 val type_occs_of = #type_occs o rep_data;
 val maxidx_of = #maxidx o rep_data;
@@ -342,8 +342,8 @@
   in if is_fixed ctxt x' then SOME x' else NONE end;
 
 fun revert_fixed ctxt x =
-  (case Symtab.lookup (#2 (fixes_of ctxt)) x of
-    SOME x' => if intern_fixed ctxt x' = x then x' else x
+  (case Name_Space.lookup_key (fixes_of ctxt) x of
+    SOME (_, x') => if intern_fixed ctxt x' = x then x' else x
   | NONE => x);
 
 fun markup_fixed ctxt x =
@@ -351,8 +351,8 @@
   |> Markup.name (revert_fixed ctxt x);
 
 fun dest_fixes ctxt =
-  let val (space, tab) = fixes_of ctxt
-  in sort (Name_Space.entry_ord space o pairself #2) (map swap (Symtab.dest tab)) end;
+  Name_Space.fold_table (fn (x, y) => cons (y, x)) (fixes_of ctxt) []
+  |> sort (Name_Space.entry_ord (fixes_space ctxt) o pairself #2);
 
 
 (* collect variables *)
@@ -383,8 +383,8 @@
     let val context = Context.Proof ctxt |> Name_Space.map_naming (K Name_Space.default_naming) in
       ctxt
       |> map_fixes
-        (Name_Space.define context true (Binding.make (x', pos), x) #> snd #>>
-          Name_Space.alias Name_Space.default_naming (Binding.make (x, pos)) x')
+        (Name_Space.define context true (Binding.make (x', pos), x) #> snd #>
+          Name_Space.alias_table Name_Space.default_naming (Binding.make (x, pos)) x')
       |> declare_fixed x
       |> declare_constraints (Syntax.free x')
   end;
@@ -450,8 +450,8 @@
     val still_fixed = not o newly_fixed inner outer;
 
     val gen_fixes =
-      Symtab.fold (fn (y, _) => not (is_fixed outer y) ? cons y)
-        (#2 (fixes_of inner)) [];
+      Name_Space.fold_table (fn (y, _) => not (is_fixed outer y) ? cons y)
+        (fixes_of inner) [];
 
     val type_occs_inner = type_occs_of inner;
     fun gen_fixesT ts =
--- a/src/Tools/Code/code_thingol.ML	Mon Mar 10 10:13:47 2014 +0100
+++ b/src/Tools/Code/code_thingol.ML	Mon Mar 10 13:55:03 2014 +0100
@@ -877,7 +877,7 @@
   let
     val thy = Proof_Context.theory_of ctxt;
     fun consts_of thy' = Symtab.fold (fn (c, (_, NONE)) => cons c | _ => I)
-      ((snd o #constants o Consts.dest o Sign.consts_of) thy') [];
+      (#constants (Consts.dest (Sign.consts_of thy'))) [];
     fun belongs_here thy' c = forall
       (fn thy'' => not (Sign.declared_const thy'' c)) (Theory.parents_of thy');
     fun consts_of_select thy' = filter (belongs_here thy') (consts_of thy');