renamed ProofContext.add_fixes_i to ProofContext.add_fixes, eliminated obsolete external version;
authorwenzelm
Sat, 28 Mar 2009 17:53:33 +0100
changeset 30763 6976521b4263
parent 30762 cabf9ff3a129
child 30764 3e3e7aa0cc7a
renamed ProofContext.add_fixes_i to ProofContext.add_fixes, eliminated obsolete external version;
src/HOL/Nominal/nominal_inductive2.ML
src/HOL/Tools/function_package/fundef_lib.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.ML
src/Pure/Isar/proof_context.ML
src/Pure/Isar/rule_insts.ML
src/Pure/Isar/specification.ML
--- a/src/HOL/Nominal/nominal_inductive2.ML	Sat Mar 28 17:21:49 2009 +0100
+++ b/src/HOL/Nominal/nominal_inductive2.ML	Sat Mar 28 17:53:33 2009 +0100
@@ -181,7 +181,7 @@
       | xs => error ("No such case(s) in inductive definition: " ^ commas_quote xs));
     fun mk_avoids params name sets =
       let
-        val (_, ctxt') = ProofContext.add_fixes_i
+        val (_, ctxt') = ProofContext.add_fixes
           (map (fn (s, T) => (Binding.name s, SOME T, NoSyn)) params) ctxt;
         fun mk s =
           let
--- a/src/HOL/Tools/function_package/fundef_lib.ML	Sat Mar 28 17:21:49 2009 +0100
+++ b/src/HOL/Tools/function_package/fundef_lib.ML	Sat Mar 28 17:53:33 2009 +0100
@@ -55,7 +55,7 @@
 fun dest_all_all_ctx ctx (Const ("all", _) $ Abs (a as (n,T,b))) =
     let
       val [(n', _)] = Variable.variant_frees ctx [] [(n,T)]
-      val (_, ctx') = ProofContext.add_fixes_i [(Binding.name n', SOME T, NoSyn)] ctx
+      val (_, ctx') = ProofContext.add_fixes [(Binding.name n', SOME T, NoSyn)] ctx
 
       val (n'', body) = Term.dest_abs (n', T, b) 
       val _ = (n' = n'') orelse error "dest_all_ctx"
--- a/src/Pure/Isar/constdefs.ML	Sat Mar 28 17:21:49 2009 +0100
+++ b/src/Pure/Isar/constdefs.ML	Sat Mar 28 17:53:33 2009 +0100
@@ -25,13 +25,13 @@
     fun err msg ts = error (cat_lines (msg :: map (Syntax.string_of_term_global thy) ts));
 
     val thy_ctxt = ProofContext.init thy;
-    val struct_ctxt = #2 (ProofContext.add_fixes_i structs thy_ctxt);
+    val struct_ctxt = #2 (ProofContext.add_fixes structs thy_ctxt);
     val ((d, mx), var_ctxt) =
       (case raw_decl of
         NONE => ((NONE, NoSyn), struct_ctxt)
       | SOME raw_var =>
           struct_ctxt |> prep_vars [raw_var] |-> (fn [(x, T, mx)] =>
-            ProofContext.add_fixes_i [(x, T, mx)] #> snd #> pair (SOME x, mx)));
+            ProofContext.add_fixes [(x, T, mx)] #> snd #> pair (SOME x, mx)));
 
     val prop = prep_prop var_ctxt raw_prop;
     val (c, T) = #1 (LocalDefs.cert_def thy_ctxt (Logic.strip_imp_concl prop));
--- a/src/Pure/Isar/element.ML	Sat Mar 28 17:21:49 2009 +0100
+++ b/src/Pure/Isar/element.ML	Sat Mar 28 17:53:33 2009 +0100
@@ -486,7 +486,7 @@
 local
 
 fun activate_elem (Fixes fixes) ctxt =
-      ctxt |> ProofContext.add_fixes_i fixes |> snd
+      ctxt |> ProofContext.add_fixes fixes |> snd
   | activate_elem (Constrains _) ctxt =
       ctxt
   | activate_elem (Assumes asms) ctxt =
--- a/src/Pure/Isar/expression.ML	Sat Mar 28 17:21:49 2009 +0100
+++ b/src/Pure/Isar/expression.ML	Sat Mar 28 17:53:33 2009 +0100
@@ -271,7 +271,7 @@
 
 fun declare_elem prep_vars (Fixes fixes) ctxt =
       let val (vars, _) = prep_vars fixes ctxt
-      in ctxt |> ProofContext.add_fixes_i vars |> snd end
+      in ctxt |> ProofContext.add_fixes vars |> snd end
   | declare_elem prep_vars (Constrains csts) ctxt =
       ctxt |> prep_vars (map (fn (x, T) => (Binding.name x, SOME T, NoSyn)) csts) |> snd
   | declare_elem _ (Assumes _) ctxt = ctxt
@@ -368,7 +368,7 @@
       in check_autofix insts elems concl ctxt end;
 
     val fors = prep_vars_inst fixed ctxt1 |> fst;
-    val ctxt2 = ctxt1 |> ProofContext.add_fixes_i fors |> snd;
+    val ctxt2 = ctxt1 |> ProofContext.add_fixes fors |> snd;
     val (_, insts', ctxt3) = fold prep_insts raw_insts (0, [], ctxt2);
     val ctxt4 = init_body ctxt3;
     val (elems, ctxt5) = fold (prep_elem insts') raw_elems ([], ctxt4);
@@ -426,7 +426,7 @@
 (* Locale declaration: import + elements *)
 
 fun fix_params params =
-  ProofContext.add_fixes_i (map (fn ((x, T), mx) => (Binding.name x, SOME T, mx)) params) #> snd;
+  ProofContext.add_fixes (map (fn ((x, T), mx) => (Binding.name x, SOME T, mx)) params) #> snd;
 
 local
 
--- a/src/Pure/Isar/local_defs.ML	Sat Mar 28 17:21:49 2009 +0100
+++ b/src/Pure/Isar/local_defs.ML	Sat Mar 28 17:53:33 2009 +0100
@@ -96,7 +96,7 @@
     val lhss = map (fst o Logic.dest_equals) eqs;
   in
     ctxt
-    |> ProofContext.add_fixes_i (map2 (fn x => fn mx => (x, NONE, mx)) bvars mxs) |> #2
+    |> ProofContext.add_fixes (map2 (fn x => fn mx => (x, NONE, mx)) bvars mxs) |> #2
     |> fold Variable.declare_term eqs
     |> ProofContext.add_assms_i def_export
       (map2 (fn a => fn eq => (a, [(eq, [])])) (names ~~ atts) eqs)
@@ -115,7 +115,7 @@
     val T = Term.fastype_of rhs;
     val ([x'], ctxt') = ctxt
       |> Variable.declare_term rhs
-      |> ProofContext.add_fixes_i [(x, SOME T, mx)];
+      |> ProofContext.add_fixes [(x, SOME T, mx)];
     val lhs = Free (x', T);
     val _ = cert_def ctxt' (Logic.mk_equals (lhs, rhs));
     fun abbrev_export _ _ = (I, Envir.expand_term_frees [((x', T), rhs)]);
--- a/src/Pure/Isar/locale.ML	Sat Mar 28 17:21:49 2009 +0100
+++ b/src/Pure/Isar/locale.ML	Sat Mar 28 17:53:33 2009 +0100
@@ -306,7 +306,7 @@
   in PureThy.note_thmss kind facts' thy |> snd end
 
 fun init_local_elem (Fixes fixes) ctxt = ctxt |>
-      ProofContext.add_fixes_i fixes |> snd
+      ProofContext.add_fixes fixes |> snd
   | init_local_elem (Assumes assms) ctxt =
       let
         val assms' = Attrib.map_specs (Attrib.attribute_i (ProofContext.theory_of ctxt)) assms
--- a/src/Pure/Isar/obtain.ML	Sat Mar 28 17:21:49 2009 +0100
+++ b/src/Pure/Isar/obtain.ML	Sat Mar 28 17:53:33 2009 +0100
@@ -118,7 +118,7 @@
 
     (*obtain vars*)
     val (vars, vars_ctxt) = prep_vars raw_vars ctxt;
-    val (_, fix_ctxt) = vars_ctxt |> ProofContext.add_fixes_i vars;
+    val (_, fix_ctxt) = vars_ctxt |> ProofContext.add_fixes vars;
     val xs = map (Name.of_binding o #1) vars;
 
     (*obtain asms*)
--- a/src/Pure/Isar/proof.ML	Sat Mar 28 17:21:49 2009 +0100
+++ b/src/Pure/Isar/proof.ML	Sat Mar 28 17:53:33 2009 +0100
@@ -531,15 +531,15 @@
 
 local
 
-fun gen_fix add_fixes args =
+fun gen_fix prep_vars args =
   assert_forward
-  #> map_context (snd o add_fixes args)
+  #> map_context (fn ctxt => snd (ProofContext.add_fixes (prep_vars ctxt args) ctxt))
   #> put_facts NONE;
 
 in
 
-val fix = gen_fix ProofContext.add_fixes;
-val fix_i = gen_fix ProofContext.add_fixes_i;
+val fix = gen_fix (fn ctxt => fn args => fst (ProofContext.read_vars args ctxt));
+val fix_i = gen_fix (K I);
 
 end;
 
--- a/src/Pure/Isar/proof_context.ML	Sat Mar 28 17:21:49 2009 +0100
+++ b/src/Pure/Isar/proof_context.ML	Sat Mar 28 17:53:33 2009 +0100
@@ -108,10 +108,8 @@
     (binding * typ option * mixfix) list * Proof.context
   val cert_vars: (binding * typ option * mixfix) list -> Proof.context ->
     (binding * typ option * mixfix) list * Proof.context
-  val add_fixes: (binding * string option * mixfix) list ->
-    Proof.context -> string list * Proof.context
-  val add_fixes_i: (binding * typ option * mixfix) list ->
-    Proof.context -> string list * Proof.context
+  val add_fixes: (binding * typ option * mixfix) list -> Proof.context ->
+    string list * Proof.context
   val auto_fixes: Proof.context * (term list list * 'a) -> Proof.context * (term list list * 'a)
   val bind_fixes: string list -> Proof.context -> (term -> term) * Proof.context
   val add_assms: Assumption.export ->
@@ -1105,9 +1103,11 @@
     error ("Illegal mixfix syntax for internal/skolem constant " ^ quote x)
   else (true, (x, T, mx));
 
-fun gen_fixes prep raw_vars ctxt =
+in
+
+fun add_fixes raw_vars ctxt =
   let
-    val (vars, _) = prep raw_vars ctxt;
+    val (vars, _) = cert_vars raw_vars ctxt;
     val (xs', ctxt') = Variable.add_fixes (map (Name.of_binding o #1) vars) ctxt;
     val ctxt'' =
       ctxt'
@@ -1117,11 +1117,6 @@
       ContextPosition.report_visible ctxt (Markup.fixed_decl x') (Binding.pos_of b));
   in (xs', ctxt'') end;
 
-in
-
-val add_fixes = gen_fixes read_vars;
-val add_fixes_i = gen_fixes cert_vars;
-
 end;
 
 
@@ -1132,7 +1127,7 @@
 
 fun bind_fixes xs ctxt =
   let
-    val (_, ctxt') = ctxt |> add_fixes_i (map (fn x => (Binding.name x, NONE, NoSyn)) xs);
+    val (_, ctxt') = ctxt |> add_fixes (map (fn x => (Binding.name x, NONE, NoSyn)) xs);
     fun bind (t as Free (x, T)) =
           if member (op =) xs x then
             (case lookup_skolem ctxt' x of SOME x' => Free (x', T) | NONE => t)
--- a/src/Pure/Isar/rule_insts.ML	Sat Mar 28 17:21:49 2009 +0100
+++ b/src/Pure/Isar/rule_insts.ML	Sat Mar 28 17:53:33 2009 +0100
@@ -283,7 +283,7 @@
         val (param_names, ctxt') = ctxt
           |> Variable.declare_thm thm
           |> Thm.fold_terms Variable.declare_constraints st
-          |> ProofContext.add_fixes_i (map (fn (x, T) => (Binding.name x, SOME T, NoSyn)) params);
+          |> ProofContext.add_fixes (map (fn (x, T) => (Binding.name x, SOME T, NoSyn)) params);
 
         (* Process type insts: Tinsts_env *)
         fun absent xi = error
--- a/src/Pure/Isar/specification.ML	Sat Mar 28 17:21:49 2009 +0100
+++ b/src/Pure/Isar/specification.ML	Sat Mar 28 17:53:33 2009 +0100
@@ -108,7 +108,7 @@
     val thy = ProofContext.theory_of ctxt;
 
     val (vars, vars_ctxt) = ctxt |> prep_vars raw_vars;
-    val (xs, params_ctxt) = vars_ctxt |> ProofContext.add_fixes_i vars;
+    val (xs, params_ctxt) = vars_ctxt |> ProofContext.add_fixes vars;
 
     val Asss = (map o map) (map (parse_prop params_ctxt) o snd) raw_specss;
     val names = Variable.names_of (params_ctxt |> (fold o fold o fold) Variable.declare_term Asss)
@@ -312,7 +312,7 @@
               |> fold_map ProofContext.inferred_param xs;
             val asm = Term.list_all_free (xs ~~ Ts, Logic.list_implies (props, thesis));
           in
-            ctxt' |> (snd o ProofContext.add_fixes_i (map (fn b => (b, NONE, NoSyn)) bs));
+            ctxt' |> (snd o ProofContext.add_fixes (map (fn b => (b, NONE, NoSyn)) bs));
             ctxt' |> Variable.auto_fixes asm
             |> ProofContext.add_assms_i Assumption.assume_export
               [((name, [ContextRules.intro_query NONE]), [(asm, [])])]
@@ -325,7 +325,7 @@
         val stmt = [((Binding.empty, atts), [(thesis, [])])];
 
         val (facts, goal_ctxt) = elems_ctxt
-          |> (snd o ProofContext.add_fixes_i [(Binding.name AutoBind.thesisN, NONE, NoSyn)])
+          |> (snd o ProofContext.add_fixes [(Binding.name AutoBind.thesisN, NONE, NoSyn)])
           |> fold_map assume_case (obtains ~~ propp)
           |-> (fn ths => ProofContext.note_thmss Thm.assumptionK
                 [((Binding.name Obtain.thatN, []), [(ths, [])])] #> #2 #> pair ths);