src/HOL/Tools/Predicate_Compile/predicate_compile_core.ML
changeset 43324 2b47822868e4
parent 43253 fa3c61dc9f2c
child 43619 3803869014aa
--- a/src/HOL/Tools/Predicate_Compile/predicate_compile_core.ML	Thu Jun 09 15:38:49 2011 +0200
+++ b/src/HOL/Tools/Predicate_Compile/predicate_compile_core.ML	Thu Jun 09 16:34:49 2011 +0200
@@ -302,7 +302,7 @@
   mk_random = (fn _ => error "no random generation"),
   additional_arguments = fn names =>
     let
-      val depth_name = Name.variant names "depth"
+      val depth_name = singleton (Name.variant_list names) "depth"
     in [Free (depth_name, @{typ code_numeral})] end,
   modify_funT = (fn T => let val (Ts, U) = strip_type T
   val Ts' = [@{typ code_numeral}] in (Ts @ Ts') ---> U end),
@@ -563,7 +563,7 @@
       NONE => (Free (s, T), (names, (s, [])::vs))
     | SOME xs =>
         let
-          val s' = Name.variant names s;
+          val s' = singleton (Name.variant_list names) s;
           val v = Free (s', T)
         in
           (v, (s'::names, AList.update (op =) (s, v::xs) vs))
@@ -626,8 +626,8 @@
     val eqs'' =
       map (compile_arg compilation_modifiers additional_arguments ctxt param_modes) eqs''
     val names = fold Term.add_free_names (success_t :: eqs'' @ out_ts) [];
-    val name = Name.variant names "x";
-    val name' = Name.variant (name :: names) "y";
+    val name = singleton (Name.variant_list names) "x";
+    val name' = singleton (Name.variant_list (name :: names)) "y";
     val T = HOLogic.mk_tupleT (map fastype_of out_ts);
     val U = fastype_of success_t;
     val U' = dest_predT compfuns U;
@@ -905,7 +905,7 @@
       let
         val (i, is) = argument_position_of mode position
         val inp_var = nth_pair is (nth in_ts' i)
-        val x = Name.variant all_vs "x"
+        val x = singleton (Name.variant_list all_vs) "x"
         val xt = Free (x, fastype_of inp_var)
         fun compile_single_case ((c, T), switched) =
           let
@@ -962,7 +962,7 @@
           (Free (hd param_vs, T), (tl param_vs, names))
         else
           let
-            val new = Name.variant names "x"
+            val new = singleton (Name.variant_list names) "x"
           in (Free (new, T), (param_vs, new :: names)) end)) inpTs
         (param_vs, (all_vs @ param_vs))
     val in_ts' = map_filter (map_filter_prod
@@ -1009,7 +1009,7 @@
 fun mk_args is_eval (m as Pair (m1, m2), T as Type (@{type_name Product_Type.prod}, [T1, T2])) names =
     if eq_mode (m, Input) orelse eq_mode (m, Output) then
       let
-        val x = Name.variant names "x"
+        val x = singleton (Name.variant_list names) "x"
       in
         (Free (x, T), x :: names)
       end
@@ -1023,7 +1023,7 @@
   | mk_args is_eval ((m as Fun _), T) names =
     let
       val funT = funT_of PredicateCompFuns.compfuns m T
-      val x = Name.variant names "x"
+      val x = singleton (Name.variant_list names) "x"
       val (args, _) = fold_map (mk_args is_eval) (strip_fun_mode m ~~ binder_types T) (x :: names)
       val (inargs, outargs) = split_map_mode (fn _ => fn t => (SOME t, NONE)) m args
       val t = fold_rev HOLogic.tupled_lambda args (PredicateCompFuns.mk_Eval
@@ -1033,7 +1033,7 @@
     end
   | mk_args is_eval (_, T) names =
     let
-      val x = Name.variant names "x"
+      val x = singleton (Name.variant_list names) "x"
     in
       (Free (x, T), x :: names)
     end