simplified Name.variant -- discontinued builtin fold_map;
authorwenzelm
Thu, 09 Jun 2011 17:51:49 +0200
changeset 4420847cf4bc789aa
parent 44207 4384f4ae0574
child 44209 c835416237b3
simplified Name.variant -- discontinued builtin fold_map;
doc-src/IsarImplementation/Thy/Prelim.thy
doc-src/IsarImplementation/Thy/document/Prelim.tex
src/HOL/Boogie/Tools/boogie_loader.ML
src/HOL/Nominal/nominal_inductive.ML
src/HOL/Nominal/nominal_inductive2.ML
src/HOL/Nominal/nominal_primrec.ML
src/HOL/SPARK/Tools/spark_vcs.ML
src/HOL/Tools/Datatype/datatype_data.ML
src/HOL/Tools/Predicate_Compile/predicate_compile_aux.ML
src/HOL/Tools/Predicate_Compile/predicate_compile_fun.ML
src/HOL/Tools/primrec.ML
src/Pure/Isar/code.ML
src/Pure/ML/ml_antiquote.ML
src/Pure/Proof/proofchecker.ML
src/Pure/Syntax/syntax_trans.ML
src/Pure/name.ML
src/Pure/proofterm.ML
src/Pure/raw_simplifier.ML
src/Pure/term.ML
src/Pure/term_subst.ML
src/Pure/type.ML
src/Pure/variable.ML
src/Tools/Code/code_haskell.ML
src/Tools/Code/code_ml.ML
src/Tools/Code/code_namespace.ML
src/Tools/Code/code_printer.ML
src/Tools/Code/code_scala.ML
src/Tools/Code/code_thingol.ML
src/Tools/induct.ML
     1.1 --- a/doc-src/IsarImplementation/Thy/Prelim.thy	Thu Jun 09 17:46:25 2011 +0200
     1.2 +++ b/doc-src/IsarImplementation/Thy/Prelim.thy	Thu Jun 09 17:51:49 2011 +0200
     1.3 @@ -855,7 +855,7 @@
     1.4    @{index_ML Name.context: Name.context} \\
     1.5    @{index_ML Name.declare: "string -> Name.context -> Name.context"} \\
     1.6    @{index_ML Name.invents: "Name.context -> string -> int -> string list"} \\
     1.7 -  @{index_ML Name.variants: "string list -> Name.context -> string list * Name.context"} \\
     1.8 +  @{index_ML Name.variant: "string -> Name.context -> string * Name.context"} \\
     1.9    \end{mldecls}
    1.10    \begin{mldecls}
    1.11    @{index_ML Variable.names_of: "Proof.context -> Name.context"} \\
    1.12 @@ -878,8 +878,8 @@
    1.13    \item @{ML Name.invents}~@{text "context name n"} produces @{text
    1.14    "n"} fresh names derived from @{text "name"}.
    1.15  
    1.16 -  \item @{ML Name.variants}~@{text "names context"} produces fresh
    1.17 -  variants of @{text "names"}; the result is entered into the context.
    1.18 +  \item @{ML Name.variant}~@{text "name context"} produces a fresh
    1.19 +  variant of @{text "name"}; the result is declared to the context.
    1.20  
    1.21    \item @{ML Variable.names_of}~@{text "ctxt"} retrieves the context
    1.22    of declared type and term variable names.  Projecting a proof
    1.23 @@ -901,7 +901,7 @@
    1.24    @{assert} (list1 = ["a", "b", "c", "d", "e"]);
    1.25  
    1.26    val list2 =
    1.27 -    #1 (Name.variants ["x", "x", "a", "a", "'a", "'a"] Name.context);
    1.28 +    #1 (fold_map Name.variant ["x", "x", "a", "a", "'a", "'a"] Name.context);
    1.29    @{assert} (list2 = ["x", "xa", "a", "aa", "'a", "'aa"]);
    1.30  *}
    1.31  
    1.32 @@ -918,7 +918,7 @@
    1.33    @{assert} (list1 = ["d", "e", "f", "g", "h"]);
    1.34  
    1.35    val list2 =
    1.36 -    #1 (Name.variants ["x", "x", "a", "a", "'a", "'a"] names);
    1.37 +    #1 (fold_map Name.variant ["x", "x", "a", "a", "'a", "'a"] names);
    1.38    @{assert} (list2 = ["x", "xa", "aa", "ab", "'aa", "'ab"]);
    1.39  *}
    1.40  
     2.1 --- a/doc-src/IsarImplementation/Thy/document/Prelim.tex	Thu Jun 09 17:46:25 2011 +0200
     2.2 +++ b/doc-src/IsarImplementation/Thy/document/Prelim.tex	Thu Jun 09 17:51:49 2011 +0200
     2.3 @@ -1255,7 +1255,7 @@
     2.4    \indexdef{}{ML}{Name.context}\verb|Name.context: Name.context| \\
     2.5    \indexdef{}{ML}{Name.declare}\verb|Name.declare: string -> Name.context -> Name.context| \\
     2.6    \indexdef{}{ML}{Name.invents}\verb|Name.invents: Name.context -> string -> int -> string list| \\
     2.7 -  \indexdef{}{ML}{Name.variants}\verb|Name.variants: string list -> Name.context -> string list * Name.context| \\
     2.8 +  \indexdef{}{ML}{Name.variant}\verb|Name.variant: string -> Name.context -> string * Name.context| \\
     2.9    \end{mldecls}
    2.10    \begin{mldecls}
    2.11    \indexdef{}{ML}{Variable.names\_of}\verb|Variable.names_of: Proof.context -> Name.context| \\
    2.12 @@ -1277,8 +1277,8 @@
    2.13  
    2.14    \item \verb|Name.invents|~\isa{context\ name\ n} produces \isa{n} fresh names derived from \isa{name}.
    2.15  
    2.16 -  \item \verb|Name.variants|~\isa{names\ context} produces fresh
    2.17 -  variants of \isa{names}; the result is entered into the context.
    2.18 +  \item \verb|Name.variant|~\isa{name\ context} produces a fresh
    2.19 +  variant of \isa{name}; the result is declared to the context.
    2.20  
    2.21    \item \verb|Variable.names_of|~\isa{ctxt} retrieves the context
    2.22    of declared type and term variable names.  Projecting a proof
    2.23 @@ -1333,7 +1333,7 @@
    2.24  \ {\isaliteral{28}{\isacharparenleft}}list{\isadigit{1}}\ {\isaliteral{3D}{\isacharequal}}\ {\isaliteral{5B}{\isacharbrackleft}}{\isaliteral{22}{\isachardoublequote}}a{\isaliteral{22}{\isachardoublequote}}{\isaliteral{2C}{\isacharcomma}}\ {\isaliteral{22}{\isachardoublequote}}b{\isaliteral{22}{\isachardoublequote}}{\isaliteral{2C}{\isacharcomma}}\ {\isaliteral{22}{\isachardoublequote}}c{\isaliteral{22}{\isachardoublequote}}{\isaliteral{2C}{\isacharcomma}}\ {\isaliteral{22}{\isachardoublequote}}d{\isaliteral{22}{\isachardoublequote}}{\isaliteral{2C}{\isacharcomma}}\ {\isaliteral{22}{\isachardoublequote}}e{\isaliteral{22}{\isachardoublequote}}{\isaliteral{5D}{\isacharbrackright}}{\isaliteral{29}{\isacharparenright}}{\isaliteral{3B}{\isacharsemicolon}}\isanewline
    2.25  \isanewline
    2.26  \ \ val\ list{\isadigit{2}}\ {\isaliteral{3D}{\isacharequal}}\isanewline
    2.27 -\ \ \ \ {\isaliteral{23}{\isacharhash}}{\isadigit{1}}\ {\isaliteral{28}{\isacharparenleft}}Name{\isaliteral{2E}{\isachardot}}variants\ {\isaliteral{5B}{\isacharbrackleft}}{\isaliteral{22}{\isachardoublequote}}x{\isaliteral{22}{\isachardoublequote}}{\isaliteral{2C}{\isacharcomma}}\ {\isaliteral{22}{\isachardoublequote}}x{\isaliteral{22}{\isachardoublequote}}{\isaliteral{2C}{\isacharcomma}}\ {\isaliteral{22}{\isachardoublequote}}a{\isaliteral{22}{\isachardoublequote}}{\isaliteral{2C}{\isacharcomma}}\ {\isaliteral{22}{\isachardoublequote}}a{\isaliteral{22}{\isachardoublequote}}{\isaliteral{2C}{\isacharcomma}}\ {\isaliteral{22}{\isachardoublequote}}{\isaliteral{27}{\isacharprime}}a{\isaliteral{22}{\isachardoublequote}}{\isaliteral{2C}{\isacharcomma}}\ {\isaliteral{22}{\isachardoublequote}}{\isaliteral{27}{\isacharprime}}a{\isaliteral{22}{\isachardoublequote}}{\isaliteral{5D}{\isacharbrackright}}\ Name{\isaliteral{2E}{\isachardot}}context{\isaliteral{29}{\isacharparenright}}{\isaliteral{3B}{\isacharsemicolon}}\isanewline
    2.28 +\ \ \ \ {\isaliteral{23}{\isacharhash}}{\isadigit{1}}\ {\isaliteral{28}{\isacharparenleft}}fold{\isaliteral{5F}{\isacharunderscore}}map\ Name{\isaliteral{2E}{\isachardot}}variant\ {\isaliteral{5B}{\isacharbrackleft}}{\isaliteral{22}{\isachardoublequote}}x{\isaliteral{22}{\isachardoublequote}}{\isaliteral{2C}{\isacharcomma}}\ {\isaliteral{22}{\isachardoublequote}}x{\isaliteral{22}{\isachardoublequote}}{\isaliteral{2C}{\isacharcomma}}\ {\isaliteral{22}{\isachardoublequote}}a{\isaliteral{22}{\isachardoublequote}}{\isaliteral{2C}{\isacharcomma}}\ {\isaliteral{22}{\isachardoublequote}}a{\isaliteral{22}{\isachardoublequote}}{\isaliteral{2C}{\isacharcomma}}\ {\isaliteral{22}{\isachardoublequote}}{\isaliteral{27}{\isacharprime}}a{\isaliteral{22}{\isachardoublequote}}{\isaliteral{2C}{\isacharcomma}}\ {\isaliteral{22}{\isachardoublequote}}{\isaliteral{27}{\isacharprime}}a{\isaliteral{22}{\isachardoublequote}}{\isaliteral{5D}{\isacharbrackright}}\ Name{\isaliteral{2E}{\isachardot}}context{\isaliteral{29}{\isacharparenright}}{\isaliteral{3B}{\isacharsemicolon}}\isanewline
    2.29  \ \ %
    2.30  \isaantiq
    2.31  assert{}%
    2.32 @@ -1378,7 +1378,7 @@
    2.33  \ {\isaliteral{28}{\isacharparenleft}}list{\isadigit{1}}\ {\isaliteral{3D}{\isacharequal}}\ {\isaliteral{5B}{\isacharbrackleft}}{\isaliteral{22}{\isachardoublequote}}d{\isaliteral{22}{\isachardoublequote}}{\isaliteral{2C}{\isacharcomma}}\ {\isaliteral{22}{\isachardoublequote}}e{\isaliteral{22}{\isachardoublequote}}{\isaliteral{2C}{\isacharcomma}}\ {\isaliteral{22}{\isachardoublequote}}f{\isaliteral{22}{\isachardoublequote}}{\isaliteral{2C}{\isacharcomma}}\ {\isaliteral{22}{\isachardoublequote}}g{\isaliteral{22}{\isachardoublequote}}{\isaliteral{2C}{\isacharcomma}}\ {\isaliteral{22}{\isachardoublequote}}h{\isaliteral{22}{\isachardoublequote}}{\isaliteral{5D}{\isacharbrackright}}{\isaliteral{29}{\isacharparenright}}{\isaliteral{3B}{\isacharsemicolon}}\isanewline
    2.34  \isanewline
    2.35  \ \ val\ list{\isadigit{2}}\ {\isaliteral{3D}{\isacharequal}}\isanewline
    2.36 -\ \ \ \ {\isaliteral{23}{\isacharhash}}{\isadigit{1}}\ {\isaliteral{28}{\isacharparenleft}}Name{\isaliteral{2E}{\isachardot}}variants\ {\isaliteral{5B}{\isacharbrackleft}}{\isaliteral{22}{\isachardoublequote}}x{\isaliteral{22}{\isachardoublequote}}{\isaliteral{2C}{\isacharcomma}}\ {\isaliteral{22}{\isachardoublequote}}x{\isaliteral{22}{\isachardoublequote}}{\isaliteral{2C}{\isacharcomma}}\ {\isaliteral{22}{\isachardoublequote}}a{\isaliteral{22}{\isachardoublequote}}{\isaliteral{2C}{\isacharcomma}}\ {\isaliteral{22}{\isachardoublequote}}a{\isaliteral{22}{\isachardoublequote}}{\isaliteral{2C}{\isacharcomma}}\ {\isaliteral{22}{\isachardoublequote}}{\isaliteral{27}{\isacharprime}}a{\isaliteral{22}{\isachardoublequote}}{\isaliteral{2C}{\isacharcomma}}\ {\isaliteral{22}{\isachardoublequote}}{\isaliteral{27}{\isacharprime}}a{\isaliteral{22}{\isachardoublequote}}{\isaliteral{5D}{\isacharbrackright}}\ names{\isaliteral{29}{\isacharparenright}}{\isaliteral{3B}{\isacharsemicolon}}\isanewline
    2.37 +\ \ \ \ {\isaliteral{23}{\isacharhash}}{\isadigit{1}}\ {\isaliteral{28}{\isacharparenleft}}fold{\isaliteral{5F}{\isacharunderscore}}map\ Name{\isaliteral{2E}{\isachardot}}variant\ {\isaliteral{5B}{\isacharbrackleft}}{\isaliteral{22}{\isachardoublequote}}x{\isaliteral{22}{\isachardoublequote}}{\isaliteral{2C}{\isacharcomma}}\ {\isaliteral{22}{\isachardoublequote}}x{\isaliteral{22}{\isachardoublequote}}{\isaliteral{2C}{\isacharcomma}}\ {\isaliteral{22}{\isachardoublequote}}a{\isaliteral{22}{\isachardoublequote}}{\isaliteral{2C}{\isacharcomma}}\ {\isaliteral{22}{\isachardoublequote}}a{\isaliteral{22}{\isachardoublequote}}{\isaliteral{2C}{\isacharcomma}}\ {\isaliteral{22}{\isachardoublequote}}{\isaliteral{27}{\isacharprime}}a{\isaliteral{22}{\isachardoublequote}}{\isaliteral{2C}{\isacharcomma}}\ {\isaliteral{22}{\isachardoublequote}}{\isaliteral{27}{\isacharprime}}a{\isaliteral{22}{\isachardoublequote}}{\isaliteral{5D}{\isacharbrackright}}\ names{\isaliteral{29}{\isacharparenright}}{\isaliteral{3B}{\isacharsemicolon}}\isanewline
    2.38  \ \ %
    2.39  \isaantiq
    2.40  assert{}%
     3.1 --- a/src/HOL/Boogie/Tools/boogie_loader.ML	Thu Jun 09 17:46:25 2011 +0200
     3.2 +++ b/src/HOL/Boogie/Tools/boogie_loader.ML	Thu Jun 09 17:51:49 2011 +0200
     3.3 @@ -446,8 +446,7 @@
     3.4        val nctxt = Name.make_context (duplicates (op =) (names_of t []))
     3.5  
     3.6        fun fresh (i, nctxt) = (position_prefix ^ string_of_int i, (i+1, nctxt))
     3.7 -      fun renamed n (i, nctxt) =
     3.8 -        yield_singleton Name.variants n nctxt ||> pair i
     3.9 +      fun renamed n (i, nctxt) = Name.variant n nctxt ||> pair i
    3.10        fun mk_label (name, t) = @{term assert_at} $ Free (name, @{typ bool}) $ t
    3.11  
    3.12        fun unique t =
    3.13 @@ -472,11 +471,11 @@
    3.14          all_names
    3.15          |> map_filter (try (fn n => (n, short_var_name n)))
    3.16          |> split_list
    3.17 -        ||>> (fn names => Name.variants names (Name.make_context all_names))
    3.18 +        ||>> (fn names => fold_map Name.variant names (Name.make_context all_names))
    3.19          |>> Symtab.make o (op ~~)
    3.20  
    3.21        fun rename_free n = the_default n (Symtab.lookup names n)
    3.22 -      fun rename_abs n = yield_singleton Name.variants (short_var_name n)
    3.23 +      fun rename_abs n = Name.variant (short_var_name n)
    3.24  
    3.25        fun rename _ (Free (n, T)) = Free (rename_free n, T)
    3.26          | rename nctxt (Abs (n, T, t)) =
     4.1 --- a/src/HOL/Nominal/nominal_inductive.ML	Thu Jun 09 17:46:25 2011 +0200
     4.2 +++ b/src/HOL/Nominal/nominal_inductive.ML	Thu Jun 09 17:51:49 2011 +0200
     4.3 @@ -200,7 +200,7 @@
     4.4      val ind_sort = if null atomTs then HOLogic.typeS
     4.5        else Sign.minimize_sort thy (Sign.certify_sort thy (map (fn T => Sign.intern_class thy
     4.6          ("fs_" ^ Long_Name.base_name (fst (dest_Type T)))) atomTs));
     4.7 -    val ([fs_ctxt_tyname], _) = Name.variants ["'n"] (Variable.names_of ctxt');
     4.8 +    val (fs_ctxt_tyname, _) = Name.variant "'n" (Variable.names_of ctxt');
     4.9      val ([fs_ctxt_name], ctxt'') = Variable.variant_fixes ["z"] ctxt';
    4.10      val fsT = TFree (fs_ctxt_tyname, ind_sort);
    4.11  
     5.1 --- a/src/HOL/Nominal/nominal_inductive2.ML	Thu Jun 09 17:46:25 2011 +0200
     5.2 +++ b/src/HOL/Nominal/nominal_inductive2.ML	Thu Jun 09 17:51:49 2011 +0200
     5.3 @@ -226,7 +226,7 @@
     5.4      val ind_sort = if null atomTs then HOLogic.typeS
     5.5        else Sign.minimize_sort thy (Sign.certify_sort thy (map (fn a => Sign.intern_class thy
     5.6          ("fs_" ^ Long_Name.base_name a)) atoms));
     5.7 -    val ([fs_ctxt_tyname], _) = Name.variants ["'n"] (Variable.names_of ctxt');
     5.8 +    val (fs_ctxt_tyname, _) = Name.variant "'n" (Variable.names_of ctxt');
     5.9      val ([fs_ctxt_name], ctxt'') = Variable.variant_fixes ["z"] ctxt';
    5.10      val fsT = TFree (fs_ctxt_tyname, ind_sort);
    5.11  
     6.1 --- a/src/HOL/Nominal/nominal_primrec.ML	Thu Jun 09 17:46:25 2011 +0200
     6.2 +++ b/src/HOL/Nominal/nominal_primrec.ML	Thu Jun 09 17:51:49 2011 +0200
     6.3 @@ -36,7 +36,7 @@
     6.4    let
     6.5      val (vs, Ts) = split_list (strip_qnt_vars "all" t);
     6.6      val body = strip_qnt_body "all" t;
     6.7 -    val (vs', _) = Name.variants vs (Name.make_context (fold_aterms
     6.8 +    val (vs', _) = fold_map Name.variant vs (Name.make_context (fold_aterms
     6.9        (fn Free (v, _) => insert (op =) v | _ => I) body []))
    6.10    in (curry subst_bounds (map2 (curry Free) vs' Ts |> rev) body) end;
    6.11  
     7.1 --- a/src/HOL/SPARK/Tools/spark_vcs.ML	Thu Jun 09 17:46:25 2011 +0200
     7.2 +++ b/src/HOL/SPARK/Tools/spark_vcs.ML	Thu Jun 09 17:51:49 2011 +0200
     7.3 @@ -136,7 +136,7 @@
     7.4  fun mk_variables thy prfx xs ty (tab, ctxt) =
     7.5    let
     7.6      val T = mk_type thy prfx ty;
     7.7 -    val (ys, ctxt') = Name.variants (map mangle_name xs) ctxt;
     7.8 +    val (ys, ctxt') = fold_map Name.variant (map mangle_name xs) ctxt;
     7.9      val zs = map (Free o rpair T) ys;
    7.10    in (zs, (fold (Symtab.update o apsnd (rpair ty)) (xs ~~ zs) tab, ctxt')) end;
    7.11  
    7.12 @@ -779,7 +779,7 @@
    7.13        map_filter (fn s => lookup funs s |>
    7.14          Option.map (fn ty => (s, (SOME ty, pfun_type thy prfx ty)))) |>
    7.15        split_list ||> split_list;
    7.16 -    val (fs', ctxt') = Name.variants fs ctxt
    7.17 +    val (fs', ctxt') = fold_map Name.variant fs ctxt
    7.18    in
    7.19      (fold Symtab.update_new (fs ~~ (tys ~~ map Free (fs' ~~ Ts))) pfuns,
    7.20       Element.Fixes (map2 (fn s => fn T =>
     8.1 --- a/src/HOL/Tools/Datatype/datatype_data.ML	Thu Jun 09 17:46:25 2011 +0200
     8.2 +++ b/src/HOL/Tools/Datatype/datatype_data.ML	Thu Jun 09 17:51:49 2011 +0200
     8.3 @@ -134,7 +134,7 @@
     8.4  
     8.5      val names = map Long_Name.base_name (the_default tycos (#alt_names info));
     8.6      val (auxnames, _) = Name.make_context names
     8.7 -      |> fold_map (yield_singleton Name.variants o Datatype_Aux.name_of_typ) Us;
     8.8 +      |> fold_map (Name.variant o Datatype_Aux.name_of_typ) Us;
     8.9      val prefix = space_implode "_" names;
    8.10  
    8.11    in (descr, vs, tycos, prefix, (names, auxnames), (Ts, Us)) end;
     9.1 --- a/src/HOL/Tools/Predicate_Compile/predicate_compile_aux.ML	Thu Jun 09 17:46:25 2011 +0200
     9.2 +++ b/src/HOL/Tools/Predicate_Compile/predicate_compile_aux.ML	Thu Jun 09 17:51:49 2011 +0200
     9.3 @@ -542,7 +542,7 @@
     9.4  fun focus_ex t nctxt =
     9.5    let
     9.6      val ((xs, Ts), t') = apfst split_list (strip_ex t) 
     9.7 -    val (xs', nctxt') = Name.variants xs nctxt;
     9.8 +    val (xs', nctxt') = fold_map Name.variant xs nctxt;
     9.9      val ps' = xs' ~~ Ts;
    9.10      val vs = map Free ps';
    9.11      val t'' = Term.subst_bounds (rev vs, t');
    10.1 --- a/src/HOL/Tools/Predicate_Compile/predicate_compile_fun.ML	Thu Jun 09 17:46:25 2011 +0200
    10.2 +++ b/src/HOL/Tools/Predicate_Compile/predicate_compile_fun.ML	Thu Jun 09 17:51:49 2011 +0200
    10.3 @@ -84,8 +84,8 @@
    10.4      val (argTs, resT) = strip_type (fastype_of func)
    10.5      val nctxt =
    10.6        Name.make_context (Term.fold_aterms (fn Free (x, _) => insert (op =) x | _ => I) (func $ pred) [])
    10.7 -    val (argnames, nctxt') = Name.variants (replicate (length argTs) "a") nctxt
    10.8 -    val ([resname], nctxt'') = Name.variants ["r"] nctxt'
    10.9 +    val (argnames, nctxt') = fold_map Name.variant (replicate (length argTs) "a") nctxt
   10.10 +    val (resname, nctxt'') = Name.variant "r" nctxt'
   10.11      val args = map Free (argnames ~~ argTs)
   10.12      val res = Free (resname, resT)
   10.13    in Logic.mk_equals
    11.1 --- a/src/HOL/Tools/primrec.ML	Thu Jun 09 17:46:25 2011 +0200
    11.2 +++ b/src/HOL/Tools/primrec.ML	Thu Jun 09 17:51:49 2011 +0200
    11.3 @@ -38,7 +38,7 @@
    11.4    let
    11.5      val (vs, Ts) = split_list (strip_qnt_vars "all" spec);
    11.6      val body = strip_qnt_body "all" spec;
    11.7 -    val (vs', _) = Name.variants vs (Name.make_context (fold_aterms
    11.8 +    val (vs', _) = fold_map Name.variant vs (Name.make_context (fold_aterms
    11.9        (fn Free (v, _) => insert (op =) v | _ => I) body []));
   11.10      val eqn = curry subst_bounds (map2 (curry Free) vs' Ts |> rev) body;
   11.11      val (lhs, rhs) = HOLogic.dest_eq (HOLogic.dest_Trueprop eqn)
    12.1 --- a/src/Pure/Isar/code.ML	Thu Jun 09 17:46:25 2011 +0200
    12.2 +++ b/src/Pure/Isar/code.ML	Thu Jun 09 17:51:49 2011 +0200
    12.3 @@ -1145,8 +1145,8 @@
    12.4  
    12.5  fun case_cong thy case_const (num_args, (pos, _)) =
    12.6    let
    12.7 -    val ([x, y], ctxt) = Name.variants ["A", "A'"] Name.context;
    12.8 -    val (zs, _) = Name.variants (replicate (num_args - 1) "") ctxt;
    12.9 +    val ([x, y], ctxt) = fold_map Name.variant ["A", "A'"] Name.context;
   12.10 +    val (zs, _) = fold_map Name.variant (replicate (num_args - 1) "") ctxt;
   12.11      val (ws, vs) = chop pos zs;
   12.12      val T = Logic.unvarifyT_global (Sign.the_const_type thy case_const);
   12.13      val Ts = binder_types T;
    13.1 --- a/src/Pure/ML/ml_antiquote.ML	Thu Jun 09 17:46:25 2011 +0200
    13.2 +++ b/src/Pure/ML/ml_antiquote.ML	Thu Jun 09 17:51:49 2011 +0200
    13.3 @@ -29,7 +29,7 @@
    13.4  fun variant a ctxt =
    13.5    let
    13.6      val names = Names.get ctxt;
    13.7 -    val ([b], names') = Name.variants [a] names;
    13.8 +    val (b, names') = Name.variant a names;
    13.9      val ctxt' = Names.put names' ctxt;
   13.10    in (b, ctxt') end;
   13.11  
    14.1 --- a/src/Pure/Proof/proofchecker.ML	Thu Jun 09 17:46:25 2011 +0200
    14.2 +++ b/src/Pure/Proof/proofchecker.ML	Thu Jun 09 17:51:49 2011 +0200
    14.3 @@ -100,7 +100,7 @@
    14.4  
    14.5        | thm_of (vs, names) Hs (Abst (s, SOME T, prf)) =
    14.6            let
    14.7 -            val ([x], names') = Name.variants [s] names;
    14.8 +            val (x, names') = Name.variant s names;
    14.9              val thm = thm_of ((x, T) :: vs, names') Hs prf
   14.10            in
   14.11              Thm.forall_intr (Thm.cterm_of thy (Free (x, T))) thm
    15.1 --- a/src/Pure/Syntax/syntax_trans.ML	Thu Jun 09 17:46:25 2011 +0200
    15.2 +++ b/src/Pure/Syntax/syntax_trans.ML	Thu Jun 09 17:51:49 2011 +0200
    15.3 @@ -439,7 +439,7 @@
    15.4  (* dependent / nondependent quantifiers *)
    15.5  
    15.6  fun var_abs mark (x, T, b) =
    15.7 -  let val ([x'], _) = Name.variants [x] (Term.declare_term_names b Name.context)
    15.8 +  let val (x', _) = Name.variant x (Term.declare_term_names b Name.context)
    15.9    in (x', subst_bound (mark (x', T), b)) end;
   15.10  
   15.11  val variant_abs = var_abs Free;
    16.1 --- a/src/Pure/name.ML	Thu Jun 09 17:46:25 2011 +0200
    16.2 +++ b/src/Pure/name.ML	Thu Jun 09 17:51:49 2011 +0200
    16.3 @@ -24,7 +24,7 @@
    16.4    val invents: context -> string -> int -> string list
    16.5    val names: context -> string -> 'a list -> (string * 'a) list
    16.6    val invent_list: string list -> string -> int -> string list
    16.7 -  val variants: string list -> context -> string list * context
    16.8 +  val variant: string -> context -> string * context
    16.9    val variant_list: string list -> string list -> string list
   16.10    val desymbolize: bool -> string -> string
   16.11  end;
   16.12 @@ -115,7 +115,7 @@
   16.13  
   16.14  (*makes a variant of a name distinct from already used names in a
   16.15    context; preserves a suffix of underscores "_"*)
   16.16 -val variants = fold_map (fn name => fn ctxt =>
   16.17 +fun variant name ctxt =
   16.18    let
   16.19      fun vary x =
   16.20        (case declared ctxt x of
   16.21 @@ -133,9 +133,9 @@
   16.22              |> x0 <> x' ? declare_renaming (x0, x')
   16.23              |> declare x';
   16.24          in (x', ctxt') end;
   16.25 -  in (x' ^ replicate_string n "_", ctxt') end);
   16.26 +  in (x' ^ replicate_string n "_", ctxt') end;
   16.27  
   16.28 -fun variant_list used names = #1 (make_context used |> variants names);
   16.29 +fun variant_list used names = #1 (make_context used |> fold_map variant names);
   16.30  
   16.31  
   16.32  (* names conforming to typical requirements of identifiers in the world outside *)
    17.1 --- a/src/Pure/proofterm.ML	Thu Jun 09 17:46:25 2011 +0200
    17.2 +++ b/src/Pure/proofterm.ML	Thu Jun 09 17:51:49 2011 +0200
    17.3 @@ -657,7 +657,7 @@
    17.4        (fn TFree v => if member (op =) fixed v then I else insert (op =) v | _ => I)) t [];
    17.5      val used = Name.context
    17.6        |> fold_types (fold_atyps (fn TVar ((a, _), _) => Name.declare a | _ => I)) t;
    17.7 -    val fmap = fs ~~ #1 (Name.variants (map fst fs) used);
    17.8 +    val fmap = fs ~~ #1 (fold_map Name.variant (map fst fs) used);
    17.9      fun thaw (f as (a, S)) =
   17.10        (case AList.lookup (op =) fmap f of
   17.11          NONE => TFree f
    18.1 --- a/src/Pure/raw_simplifier.ML	Thu Jun 09 17:46:25 2011 +0200
    18.2 +++ b/src/Pure/raw_simplifier.ML	Thu Jun 09 17:51:49 2011 +0200
    18.3 @@ -305,7 +305,7 @@
    18.4  fun show_bounds (Simpset ({bounds = (_, bs), ...}, _)) t =
    18.5    let
    18.6      val names = Term.declare_term_names t Name.context;
    18.7 -    val xs = rev (#1 (Name.variants (rev (map #2 bs)) names));
    18.8 +    val xs = rev (#1 (fold_map Name.variant (rev (map #2 bs)) names));
    18.9      fun subst (((b, T), _), x') = (Free (b, T), Syntax_Trans.mark_boundT (x', T));
   18.10    in Term.subst_atomic (ListPair.map subst (bs, xs)) t end;
   18.11  
    19.1 --- a/src/Pure/term.ML	Thu Jun 09 17:46:25 2011 +0200
    19.2 +++ b/src/Pure/term.ML	Thu Jun 09 17:51:49 2011 +0200
    19.3 @@ -514,7 +514,8 @@
    19.4  val declare_term_frees = fold_aterms (fn Free (x, _) => Name.declare x | _ => I);
    19.5  
    19.6  fun variant_frees t frees =
    19.7 -  fst (Name.variants (map fst frees) (declare_term_names t Name.context)) ~~ map snd frees;
    19.8 +  fst (fold_map Name.variant (map fst frees) (declare_term_names t Name.context)) ~~
    19.9 +    map snd frees;
   19.10  
   19.11  fun rename_wrt_term t frees = rev (variant_frees t frees);  (*reversed result!*)
   19.12  
   19.13 @@ -705,7 +706,7 @@
   19.14      fun strip_abs t (0, used) = (([], t), (0, used))
   19.15        | strip_abs (Abs (v, T, t)) (k, used) =
   19.16            let
   19.17 -            val ([v'], used') = Name.variants [v] used;
   19.18 +            val (v', used') = Name.variant v used;
   19.19              val t' = subst_bound (Free (v', T), t);
   19.20              val ((vs, t''), (k', used'')) = strip_abs t' (k - 1, used');
   19.21            in (((v', T) :: vs, t''), (k', used'')) end
   19.22 @@ -713,7 +714,7 @@
   19.23      fun expand_eta [] t _ = ([], t)
   19.24        | expand_eta (T::Ts) t used =
   19.25            let
   19.26 -            val ([v], used') = Name.variants [""] used;
   19.27 +            val (v, used') = Name.variant "" used;
   19.28              val (vs, t') = expand_eta Ts (t $ Free (v, T)) used';
   19.29            in ((v, T) :: vs, t') end;
   19.30      val ((vs1, t'), (k', used')) = strip_abs t (k, used);
    20.1 --- a/src/Pure/term_subst.ML	Thu Jun 09 17:46:25 2011 +0200
    20.2 +++ b/src/Pure/term_subst.ML	Thu Jun 09 17:51:49 2011 +0200
    20.3 @@ -163,7 +163,7 @@
    20.4  fun zero_var_inst vars =
    20.5    fold (fn v as ((x, i), X) => fn (inst, used) =>
    20.6      let
    20.7 -      val ([x'], used') = Name.variants [if Name.is_bound x then "u" else x] used;
    20.8 +      val (x', used') = Name.variant (if Name.is_bound x then "u" else x) used;
    20.9      in if x = x' andalso i = 0 then (inst, used') else ((v, ((x', 0), X)) :: inst, used') end)
   20.10    vars ([], Name.context) |> #1;
   20.11  
    21.1 --- a/src/Pure/type.ML	Thu Jun 09 17:46:25 2011 +0200
    21.2 +++ b/src/Pure/type.ML	Thu Jun 09 17:51:49 2011 +0200
    21.3 @@ -345,7 +345,7 @@
    21.4        (fn TFree v => if member (op =) fixed v then I else insert (op =) v | _ => I)) t [];
    21.5      val used = Name.context
    21.6        |> fold_types (fold_atyps (fn TVar ((a, _), _) => Name.declare a | _ => I)) t;
    21.7 -    val fmap = fs ~~ map (rpair 0) (#1 (Name.variants (map fst fs) used));
    21.8 +    val fmap = fs ~~ map (rpair 0) (#1 (fold_map Name.variant (map fst fs) used));
    21.9      fun thaw (f as (_, S)) =
   21.10        (case AList.lookup (op =) fmap f of
   21.11          NONE => TFree f
    22.1 --- a/src/Pure/variable.ML	Thu Jun 09 17:46:25 2011 +0200
    22.2 +++ b/src/Pure/variable.ML	Thu Jun 09 17:51:49 2011 +0200
    22.3 @@ -255,7 +255,7 @@
    22.4  fun variant_frees ctxt ts frees =
    22.5    let
    22.6      val names = names_of (fold declare_names ts ctxt);
    22.7 -    val xs = fst (Name.variants (map #1 frees) names);
    22.8 +    val xs = fst (fold_map Name.variant (map #1 frees) names);
    22.9    in xs ~~ map snd frees end;
   22.10  
   22.11  
   22.12 @@ -365,7 +365,7 @@
   22.13      val xs = map check_name bs;
   22.14      val names = names_of ctxt;
   22.15      val (xs', names') =
   22.16 -      if is_body ctxt then Name.variants xs names |>> map Name.skolem
   22.17 +      if is_body ctxt then fold_map Name.variant xs names |>> map Name.skolem
   22.18        else (xs, fold Name.declare xs names);
   22.19    in ctxt |> new_fixes names' xs xs' (map Binding.pos_of bs) end;
   22.20  
   22.21 @@ -373,7 +373,7 @@
   22.22    let
   22.23      val names = names_of ctxt;
   22.24      val xs = map (fn x => Name.clean x |> can Name.dest_internal x ? Name.internal) raw_xs;
   22.25 -    val (xs', names') = Name.variants xs names |>> (is_body ctxt ? map Name.skolem);
   22.26 +    val (xs', names') = fold_map Name.variant xs names |>> (is_body ctxt ? map Name.skolem);
   22.27    in ctxt |> new_fixes names' xs xs' (replicate (length xs) Position.none) end;
   22.28  
   22.29  end;
    23.1 --- a/src/Tools/Code/code_haskell.ML	Thu Jun 09 17:46:25 2011 +0200
    23.2 +++ b/src/Tools/Code/code_haskell.ML	Thu Jun 09 17:51:49 2011 +0200
    23.3 @@ -264,13 +264,12 @@
    23.4    let
    23.5      fun namify_fun upper base (nsp_fun, nsp_typ) =
    23.6        let
    23.7 -        val (base', nsp_fun') = yield_singleton Name.variants
    23.8 -          (if upper then first_upper base else base) nsp_fun;
    23.9 +        val (base', nsp_fun') =
   23.10 +          Name.variant (if upper then first_upper base else base) nsp_fun;
   23.11        in (base', (nsp_fun', nsp_typ)) end;
   23.12      fun namify_typ base (nsp_fun, nsp_typ) =
   23.13        let
   23.14 -        val (base', nsp_typ') = yield_singleton Name.variants
   23.15 -          (first_upper base) nsp_typ
   23.16 +        val (base', nsp_typ') = Name.variant (first_upper base) nsp_typ;
   23.17        in (base', (nsp_fun, nsp_typ')) end;
   23.18      fun namify_stmt (Code_Thingol.Fun (_, (_, SOME _))) = pair
   23.19        | namify_stmt (Code_Thingol.Fun _) = namify_fun false
    24.1 --- a/src/Tools/Code/code_ml.ML	Thu Jun 09 17:46:25 2011 +0200
    24.2 +++ b/src/Tools/Code/code_ml.ML	Thu Jun 09 17:51:49 2011 +0200
    24.3 @@ -715,12 +715,12 @@
    24.4    let
    24.5      fun namify_const upper base (nsp_const, nsp_type) =
    24.6        let
    24.7 -        val (base', nsp_const') = yield_singleton Name.variants
    24.8 -          (if upper then first_upper base else base) nsp_const
    24.9 +        val (base', nsp_const') =
   24.10 +          Name.variant (if upper then first_upper base else base) nsp_const
   24.11        in (base', (nsp_const', nsp_type)) end;
   24.12      fun namify_type base (nsp_const, nsp_type) =
   24.13        let
   24.14 -        val (base', nsp_type') = yield_singleton Name.variants base nsp_type
   24.15 +        val (base', nsp_type') = Name.variant base nsp_type
   24.16        in (base', (nsp_const, nsp_type')) end;
   24.17      fun namify_stmt (Code_Thingol.Fun _) = namify_const false
   24.18        | namify_stmt (Code_Thingol.Datatype _) = namify_type
    25.1 --- a/src/Tools/Code/code_namespace.ML	Thu Jun 09 17:46:25 2011 +0200
    25.2 +++ b/src/Tools/Code/code_namespace.ML	Thu Jun 09 17:51:49 2011 +0200
    25.3 @@ -46,8 +46,7 @@
    25.4    let
    25.5      fun alias_fragments name = case module_alias name
    25.6       of SOME name' => Long_Name.explode name'
    25.7 -      | NONE => map (fn name => fst (yield_singleton Name.variants name reserved))
    25.8 -          (Long_Name.explode name);
    25.9 +      | NONE => map (fn name => fst (Name.variant name reserved)) (Long_Name.explode name);
   25.10      val module_names = Graph.fold (insert (op =) o fst o dest_name o fst) program [];
   25.11    in
   25.12      fold (fn name => Symtab.update (name, Long_Name.explode module_prefix @ alias_fragments name))
    26.1 --- a/src/Tools/Code/code_printer.ML	Thu Jun 09 17:46:25 2011 +0200
    26.2 +++ b/src/Tools/Code/code_printer.ML	Thu Jun 09 17:51:49 2011 +0200
    26.3 @@ -165,7 +165,7 @@
    26.4  
    26.5  fun intro_vars names (namemap, namectxt) =
    26.6    let
    26.7 -    val (names', namectxt') = Name.variants names namectxt;
    26.8 +    val (names', namectxt') = fold_map Name.variant names namectxt;
    26.9      val namemap' = fold2 (curry Symtab.update) names names' namemap;
   26.10    in (namemap', namectxt') end;
   26.11  
   26.12 @@ -186,7 +186,7 @@
   26.13      val fished1 = fold (map2 fish_param) lhss (replicate (length (hd lhss)) NONE);
   26.14      val x = singleton (Name.variant_list (map_filter I fished1)) "x";
   26.15      val fished2 = map_index (fillup_param x) fished1;
   26.16 -    val (fished3, _) = Name.variants fished2 Name.context;
   26.17 +    val (fished3, _) = fold_map Name.variant fished2 Name.context;
   26.18      val vars' = intro_vars fished3 vars;
   26.19    in map (lookup_var vars') fished3 end;
   26.20  
    27.1 --- a/src/Tools/Code/code_scala.ML	Thu Jun 09 17:46:25 2011 +0200
    27.2 +++ b/src/Tools/Code/code_scala.ML	Thu Jun 09 17:51:49 2011 +0200
    27.3 @@ -294,16 +294,16 @@
    27.4        in (name_fragment, ((declare nsp_class, declare nsp_object), declare nsp_common)) end;
    27.5      fun namify_class base ((nsp_class, nsp_object), nsp_common) =
    27.6        let
    27.7 -        val (base', nsp_class') = yield_singleton Name.variants base nsp_class
    27.8 +        val (base', nsp_class') = Name.variant base nsp_class
    27.9        in (base', ((nsp_class', nsp_object), Name.declare base' nsp_common)) end;
   27.10      fun namify_object base ((nsp_class, nsp_object), nsp_common) =
   27.11        let
   27.12 -        val (base', nsp_object') = yield_singleton Name.variants base nsp_object
   27.13 +        val (base', nsp_object') = Name.variant base nsp_object
   27.14        in (base', ((nsp_class, nsp_object'), Name.declare base' nsp_common)) end;
   27.15      fun namify_common upper base ((nsp_class, nsp_object), nsp_common) =
   27.16        let
   27.17          val (base', nsp_common') =
   27.18 -          yield_singleton Name.variants (if upper then first_upper base else base) nsp_common
   27.19 +          Name.variant (if upper then first_upper base else base) nsp_common
   27.20        in
   27.21          (base',
   27.22            ((Name.declare base' nsp_class, Name.declare base' nsp_object), nsp_common'))
    28.1 --- a/src/Tools/Code/code_thingol.ML	Thu Jun 09 17:46:25 2011 +0200
    28.2 +++ b/src/Tools/Code/code_thingol.ML	Thu Jun 09 17:51:49 2011 +0200
    28.3 @@ -354,7 +354,7 @@
    28.4  
    28.5  fun add_variant update (thing, name) (tab, used) =
    28.6    let
    28.7 -    val (name', used') = yield_singleton Name.variants name used;
    28.8 +    val (name', used') = Name.variant name used;
    28.9      val tab' = update (thing, name') tab;
   28.10    in (tab', used') end;
   28.11  
    29.1 --- a/src/Tools/induct.ML	Thu Jun 09 17:46:25 2011 +0200
    29.2 +++ b/src/Tools/induct.ML	Thu Jun 09 17:51:49 2011 +0200
    29.3 @@ -692,7 +692,7 @@
    29.4        | add (SOME (NONE, (t as Free _, _))) ctxt = ((SOME t, []), ctxt)
    29.5        | add (SOME (NONE, (t, _))) ctxt =
    29.6            let
    29.7 -            val ([s], _) = Name.variants ["x"] (Variable.names_of ctxt);
    29.8 +            val (s, _) = Name.variant "x" (Variable.names_of ctxt);
    29.9              val ([(lhs, (_, th))], ctxt') =
   29.10                Local_Defs.add_defs [((Binding.name s, NoSyn),
   29.11                  (Thm.empty_binding, t))] ctxt