use Name.of_binding for basic logical entities without name space (fixes, case names etc.);
authorwenzelm
Thu, 19 Mar 2009 13:28:55 +0100
changeset 30585 6b2ba4666336
parent 30584 7e839627b9e7
child 30586 9674f64a0702
use Name.of_binding for basic logical entities without name space (fixes, case names etc.);
src/Pure/Isar/class.ML
src/Pure/Isar/constdefs.ML
src/Pure/Isar/element.ML
src/Pure/Isar/expression.ML
src/Pure/Isar/local_defs.ML
src/Pure/Isar/locale.ML
src/Pure/Isar/obtain.ML
src/Pure/Isar/proof_context.ML
src/Pure/Isar/specification.ML
src/Pure/sign.ML
--- a/src/Pure/Isar/class.ML	Thu Mar 19 13:26:19 2009 +0100
+++ b/src/Pure/Isar/class.ML	Thu Mar 19 13:28:55 2009 +0100
@@ -236,7 +236,7 @@
         thy
         |> Sign.declare_const [] ((b, ty0), syn)
         |> snd
-        |> pair ((Binding.name_of b, ty), (c, ty'))
+        |> pair ((Name.of_binding b, ty), (c, ty'))
       end;
   in
     thy
--- a/src/Pure/Isar/constdefs.ML	Thu Mar 19 13:26:19 2009 +0100
+++ b/src/Pure/Isar/constdefs.ML	Thu Mar 19 13:28:55 2009 +0100
@@ -36,7 +36,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 Binding.name_of d of
+      (case Option.map Name.of_binding d of
         NONE => ()
       | SOME c' =>
           if c <> c' then
--- a/src/Pure/Isar/element.ML	Thu Mar 19 13:26:19 2009 +0100
+++ b/src/Pure/Isar/element.ML	Thu Mar 19 13:28:55 2009 +0100
@@ -96,7 +96,7 @@
 fun map_ctxt {binding, typ, term, pattern, fact, attrib} =
   fn Fixes fixes => Fixes (fixes |> map (fn (x, T, mx) => (binding x, Option.map typ T, mx)))
    | Constrains xs => Constrains (xs |> map (fn (x, T) =>
-      (Binding.name_of (binding (Binding.name x)), typ T)))
+      (Name.of_binding (binding (Binding.name x)), typ T)))
    | Assumes asms => Assumes (asms |> map (fn ((a, atts), propps) =>
       ((binding a, map attrib atts), propps |> map (fn (t, ps) => (term t, map pattern ps)))))
    | Defines defs => Defines (defs |> map (fn ((a, atts), (t, ps)) =>
--- a/src/Pure/Isar/expression.ML	Thu Mar 19 13:26:19 2009 +0100
+++ b/src/Pure/Isar/expression.ML	Thu Mar 19 13:28:55 2009 +0100
@@ -125,8 +125,8 @@
 
     val (implicit, expr') = params_expr expr;
 
-    val implicit' = map (#1 #> Binding.name_of) implicit;
-    val fixed' = map (#1 #> Binding.name_of) fixed;
+    val implicit' = map (#1 #> Name.of_binding) implicit;
+    val fixed' = map (#1 #> Name.of_binding) fixed;
     val _ = reject_dups "Duplicate fixed parameter(s): " fixed';
     val implicit'' =
       if strict then []
@@ -352,7 +352,7 @@
     fun prep_insts (loc, (prfx, inst)) (i, insts, ctxt) =
       let
         val (parm_names, parm_types) = Locale.params_of thy loc |>
-          map_split (fn (b, SOME T, _) => (Binding.name_of b, T))
+          map_split (fn (b, SOME T, _) => (Name.of_binding b, T))
             (*FIXME return value of Locale.params_of has strange type*)
         val inst' = prep_inst ctxt parm_names inst;
         val parm_types' = map (TypeInfer.paramify_vars o
@@ -386,7 +386,7 @@
       prep_concl raw_concl (insts', elems, ctxt5);
 
     (* Retrieve parameter types *)
-    val xs = fold (fn Fixes fixes => (fn ps => ps @ map (Binding.name_of o #1) fixes)
+    val xs = fold (fn Fixes fixes => (fn ps => ps @ map (Name.of_binding o #1) fixes)
       | _ => fn ps => ps) (Fixes fors :: elems') [];
     val (Ts, ctxt7) = fold_map ProofContext.inferred_param xs ctxt6;
     val parms = xs ~~ Ts;  (* params from expression and elements *)
--- a/src/Pure/Isar/local_defs.ML	Thu Mar 19 13:26:19 2009 +0100
+++ b/src/Pure/Isar/local_defs.ML	Thu Mar 19 13:28:55 2009 +0100
@@ -90,7 +90,7 @@
   let
     val ((bvars, mxs), specs) = defs |> split_list |>> split_list;
     val ((bfacts, atts), rhss) = specs |> split_list |>> split_list;
-    val xs = map Binding.name_of bvars;
+    val xs = map Name.of_binding bvars;
     val names = map2 Thm.def_binding_optional bvars bfacts;
     val eqs = mk_def ctxt (xs ~~ rhss);
     val lhss = map (fst o Logic.dest_equals) eqs;
--- a/src/Pure/Isar/locale.ML	Thu Mar 19 13:26:19 2009 +0100
+++ b/src/Pure/Isar/locale.ML	Thu Mar 19 13:28:55 2009 +0100
@@ -181,7 +181,7 @@
 fun axioms_of thy = #axioms o the_locale thy;
 
 fun instance_of thy name morph = params_of thy name |>
-  map ((fn (b, T, _) => Free (Binding.name_of b, the T)) #> Morphism.term morph);
+  map ((fn (b, T, _) => Free (Name.of_binding b, the T)) #> Morphism.term morph);
 
 fun specification_of thy = #spec o the_locale thy;
 
--- a/src/Pure/Isar/obtain.ML	Thu Mar 19 13:26:19 2009 +0100
+++ b/src/Pure/Isar/obtain.ML	Thu Mar 19 13:28:55 2009 +0100
@@ -119,7 +119,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 (Binding.name_of o #1) vars;
+    val xs = map (Name.of_binding o #1) vars;
 
     (*obtain asms*)
     val (asms_ctxt, proppss) = prep_propp (fix_ctxt, map snd raw_asms);
@@ -258,7 +258,7 @@
 
 fun inferred_type (binding, _, mx) ctxt =
   let
-    val x = Binding.name_of binding;
+    val x = Name.of_binding binding;
     val (T, ctxt') = ProofContext.inferred_param x ctxt
   in ((x, T, mx), ctxt') end;
 
--- a/src/Pure/Isar/proof_context.ML	Thu Mar 19 13:26:19 2009 +0100
+++ b/src/Pure/Isar/proof_context.ML	Thu Mar 19 13:28:55 2009 +0100
@@ -1003,7 +1003,7 @@
 fun prep_vars prep_typ internal =
   fold_map (fn (raw_b, raw_T, raw_mx) => fn ctxt =>
     let
-      val raw_x = Binding.name_of raw_b;
+      val raw_x = Name.of_binding 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);
@@ -1113,7 +1113,7 @@
 fun gen_fixes prep raw_vars ctxt =
   let
     val (vars, _) = prep raw_vars ctxt;
-    val (xs', ctxt') = Variable.add_fixes (map (Binding.name_of o #1) vars) ctxt;
+    val (xs', ctxt') = Variable.add_fixes (map (Name.of_binding 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	Thu Mar 19 13:26:19 2009 +0100
+++ b/src/Pure/Isar/specification.ML	Thu Mar 19 13:28:55 2009 +0100
@@ -161,7 +161,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), _) => (Binding.name_of b, T)) vars;
+    val xs = map (fn ((b, T), _) => (Name.of_binding b, T)) vars;
 
     (*consts*)
     val (consts, consts_thy) = thy |> fold_map (Theory.specify_const []) vars;
@@ -171,7 +171,7 @@
     val (axioms, axioms_thy) = (specs, consts_thy) |-> fold_map (fn ((b, atts), props) =>
         fold_map Thm.add_axiom
           (map (apfst (fn a => Binding.map_name (K a) b))
-            (PureThy.name_multi (Binding.name_of b) (map subst props)))
+            (PureThy.name_multi (Name.of_binding b) (map subst props)))
         #>> (fn ths => ((b, atts), [(map Drule.standard' ths, [])])));
 
     (*facts*)
@@ -198,7 +198,7 @@
         [] => (Binding.name x, NoSyn)
       | [((b, _), mx)] =>
           let
-            val y = Binding.name_of b;
+            val y = Name.of_binding b;
             val _ = x = y orelse
               error ("Head of definition " ^ quote x ^ " differs from declaration " ^ quote y ^
                 Position.str_of (Binding.pos_of b));
@@ -234,7 +234,7 @@
         [] => (Binding.name x, NoSyn)
       | [((b, _), mx)] =>
           let
-            val y = Binding.name_of b;
+            val y = Name.of_binding b;
             val _ = x = y orelse
               error ("Head of abbreviation " ^ quote x ^ " differs from declaration " ^ quote y ^
                 Position.str_of (Binding.pos_of b));
@@ -292,10 +292,10 @@
   | Element.Obtains obtains =>
       let
         val case_names = obtains |> map_index (fn (i, (b, _)) =>
-          if Binding.is_empty b then string_of_int (i + 1) else Binding.name_of b);
+          if Binding.is_empty b then string_of_int (i + 1) else Name.of_binding b);
         val constraints = obtains |> map (fn (_, (vars, _)) =>
           Element.Constrains
-            (vars |> map_filter (fn (x, SOME T) => SOME (Binding.name_of x, T) | _ => NONE)));
+            (vars |> map_filter (fn (x, SOME T) => SOME (Name.of_binding x, T) | _ => NONE)));
 
         val raw_propp = obtains |> map (fn (_, (_, props)) => map (rpair []) props);
         val (propp, elems_ctxt) = prep_stmt (elems @ constraints) raw_propp ctxt;
@@ -305,7 +305,7 @@
         fun assume_case ((name, (vars, _)), asms) ctxt' =
           let
             val bs = map fst vars;
-            val xs = map Binding.name_of bs;
+            val xs = map Name.of_binding bs;
             val props = map fst asms;
             val (Ts, _) = ctxt'
               |> fold Variable.declare_term props
--- a/src/Pure/sign.ML	Thu Mar 19 13:26:19 2009 +0100
+++ b/src/Pure/sign.ML	Thu Mar 19 13:28:55 2009 +0100
@@ -434,7 +434,7 @@
 
 fun add_types types thy = thy |> map_sign (fn (naming, syn, tsig, consts) =>
   let
-    val syn' = Syntax.update_type_gram (map (fn (a, n, mx) => (Binding.name_of a, n, mx)) types) syn;
+    val syn' = Syntax.update_type_gram (map (fn (a, n, mx) => (Name.of_binding a, n, mx)) types) syn;
     val decls = map (fn (a, n, mx) => (Binding.map_name (Syntax.type_name mx) a, n)) types;
     val tags = [(Markup.theory_nameN, Context.theory_name thy)];
     val tsig' = fold (Type.add_type naming tags) decls tsig;
@@ -445,7 +445,7 @@
 
 fun add_nonterminals ns thy = thy |> map_sign (fn (naming, syn, tsig, consts) =>
   let
-    val syn' = Syntax.update_consts (map Binding.name_of ns) syn;
+    val syn' = Syntax.update_consts (map Name.of_binding ns) syn;
     val tsig' = fold (Type.add_nonterminal naming []) ns tsig;
   in (naming, syn', tsig', consts) end);
 
@@ -456,7 +456,7 @@
   thy |> map_sign (fn (naming, syn, tsig, consts) =>
     let
       val ctxt = ProofContext.init thy;
-      val syn' = Syntax.update_type_gram [(Binding.name_of a, length vs, mx)] syn;
+      val syn' = Syntax.update_type_gram [(Name.of_binding a, length vs, mx)] syn;
       val b = Binding.map_name (Syntax.type_name mx) a;
       val abbr = (b, vs, certify_typ_mode Type.mode_syntax thy (parse_typ ctxt rhs))
         handle ERROR msg => cat_error msg ("in type abbreviation " ^ quote (Binding.str_of b));
@@ -504,10 +504,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 (Binding.name_of raw_b) raw_mx;
+        val (mx_name, mx) = Syntax.const_mixfix (Name.of_binding raw_b) raw_mx;
         val b = Binding.map_name (K mx_name) raw_b;
         val c = full_name thy b;
-        val c_syn = if authentic then Syntax.constN ^ c else Binding.name_of b;
+        val c_syn = if authentic then Syntax.constN ^ c else Name.of_binding b;
         val T = (prepT raw_T handle TYPE (msg, _, _) => error msg) handle ERROR msg =>
           cat_error msg ("in declaration of constant " ^ quote (Binding.str_of b));
         val T' = Logic.varifyT T;
@@ -568,7 +568,7 @@
 fun primitive_class (bclass, classes) thy =
   thy |> map_sign (fn (naming, syn, tsig, consts) =>
     let
-      val syn' = Syntax.update_consts [Binding.name_of bclass] syn;
+      val syn' = Syntax.update_consts [Name.of_binding bclass] syn;
       val tsig' = Type.add_class (Syntax.pp_global thy) naming (bclass, classes) tsig;
     in (naming, syn', tsig', consts) end)
   |> add_consts_i [(Binding.map_name Logic.const_of_class bclass, Term.a_itselfT --> propT, NoSyn)];