Name.name_of -> Binding.base_name
authorhaftmann
Fri, 05 Dec 2008 18:43:42 +0100
changeset 29006 abe0f11cfa4e
parent 29005 ce378dcfddab
child 29007 d808238131e7
Name.name_of -> Binding.base_name
src/HOL/Nominal/nominal_primrec.ML
src/HOL/Tools/function_package/fundef_common.ML
src/HOL/Tools/function_package/fundef_package.ML
src/HOL/Tools/inductive_package.ML
src/HOL/Tools/inductive_set_package.ML
src/HOL/Tools/primrec_package.ML
src/HOL/Tools/recdef_package.ML
src/HOL/Tools/specification_package.ML
src/HOLCF/Tools/fixrec_package.ML
src/Pure/General/binding.ML
src/Pure/Isar/class.ML
src/Pure/Isar/constdefs.ML
src/Pure/Isar/element.ML
src/Pure/Isar/expression.ML
src/Pure/Isar/isar_cmd.ML
src/Pure/Isar/isar_syn.ML
src/Pure/Isar/local_defs.ML
src/Pure/Isar/new_locale.ML
src/Pure/Isar/obtain.ML
src/Pure/Isar/proof_context.ML
src/Pure/Isar/specification.ML
src/Pure/Isar/theory_target.ML
src/Pure/Tools/invoke.ML
src/Pure/name.ML
src/Pure/sign.ML
src/ZF/Tools/inductive_package.ML
src/ZF/Tools/primrec_package.ML
--- a/src/HOL/Nominal/nominal_primrec.ML	Fri Dec 05 18:42:39 2008 +0100
+++ b/src/HOL/Nominal/nominal_primrec.ML	Fri Dec 05 18:43:42 2008 +0100
@@ -230,7 +230,7 @@
 fun gen_primrec_i note def alt_name invs fctxt eqns_atts thy =
   let
     val (raw_eqns, atts) = split_list eqns_atts;
-    val eqns = map (apfst Name.name_of) raw_eqns;
+    val eqns = map (apfst Binding.base_name) raw_eqns;
     val dt_info = NominalPackage.get_nominal_datatypes thy;
     val rec_eqns = fold_rev (process_eqn thy o snd) eqns [];
     val lsrs :: lsrss = maps (fn (_, (_, _, eqns)) =>
--- a/src/HOL/Tools/function_package/fundef_common.ML	Fri Dec 05 18:42:39 2008 +0100
+++ b/src/HOL/Tools/function_package/fundef_common.ML	Fri Dec 05 18:43:42 2008 +0100
@@ -82,7 +82,7 @@
                                       psimps, pinducts, termination, defname}) phi =
     let
       val term = Morphism.term phi val thm = Morphism.thm phi val fact = Morphism.fact phi
-      val name = Name.name_of o Morphism.binding phi o Binding.name
+      val name = Binding.base_name o Morphism.binding phi o Binding.name
     in
       FundefCtxData { add_simps = add_simps, case_names = case_names,
                       fs = map term fs, R = term R, psimps = fact psimps, 
--- a/src/HOL/Tools/function_package/fundef_package.ML	Fri Dec 05 18:42:39 2008 +0100
+++ b/src/HOL/Tools/function_package/fundef_package.ML	Fri Dec 05 18:43:42 2008 +0100
@@ -96,8 +96,8 @@
 fun gen_add_fundef is_external prep fixspec eqnss config flags lthy =
     let
       val ((fixes0, spec0), ctxt') = prep fixspec (map (fn (n_a, eq) => [(n_a, [eq])]) eqnss) lthy
-      val fixes = map (apfst (apfst Name.name_of)) fixes0;
-      val spec = map (apfst (apfst Name.name_of)) spec0;
+      val fixes = map (apfst (apfst Binding.base_name)) fixes0;
+      val spec = map (apfst (apfst Binding.base_name)) spec0;
       val (eqs, post, sort_cont, cnames) = FundefCommon.get_preproc lthy config flags ctxt' fixes spec
 
       val defname = mk_defname fixes
--- a/src/HOL/Tools/inductive_package.ML	Fri Dec 05 18:42:39 2008 +0100
+++ b/src/HOL/Tools/inductive_package.ML	Fri Dec 05 18:43:42 2008 +0100
@@ -260,7 +260,7 @@
 
 fun check_rule ctxt cs params ((binding, att), rule) =
   let
-    val name = Name.name_of binding;
+    val err_name = Binding.display binding;
     val params' = Term.variant_frees rule (Logic.strip_params rule);
     val frees = rev (map Free params');
     val concl = subst_bounds (frees, Logic.strip_assums_concl rule);
@@ -278,7 +278,7 @@
 
     fun check_prem' prem t =
       if head_of t mem cs then
-        check_ind (err_in_prem ctxt name rule prem) t
+        check_ind (err_in_prem ctxt err_name rule prem) t
       else (case t of
           Abs (_, _, t) => check_prem' prem t
         | t $ u => (check_prem' prem t; check_prem' prem u)
@@ -286,15 +286,15 @@
 
     fun check_prem (prem, aprem) =
       if can HOLogic.dest_Trueprop aprem then check_prem' prem prem
-      else err_in_prem ctxt name rule prem "Non-atomic premise";
+      else err_in_prem ctxt err_name rule prem "Non-atomic premise";
   in
     (case concl of
        Const ("Trueprop", _) $ t =>
          if head_of t mem cs then
-           (check_ind (err_in_rule ctxt name rule') t;
+           (check_ind (err_in_rule ctxt err_name rule') t;
             List.app check_prem (prems ~~ aprems))
-         else err_in_rule ctxt name rule' bad_concl
-     | _ => err_in_rule ctxt name rule' bad_concl);
+         else err_in_rule ctxt err_name rule' bad_concl
+     | _ => err_in_rule ctxt err_name rule' bad_concl);
     ((binding, att), arule)
   end;
 
@@ -638,7 +638,7 @@
 
     val rec_name =
       if Binding.is_empty alt_name then
-        Binding.name (space_implode "_" (map (Name.name_of o fst) cnames_syn))
+        Binding.name (space_implode "_" (map (Binding.base_name o fst) cnames_syn))
       else alt_name;
 
     val ((rec_const, (_, fp_def)), ctxt') = ctxt |>
@@ -671,9 +671,9 @@
 fun declare_rules kind rec_binding coind no_ind cnames intrs intr_bindings intr_atts
       elims raw_induct ctxt =
   let
-    val rec_name = Name.name_of rec_binding;
+    val rec_name = Binding.base_name rec_binding;
     val rec_qualified = Binding.qualify rec_name;
-    val intr_names = map Name.name_of intr_bindings;
+    val intr_names = map Binding.base_name intr_bindings;
     val ind_case_names = RuleCases.case_names intr_names;
     val induct =
       if coind then
@@ -730,11 +730,11 @@
     cs intros monos params cnames_syn ctxt =
   let
     val _ = null cnames_syn andalso error "No inductive predicates given";
-    val names = map (Name.name_of o fst) cnames_syn;
+    val names = map (Binding.base_name o fst) cnames_syn;
     val _ = message (quiet_mode andalso not verbose)
       ("Proofs for " ^ coind_prefix coind ^ "inductive predicate(s) " ^ commas_quote names);
 
-    val cnames = map (Sign.full_bname (ProofContext.theory_of ctxt) o Name.name_of o #1) cnames_syn;  (* FIXME *)
+    val cnames = map (Sign.full_name (ProofContext.theory_of ctxt) o #1) cnames_syn;  (* FIXME *)
     val ((intr_names, intr_atts), intr_ts) =
       apfst split_list (split_list (map (check_rule ctxt cs params) intros));
 
@@ -745,7 +745,7 @@
     val (intrs, unfold) = prove_intrs quiet_mode coind mono fp_def (length bs + length xs)
       params intr_ts rec_preds_defs ctxt1;
     val elims = if no_elim then [] else
-      prove_elims quiet_mode cs params intr_ts (map Name.name_of intr_names)
+      prove_elims quiet_mode cs params intr_ts (map Binding.base_name intr_names)
         unfold rec_preds_defs ctxt1;
     val raw_induct = zero_var_indexes
       (if no_ind then Drule.asm_rl else
@@ -789,16 +789,16 @@
 
     (* abbrevs *)
 
-    val (_, ctxt1) = Variable.add_fixes (map (Name.name_of o fst o fst) cnames_syn) lthy;
+    val (_, ctxt1) = Variable.add_fixes (map (Binding.base_name o fst o fst) cnames_syn) lthy;
 
     fun get_abbrev ((name, atts), t) =
       if can (Logic.strip_assums_concl #> Logic.dest_equals) t then
         let
-          val _ = Name.name_of name = "" andalso null atts orelse
+          val _ = Binding.is_empty name andalso null atts orelse
             error "Abbreviations may not have names or attributes";
           val ((x, T), rhs) = LocalDefs.abs_def (snd (LocalDefs.cert_def ctxt1 t));
           val var =
-            (case find_first (fn ((c, _), _) => Name.name_of c = x) cnames_syn of
+            (case find_first (fn ((c, _), _) => Binding.base_name c = x) cnames_syn of
               NONE => error ("Undeclared head of abbreviation " ^ quote x)
             | SOME ((b, T'), mx) =>
                 if T <> T' then error ("Bad type specification for abbreviation " ^ quote x)
@@ -807,17 +807,17 @@
       else NONE;
 
     val abbrevs = map_filter get_abbrev spec;
-    val bs = map (Name.name_of o fst o fst) abbrevs;
+    val bs = map (Binding.base_name o fst o fst) abbrevs;
 
 
     (* predicates *)
 
     val pre_intros = filter_out (is_some o get_abbrev) spec;
-    val cnames_syn' = filter_out (member (op =) bs o Name.name_of o fst o fst) cnames_syn;
-    val cs = map (Free o apfst Name.name_of o fst) cnames_syn';
+    val cnames_syn' = filter_out (member (op =) bs o Binding.base_name o fst o fst) cnames_syn;
+    val cs = map (Free o apfst Binding.base_name o fst) cnames_syn';
     val ps = map Free pnames;
 
-    val (_, ctxt2) = lthy |> Variable.add_fixes (map (Name.name_of o fst o fst) cnames_syn');
+    val (_, ctxt2) = lthy |> Variable.add_fixes (map (Binding.base_name o fst o fst) cnames_syn');
     val _ = map (fn abbr => LocalDefs.fixed_abbrev abbr ctxt2) abbrevs;
     val ctxt3 = ctxt2 |> fold (snd oo LocalDefs.fixed_abbrev) abbrevs;
     val expand = Assumption.export_term ctxt3 lthy #> ProofContext.cert_term lthy;
@@ -849,7 +849,7 @@
   in
     lthy
     |> LocalTheory.set_group (serial_string ())
-    |> gen_add_inductive_i mk_def flags cs (map (apfst Name.name_of o fst) ps) intrs monos
+    |> gen_add_inductive_i mk_def flags cs (map (apfst Binding.base_name o fst) ps) intrs monos
   end;
 
 val add_inductive_i = gen_add_inductive_i add_ind_def;
@@ -857,7 +857,7 @@
 
 fun add_inductive_global group flags cnames_syn pnames pre_intros monos thy =
   let
-    val name = Sign.full_bname thy (Name.name_of (fst (fst (hd cnames_syn))));
+    val name = Sign.full_name thy (fst (fst (hd cnames_syn)));
     val ctxt' = thy
       |> TheoryTarget.init NONE
       |> LocalTheory.set_group group
@@ -945,11 +945,11 @@
 fun flatten_specification specs = specs |> maps
   (fn (a, (concl, [])) => concl |> map
         (fn ((b, atts), [B]) =>
-              if Name.name_of a = "" then ((b, atts), B)
-              else if Name.name_of b = "" then ((a, atts), B)
+              if Binding.is_empty a then ((b, atts), B)
+              else if Binding.is_empty b then ((a, atts), B)
               else error "Illegal nested case names"
           | ((b, _), _) => error "Illegal simultaneous specification")
-    | (a, _) => error ("Illegal local specification parameters for " ^ quote (Name.name_of a)));
+    | (a, _) => error ("Illegal local specification parameters for " ^ quote (Binding.base_name a)));
 
 fun gen_ind_decl mk_def coind =
   P.fixes -- P.for_fixes --
--- a/src/HOL/Tools/inductive_set_package.ML	Fri Dec 05 18:42:39 2008 +0100
+++ b/src/HOL/Tools/inductive_set_package.ML	Fri Dec 05 18:43:42 2008 +0100
@@ -499,9 +499,9 @@
     (* convert theorems to set notation *)
     val rec_name =
       if Binding.is_empty alt_name then
-        Binding.name (space_implode "_" (map (Name.name_of o fst) cnames_syn))
+        Binding.name (space_implode "_" (map (Binding.base_name o fst) cnames_syn))
       else alt_name;
-    val cnames = map (Sign.full_bname (ProofContext.theory_of ctxt3) o Name.name_of o #1) cnames_syn;  (* FIXME *)
+    val cnames = map (Sign.full_name (ProofContext.theory_of ctxt3) o #1) cnames_syn;  (* FIXME *)
     val (intr_names, intr_atts) = split_list (map fst intros);
     val raw_induct' = to_set [] (Context.Proof ctxt3) raw_induct;
     val (intrs', elims', induct, ctxt4) =
--- a/src/HOL/Tools/primrec_package.ML	Fri Dec 05 18:42:39 2008 +0100
+++ b/src/HOL/Tools/primrec_package.ML	Fri Dec 05 18:43:42 2008 +0100
@@ -194,7 +194,7 @@
     val def_name = Thm.def_name (Sign.base_name fname);
     val rhs = singleton (Syntax.check_terms ctxt) raw_rhs;
     val SOME var = get_first (fn ((b, _), mx) =>
-      if Name.name_of b = fname then SOME (b, mx) else NONE) fixes;
+      if Binding.base_name b = fname then SOME (b, mx) else NONE) fixes;
   in (var, ((Binding.name def_name, []), rhs)) end;
 
 
@@ -231,7 +231,7 @@
   let
     val (fixes, spec) = prepare_spec prep_spec lthy raw_fixes raw_spec;
     val eqns = fold_rev (process_eqn (fn v => Variable.is_fixed lthy v
-      orelse exists (fn ((w, _), _) => v = Name.name_of w) fixes) o snd) spec [];
+      orelse exists (fn ((w, _), _) => v = Binding.base_name w) fixes) o snd) spec [];
     val tnames = distinct (op =) (map (#1 o snd) eqns);
     val dts = find_dts (DatatypePackage.get_datatypes (ProofContext.theory_of lthy)) tnames tnames;
     val main_fns = map (fn (tname, {index, ...}) =>
@@ -298,7 +298,7 @@
       P.name >> pair false) --| P.$$$ ")")) (false, "");
 
 val old_primrec_decl =
-  opt_unchecked_name -- Scan.repeat1 ((SpecParse.opt_thm_name ":" >> apfst Name.name_of) -- P.prop);
+  opt_unchecked_name -- Scan.repeat1 ((SpecParse.opt_thm_name ":" >> apfst Binding.base_name) -- P.prop);
 
 fun pipe_error t = P.!!! (Scan.fail_with (K
   (cat_lines ["Equations must be separated by " ^ quote "|", quote t])));
--- a/src/HOL/Tools/recdef_package.ML	Fri Dec 05 18:42:39 2008 +0100
+++ b/src/HOL/Tools/recdef_package.ML	Fri Dec 05 18:43:42 2008 +0100
@@ -299,7 +299,7 @@
 
 val recdef_decl =
   Scan.optional (P.$$$ "(" -- P.!!! (P.$$$ "permissive" -- P.$$$ ")") >> K false) true --
-  P.name -- P.term -- Scan.repeat1 ((SpecParse.opt_thm_name ":" >> apfst Name.name_of) -- P.prop)
+  P.name -- P.term -- Scan.repeat1 ((SpecParse.opt_thm_name ":" >> apfst Binding.base_name) -- P.prop)
     -- Scan.option hints
   >> (fn ((((p, f), R), eqs), src) => #1 o add_recdef p f R (map P.triple_swap eqs) src);
 
@@ -320,7 +320,7 @@
 val _ =
   OuterSyntax.local_theory_to_proof' "recdef_tc" "recommence proof of termination condition (TFL)"
     K.thy_goal
-    ((SpecParse.opt_thm_name ":" >> apfst Name.name_of) -- P.xname --
+    ((SpecParse.opt_thm_name ":" >> apfst Binding.base_name) -- P.xname --
         Scan.option (P.$$$ "(" |-- P.nat --| P.$$$ ")")
       >> (fn ((thm_name, name), i) => recdef_tc thm_name name i));
 
--- a/src/HOL/Tools/specification_package.ML	Fri Dec 05 18:42:39 2008 +0100
+++ b/src/HOL/Tools/specification_package.ML	Fri Dec 05 18:43:42 2008 +0100
@@ -233,7 +233,7 @@
 
 val specification_decl =
   P.$$$ "(" |-- Scan.repeat1 (opt_name -- P.term -- opt_overloaded) --| P.$$$ ")" --
-          Scan.repeat1 ((SpecParse.opt_thm_name ":" >> apfst Name.name_of) -- P.prop)
+          Scan.repeat1 ((SpecParse.opt_thm_name ":" >> apfst Binding.base_name) -- P.prop)
 
 val _ =
   OuterSyntax.command "specification" "define constants by specification" K.thy_goal
@@ -244,7 +244,7 @@
 val ax_specification_decl =
     P.name --
     (P.$$$ "(" |-- Scan.repeat1 (opt_name -- P.term -- opt_overloaded) --| P.$$$ ")" --
-           Scan.repeat1 ((SpecParse.opt_thm_name ":" >> apfst Name.name_of) -- P.prop))
+           Scan.repeat1 ((SpecParse.opt_thm_name ":" >> apfst Binding.base_name) -- P.prop))
 
 val _ =
   OuterSyntax.command "ax_specification" "define constants by specification" K.thy_goal
--- a/src/HOLCF/Tools/fixrec_package.ML	Fri Dec 05 18:42:39 2008 +0100
+++ b/src/HOLCF/Tools/fixrec_package.ML	Fri Dec 05 18:43:42 2008 +0100
@@ -226,7 +226,7 @@
     val lengths = map length blocks;
     
     val ((bindings, srcss), strings) = apfst split_list (split_list eqns);
-    val names = map Name.name_of bindings;
+    val names = map Binding.base_name bindings;
     val atts = map (map (prep_attrib thy)) srcss;
     val eqn_ts = map (prep_prop thy) strings;
     val rec_ts = map (fn eq => chead_of (fst (dest_eqs (Logic.strip_imp_concl eq)))
@@ -278,7 +278,7 @@
     val ts = map (prep_term thy) strings;
     val simps = map (fix_pat thy) ts;
   in
-    (snd o PureThy.add_thmss [((Name.name_of name, simps), atts)]) thy
+    (snd o PureThy.add_thmss [((Binding.base_name name, simps), atts)]) thy
   end;
 
 val add_fixpat = gen_add_fixpat Syntax.read_term_global Attrib.attribute;
--- a/src/Pure/General/binding.ML	Fri Dec 05 18:42:39 2008 +0100
+++ b/src/Pure/General/binding.ML	Fri Dec 05 18:43:42 2008 +0100
@@ -23,6 +23,7 @@
   val add_prefix: bool -> string -> T -> T
   val map_prefix: ((string * bool) list -> T -> T) -> T -> T
   val is_empty: T -> bool
+  val base_name: T -> string
   val pos_of: T -> Position.T
   val dest: T -> (string * bool) list * string
   val display: T -> string
@@ -56,7 +57,7 @@
   else path ^ "." ^ name;
 
 val qualify = map_base o qualify_base;
-  (*FIXME should all operations on bare names moved here from name_space.ML ?*)
+  (*FIXME should all operations on bare names move here from name_space.ML ?*)
 
 fun add_prefix sticky prfx b = if prfx = "" then error "empty name prefix"
   else (map_binding o apfst) (cons (prfx, sticky)) b;
@@ -65,6 +66,7 @@
   f prefix (name_pos (name, pos));
 
 fun is_empty (Binding ((_, name), _)) = name = "";
+fun base_name (Binding ((_, name), _)) = name;
 fun pos_of (Binding (_, pos)) = pos;
 fun dest (Binding (prefix_name, _)) = prefix_name;
 
--- a/src/Pure/Isar/class.ML	Fri Dec 05 18:42:39 2008 +0100
+++ b/src/Pure/Isar/class.ML	Fri Dec 05 18:43:42 2008 +0100
@@ -545,7 +545,7 @@
     val constrain = Element.Constrains ((map o apsnd o map_atyps)
       (K (TFree (Name.aT, base_sort))) supparams);
     fun fork_syn (Element.Fixes xs) =
-          fold_map (fn (c, ty, syn) => cons (Name.name_of c, syn) #> pair (c, ty, NoSyn)) xs
+          fold_map (fn (c, ty, syn) => cons (Binding.base_name c, syn) #> pair (c, ty, NoSyn)) xs
           #>> Element.Fixes
       | fork_syn x = pair x;
     fun fork_syntax elems =
--- a/src/Pure/Isar/constdefs.ML	Fri Dec 05 18:42:39 2008 +0100
+++ b/src/Pure/Isar/constdefs.ML	Fri Dec 05 18:43:42 2008 +0100
@@ -38,7 +38,7 @@
     val prop = prep_prop var_ctxt raw_prop;
     val (c, T) = #1 (LocalDefs.cert_def thy_ctxt (Logic.strip_imp_concl prop));
     val _ =
-      (case Option.map Name.name_of d of
+      (case Option.map Binding.base_name d of
         NONE => ()
       | SOME c' =>
           if c <> c' then
@@ -46,7 +46,7 @@
           else ());
 
     val def = Term.subst_atomic [(Free (c, T), Const (Sign.full_bname thy c, T))] prop;
-    val name = Thm.def_name_optional c (Name.name_of raw_name);
+    val name = Thm.def_name_optional c (Binding.base_name raw_name);
     val atts = map (prep_att thy) raw_atts;
 
     val thy' =
--- a/src/Pure/Isar/element.ML	Fri Dec 05 18:42:39 2008 +0100
+++ b/src/Pure/Isar/element.ML	Fri Dec 05 18:43:42 2008 +0100
@@ -113,7 +113,7 @@
   fn Fixes fixes => Fixes (fixes |> map (fn (x, T, mx) =>
        let val (x', mx') = var (x, mx) in (x', Option.map typ T, mx') end))
    | Constrains xs => Constrains (xs |> map (fn (x, T) =>
-       let val x' = Name.name_of (#1 (var (Binding.name x, NoSyn))) in (x', typ T) end))
+       let val x' = Binding.base_name (#1 (var (Binding.name x, NoSyn))) in (x', typ T) end))
    | Assumes asms => Assumes (asms |> map (fn ((a, atts), propps) =>
       ((binding a, map attrib atts), propps |> map (fn (t, ps) => (term t, map term ps)))))
    | Defines defs => Defines (defs |> map (fn ((a, atts), (t, ps)) =>
@@ -136,7 +136,7 @@
 (* logical content *)
 
 fun params_of (Fixes fixes) = fixes |> map
-    (fn (x, SOME T, _) => (Name.name_of x, T)
+    (fn (x, SOME T, _) => (Binding.base_name x, T)
       | (x, _, _) => raise TERM ("Untyped context element parameter " ^ quote (Binding.display x), []))
   | params_of _ = [];
 
@@ -182,8 +182,8 @@
       Pretty.block (Pretty.breaks (prt_name_atts a ":" @ prt_terms (map fst ts)));
 
     fun prt_var (x, SOME T) = Pretty.block
-          [Pretty.str (Name.name_of x ^ " ::"), Pretty.brk 1, prt_typ T]
-      | prt_var (x, NONE) = Pretty.str (Name.name_of x);
+          [Pretty.str (Binding.base_name x ^ " ::"), Pretty.brk 1, prt_typ T]
+      | prt_var (x, NONE) = Pretty.str (Binding.base_name x);
     val prt_vars = separate (Pretty.keyword "and") o map prt_var;
 
     fun prt_obtain (_, ([], ts)) = Pretty.block (Pretty.breaks (prt_terms ts))
@@ -207,9 +207,9 @@
     fun prt_mixfix NoSyn = []
       | prt_mixfix mx = [Pretty.brk 2, Syntax.pretty_mixfix mx];
 
-    fun prt_fix (x, SOME T, mx) = Pretty.block (Pretty.str (Name.name_of x ^ " ::") ::
+    fun prt_fix (x, SOME T, mx) = Pretty.block (Pretty.str (Binding.base_name x ^ " ::") ::
           Pretty.brk 1 :: prt_typ T :: Pretty.brk 1 :: prt_mixfix mx)
-      | prt_fix (x, NONE, mx) = Pretty.block (Pretty.str (Name.name_of x) ::
+      | prt_fix (x, NONE, mx) = Pretty.block (Pretty.str (Binding.base_name x) ::
           Pretty.brk 1 :: prt_mixfix mx);
     fun prt_constrain (x, T) = prt_fix (Binding.name x, SOME T, NoSyn);
 
@@ -395,7 +395,7 @@
 
 fun rename_var ren (b, mx) =
   let
-    val x = Name.name_of b;
+    val x = Binding.base_name b;
     val (x', mx') = rename_var_name ren (x, mx);
   in (Binding.name x', mx') end;
 
--- a/src/Pure/Isar/expression.ML	Fri Dec 05 18:42:39 2008 +0100
+++ b/src/Pure/Isar/expression.ML	Fri Dec 05 18:43:42 2008 +0100
@@ -134,8 +134,8 @@
         if null dups then () else error (message ^ commas dups)
       end;
 
-    fun match_bind (n, b) = (n = Name.name_of b);
-    fun bind_eq (b1, b2) = (Name.name_of b1 = Name.name_of b2);
+    fun match_bind (n, b) = (n = Binding.base_name b);
+    fun bind_eq (b1, b2) = (Binding.base_name b1 = Binding.base_name b2);
       (* FIXME: cannot compare bindings for equality. *)
 
     fun params_loc loc =
@@ -177,8 +177,8 @@
 
     val (implicit, expr') = params_expr expr;
 
-    val implicit' = map (#1 #> Name.name_of) implicit;
-    val fixed' = map (#1 #> Name.name_of) fixed;
+    val implicit' = map (#1 #> Binding.base_name) implicit;
+    val fixed' = map (#1 #> Binding.base_name) fixed;
     val _ = reject_dups "Duplicate fixed parameter(s): " fixed';
     val implicit'' = if strict then []
       else let val _ = reject_dups
@@ -385,7 +385,7 @@
       end;
 
 fun finish_primitive parms _ (Fixes fixes) = Fixes (map (fn (binding, _, mx) =>
-      let val x = Name.name_of binding
+      let val x = Binding.base_name binding
       in (binding, AList.lookup (op =) parms x, mx) end) fixes)
   | finish_primitive _ _ (Constrains _) = Constrains []
   | finish_primitive _ close (Assumes asms) = close (Assumes asms)
@@ -396,7 +396,7 @@
   let
     val thy = ProofContext.theory_of ctxt;
     val (parm_names, parm_types) = NewLocale.params_of thy loc |>
-      map (fn (b, SOME T, _) => (Name.name_of b, T)) |> split_list;
+      map (fn (b, SOME T, _) => (Binding.base_name b, T)) |> split_list;
     val (asm, defs) = NewLocale.specification_of thy loc;
     val (morph, _) = inst_morph (parm_names, parm_types) (prfx, inst) ctxt;
     val asm' = Option.map (Morphism.term morph) asm;
@@ -440,7 +440,7 @@
     fun prep_inst (loc, (prfx, inst)) (i, insts, ctxt) =
       let
         val (parm_names, parm_types) = NewLocale.params_of thy loc |>
-          map (fn (b, SOME T, _) => (Name.name_of b, T)) |> split_list;
+          map (fn (b, SOME T, _) => (Binding.base_name b, T)) |> split_list;
         val inst' = parse_inst parm_names inst ctxt;
         val parm_types' = map (TypeInfer.paramify_vars o
           Term.map_type_tvar (fn ((x, _), S) => TVar ((x, i), S)) o Logic.varifyT) parm_types;
@@ -473,7 +473,7 @@
     val (insts, elems, concl, ctxt) = prep_concl raw_concl (insts', elems'', ctxt'');
 
     (* Retrieve parameter types *)
-    val xs = fold (fn Fixes fixes => (fn ps => ps @ map (Name.name_of o #1) fixes) |
+    val xs = fold (fn Fixes fixes => (fn ps => ps @ map (Binding.base_name o #1) fixes) |
       _ => fn ps => ps) (Fixes fors :: elems) [];
     val (Ts, ctxt') = fold_map ProofContext.inferred_param xs ctxt; 
     val parms = xs ~~ Ts;  (* params from expression and elements *)
--- a/src/Pure/Isar/isar_cmd.ML	Fri Dec 05 18:42:39 2008 +0100
+++ b/src/Pure/Isar/isar_cmd.ML	Fri Dec 05 18:43:42 2008 +0100
@@ -167,7 +167,7 @@
 (* axioms *)
 
 fun add_axms f args thy =
-  f (map (fn ((b, ax), srcs) => ((Name.name_of b, ax), map (Attrib.attribute thy) srcs)) args) thy;
+  f (map (fn ((b, ax), srcs) => ((Binding.base_name b, ax), map (Attrib.attribute thy) srcs)) args) thy;
 
 val add_axioms = add_axms (snd oo PureThy.add_axioms_cmd);
 
--- a/src/Pure/Isar/isar_syn.ML	Fri Dec 05 18:42:39 2008 +0100
+++ b/src/Pure/Isar/isar_syn.ML	Fri Dec 05 18:43:42 2008 +0100
@@ -413,7 +413,7 @@
       opt_prefix  -- SpecParse.locale_expr -- SpecParse.locale_insts
         >> (fn ((name, expr), insts) => Toplevel.print o
             Toplevel.theory_to_proof
-              (Locale.interpretation_cmd (Name.name_of name) expr insts)));
+              (Locale.interpretation_cmd (Binding.base_name name) expr insts)));
 
 val _ =
   OuterSyntax.command "interpret"
@@ -422,7 +422,7 @@
     (opt_prefix -- SpecParse.locale_expr -- SpecParse.locale_insts
       >> (fn ((name, expr), insts) => Toplevel.print o
           Toplevel.proof'
-            (fn int => Locale.interpret_cmd (Name.name_of name) expr insts int)));
+            (fn int => Locale.interpret_cmd (Binding.base_name name) expr insts int)));
 
 
 (* classes *)
--- a/src/Pure/Isar/local_defs.ML	Fri Dec 05 18:42:39 2008 +0100
+++ b/src/Pure/Isar/local_defs.ML	Fri Dec 05 18:43:42 2008 +0100
@@ -91,7 +91,7 @@
   let
     val ((bvars, mxs), specs) = defs |> split_list |>> split_list;
     val ((bfacts, atts), rhss) = specs |> split_list |>> split_list;
-    val xs = map Name.name_of bvars;
+    val xs = map Binding.base_name bvars;
     val names = map2 (Binding.map_base o Thm.def_name_optional) xs bfacts;
     val eqs = mk_def ctxt (xs ~~ rhss);
     val lhss = map (fst o Logic.dest_equals) eqs;
--- a/src/Pure/Isar/new_locale.ML	Fri Dec 05 18:42:39 2008 +0100
+++ b/src/Pure/Isar/new_locale.ML	Fri Dec 05 18:43:42 2008 +0100
@@ -175,7 +175,7 @@
 
 fun instance_of thy name morph =
   params_of thy name |>
-    map ((fn (b, T, _) => Free (Name.name_of b, the T)) #> Morphism.term morph);
+    map ((fn (b, T, _) => Free (Binding.base_name b, the T)) #> Morphism.term morph);
 
 fun specification_of thy name =
   let
--- a/src/Pure/Isar/obtain.ML	Fri Dec 05 18:42:39 2008 +0100
+++ b/src/Pure/Isar/obtain.ML	Fri Dec 05 18:43:42 2008 +0100
@@ -122,7 +122,7 @@
     (*obtain vars*)
     val (vars, vars_ctxt) = prep_vars raw_vars ctxt;
     val (_, fix_ctxt) = vars_ctxt |> ProofContext.add_fixes_i vars;
-    val xs = map (Name.name_of o #1) vars;
+    val xs = map (Binding.base_name o #1) vars;
 
     (*obtain asms*)
     val (asms_ctxt, proppss) = prep_propp (fix_ctxt, map snd raw_asms);
@@ -261,7 +261,7 @@
 
 fun inferred_type (binding, _, mx) ctxt =
   let
-    val x = Name.name_of binding;
+    val x = Binding.base_name binding;
     val (T, ctxt') = ProofContext.inferred_param x ctxt
   in ((x, T, mx), ctxt') end;
 
--- a/src/Pure/Isar/proof_context.ML	Fri Dec 05 18:42:39 2008 +0100
+++ b/src/Pure/Isar/proof_context.ML	Fri Dec 05 18:43:42 2008 +0100
@@ -1012,7 +1012,7 @@
 fun prep_vars prep_typ internal =
   fold_map (fn (raw_b, raw_T, raw_mx) => fn ctxt =>
     let
-      val raw_x = Name.name_of raw_b;
+      val raw_x = Binding.base_name raw_b;
       val (x, mx) = Syntax.const_mixfix raw_x raw_mx;
       val _ = Syntax.is_identifier (no_skolem internal x) orelse
         error ("Illegal variable name: " ^ quote x);
@@ -1122,7 +1122,7 @@
 fun gen_fixes prep raw_vars ctxt =
   let
     val (vars, _) = prep raw_vars ctxt;
-    val (xs', ctxt') = Variable.add_fixes (map (Name.name_of o #1) vars) ctxt;
+    val (xs', ctxt') = Variable.add_fixes (map (Binding.base_name o #1) vars) ctxt;
     val ctxt'' =
       ctxt'
       |> fold_map declare_var (map2 (fn x' => fn (_, T, mx) => (x', T, mx)) xs' vars)
--- a/src/Pure/Isar/specification.ML	Fri Dec 05 18:42:39 2008 +0100
+++ b/src/Pure/Isar/specification.ML	Fri Dec 05 18:43:42 2008 +0100
@@ -153,7 +153,7 @@
 fun gen_axioms do_print prep raw_vars raw_specs thy =
   let
     val ((vars, specs), _) = prep raw_vars [raw_specs] (ProofContext.init thy);
-    val xs = map (fn ((b, T), _) => (Name.name_of b, T)) vars;
+    val xs = map (fn ((b, T), _) => (Binding.base_name b, T)) vars;
 
     (*consts*)
     val (consts, consts_thy) = thy |> fold_map (Theory.specify_const []) vars;
@@ -161,7 +161,7 @@
 
     (*axioms*)
     val (axioms, axioms_thy) = consts_thy |> fold_map (fn ((b, atts), props) =>
-        fold_map Thm.add_axiom (PureThy.name_multi (Name.name_of b) (map subst props))
+        fold_map Thm.add_axiom (PureThy.name_multi (Binding.base_name b) (map subst props))
         #>> (fn ths => ((b, atts), [(map Drule.standard' ths, [])]))) specs;
     val (facts, thy') = axioms_thy |> PureThy.note_thmss Thm.axiomK
       (Attrib.map_facts (Attrib.attribute_i axioms_thy) axioms);
@@ -187,7 +187,7 @@
         [] => (Binding.name x, NoSyn)
       | [((b, _), mx)] =>
           let
-            val y = Name.name_of b;
+            val y = Binding.base_name b;
             val _ = x = y orelse
               error ("Head of definition " ^ quote x ^ " differs from declaration " ^ quote y ^
                 Position.str_of (Binding.pos_of b));
@@ -220,7 +220,7 @@
         [] => (Binding.name x, NoSyn)
       | [((b, _), mx)] =>
           let
-            val y = Name.name_of b;
+            val y = Binding.base_name b;
             val _ = x = y orelse
               error ("Head of abbreviation " ^ quote x ^ " differs from declaration " ^ quote y ^
                 Position.str_of (Binding.pos_of b));
@@ -281,11 +281,11 @@
   | Element.Obtains obtains =>
       let
         val case_names = obtains |> map_index (fn (i, (b, _)) =>
-          let val name = Name.name_of b
+          let val name = Binding.base_name b
           in if name = "" then string_of_int (i + 1) else name end);
         val constraints = obtains |> map (fn (_, (vars, _)) =>
           Element.Constrains
-            (vars |> map_filter (fn (x, SOME T) => SOME (Name.name_of x, T) | _ => NONE)));
+            (vars |> map_filter (fn (x, SOME T) => SOME (Binding.base_name x, T) | _ => NONE)));
 
         val raw_propp = obtains |> map (fn (_, (_, props)) => map (rpair []) props);
         val (propp, elems_ctxt) = prep_stmt (elems @ constraints) raw_propp ctxt;
@@ -295,7 +295,7 @@
         fun assume_case ((name, (vars, _)), asms) ctxt' =
           let
             val bs = map fst vars;
-            val xs = map Name.name_of bs;
+            val xs = map Binding.base_name bs;
             val props = map fst asms;
             val (Ts, _) = ctxt'
               |> fold Variable.declare_term props
--- a/src/Pure/Isar/theory_target.ML	Fri Dec 05 18:42:39 2008 +0100
+++ b/src/Pure/Isar/theory_target.ML	Fri Dec 05 18:43:42 2008 +0100
@@ -200,7 +200,7 @@
     val similar_body = Type.similar_types (rhs, rhs');
     (* FIXME workaround based on educated guess *)
     val (prefix', _) = Binding.dest b';
-    val class_global = Name.name_of b = Name.name_of b'
+    val class_global = Binding.base_name b = Binding.base_name b'
       andalso not (null prefix')
       andalso (fst o snd o split_last) prefix' = Class.class_prefix target;
   in
@@ -219,7 +219,7 @@
 
 fun declare_const (ta as Target {target, is_locale, is_class, ...}) depends ((b, T), mx) lthy =
   let
-    val c = Name.name_of b;
+    val c = Binding.base_name b;
     val tags = LocalTheory.group_position_of lthy;
     val xs = filter depends (#1 (ProofContext.inferred_fixes (LocalTheory.target_of lthy)));
     val U = map #2 xs ---> T;
@@ -252,7 +252,7 @@
 
 fun abbrev (ta as Target {target, is_locale, is_class, ...}) prmode ((b, mx), t) lthy =
   let
-    val c = Name.name_of b;
+    val c = Binding.base_name b;
     val tags = LocalTheory.group_position_of lthy;
     val thy_ctxt = ProofContext.init (ProofContext.theory_of lthy);
     val target_ctxt = LocalTheory.target_of lthy;
@@ -289,7 +289,7 @@
     val thy = ProofContext.theory_of lthy;
     val thy_ctxt = ProofContext.init thy;
 
-    val c = Name.name_of b;
+    val c = Binding.base_name b;
     val name' = Binding.map_base (Thm.def_name_optional c) name;
     val (rhs', rhs_conv) =
       LocalDefs.export_cterm lthy thy_ctxt (Thm.cterm_of thy rhs) |>> Thm.term_of;
@@ -310,7 +310,7 @@
           then (fn name => fn eq => Thm.add_def false false (name, Logic.mk_equals eq))
           else (fn name => fn (Const (c, _), rhs) => AxClass.define_overloaded name (c, rhs)));
     val (global_def, lthy3) = lthy2
-      |> LocalTheory.theory_result (define_const (Name.name_of name') (lhs', rhs'));
+      |> LocalTheory.theory_result (define_const (Binding.base_name name') (lhs', rhs'));
     val def = LocalDefs.trans_terms lthy3
       [(*c == global.c xs*)     local_def,
        (*global.c xs == rhs'*)  global_def,
--- a/src/Pure/Tools/invoke.ML	Fri Dec 05 18:42:39 2008 +0100
+++ b/src/Pure/Tools/invoke.ML	Fri Dec 05 18:43:42 2008 +0100
@@ -120,7 +120,7 @@
     (K.tag_proof K.prf_goal)
     (SpecParse.opt_thm_name ":" -- SpecParse.locale_expr -- SpecParse.locale_insts -- P.for_fixes
       >> (fn ((((name, atts), expr), (insts, _)), fixes) =>
-          Toplevel.print o Toplevel.proof' (invoke (Name.name_of name, atts) expr insts fixes)));
+          Toplevel.print o Toplevel.proof' (invoke (Binding.base_name name, atts) expr insts fixes)));
 
 end;
 
--- a/src/Pure/name.ML	Fri Dec 05 18:42:39 2008 +0100
+++ b/src/Pure/name.ML	Fri Dec 05 18:43:42 2008 +0100
@@ -27,8 +27,6 @@
   val variants: string list -> context -> string list * context
   val variant_list: string list -> string list -> string list
   val variant: string list -> string -> string
-
-  val name_of: Binding.T -> string (*FIMXE legacy*)
 end;
 
 structure Name: NAME =
@@ -140,9 +138,4 @@
 fun variant_list used names = #1 (make_context used |> variants names);
 fun variant used = singleton (variant_list used);
 
-
-(** generic name bindings -- legacy **)
-
-val name_of = snd o Binding.dest;
-
 end;
--- a/src/Pure/sign.ML	Fri Dec 05 18:42:39 2008 +0100
+++ b/src/Pure/sign.ML	Fri Dec 05 18:43:42 2008 +0100
@@ -508,10 +508,10 @@
     val prepT = Type.no_tvars o Term.no_dummyT o certify_typ thy o parse_typ ctxt;
     fun prep (raw_b, raw_T, raw_mx) =
       let
-        val (mx_name, mx) = Syntax.const_mixfix (Name.name_of raw_b) raw_mx;
+        val (mx_name, mx) = Syntax.const_mixfix (Binding.base_name raw_b) raw_mx;
         val b = Binding.map_base (K mx_name) raw_b;
         val c = full_name thy b;
-        val c_syn = if authentic then Syntax.constN ^ c else Name.name_of b;
+        val c_syn = if authentic then Syntax.constN ^ c else Binding.base_name b;
         val T = (prepT raw_T handle TYPE (msg, _, _) => error msg) handle ERROR msg =>
           cat_error msg ("in declaration of constant " ^ quote (Binding.display b));
         val T' = Logic.varifyT T;
--- a/src/ZF/Tools/inductive_package.ML	Fri Dec 05 18:42:39 2008 +0100
+++ b/src/ZF/Tools/inductive_package.ML	Fri Dec 05 18:43:42 2008 +0100
@@ -67,7 +67,7 @@
   val _ = Theory.requires thy "Inductive_ZF" "(co)inductive definitions";
   val ctxt = ProofContext.init thy;
 
-  val intr_specs = map (apfst (apfst Name.name_of)) raw_intr_specs;
+  val intr_specs = map (apfst (apfst Binding.base_name)) raw_intr_specs;
   val (intr_names, intr_tms) = split_list (map fst intr_specs);
   val case_names = RuleCases.case_names intr_names;
 
--- a/src/ZF/Tools/primrec_package.ML	Fri Dec 05 18:42:39 2008 +0100
+++ b/src/ZF/Tools/primrec_package.ML	Fri Dec 05 18:43:42 2008 +0100
@@ -180,7 +180,7 @@
 
     val (eqn_thms', thy2) =
       thy1
-      |> PureThy.add_thms ((map Name.name_of eqn_names ~~ eqn_thms) ~~ eqn_atts);
+      |> PureThy.add_thms ((map Binding.base_name eqn_names ~~ eqn_thms) ~~ eqn_atts);
     val (_, thy3) =
       thy2
       |> PureThy.add_thmss [(("simps", eqn_thms'), [Simplifier.simp_add])]