tuned signature;
authorwenzelm
Wed, 22 Jun 2016 10:40:53 +0200
changeset 63344 c9910404cc8a
parent 63343 fb5d8a50c641
child 63345 70b2313f9c52
tuned signature; tuned;
src/HOL/Library/simps_case_conv.ML
src/Pure/Isar/generic_target.ML
src/Pure/Isar/local_defs.ML
src/Pure/Isar/proof.ML
src/Tools/induct.ML
--- a/src/HOL/Library/simps_case_conv.ML	Wed Jun 22 10:09:20 2016 +0200
+++ b/src/HOL/Library/simps_case_conv.ML	Wed Jun 22 10:40:53 2016 +0200
@@ -136,8 +136,8 @@
       let
         val frees = fold Term.add_frees pat []
         val abs_rhs = fold absfree frees rhs
-        val ((f,def), lthy') = Local_Defs.add_def
-          ((Binding.name name, Mixfix.NoSyn), abs_rhs) lthy
+        val ([(f, (_, def))], lthy') = lthy
+          |> Local_Defs.define [((Binding.name name, Mixfix.NoSyn), (Thm.empty_binding, abs_rhs))]
       in ((list_comb (f, map Free (rev frees)), def), lthy') end
 
     val ((def_ts, def_thms), ctxt2) =
--- a/src/Pure/Isar/generic_target.ML	Wed Jun 22 10:09:20 2016 +0200
+++ b/src/Pure/Isar/generic_target.ML	Wed Jun 22 10:40:53 2016 +0200
@@ -241,8 +241,8 @@
       |> foundation (((b, U), mx'), (b_def, rhs')) (type_params, term_params);
 
     (*local definition*)
-    val ((lhs, local_def), lthy3) = lthy2
-      |> Local_Defs.add_def ((b, NoSyn), lhs');
+    val ([(lhs, (_, local_def))], lthy3) = lthy2
+      |> Local_Defs.define [((b, NoSyn), (Thm.empty_binding, lhs'))];
 
     (*result*)
     val def =
--- a/src/Pure/Isar/local_defs.ML	Wed Jun 22 10:09:20 2016 +0200
+++ b/src/Pure/Isar/local_defs.ML	Wed Jun 22 10:40:53 2016 +0200
@@ -10,9 +10,8 @@
   val abs_def: term -> (string * typ) * term
   val expand: cterm list -> thm -> thm
   val def_export: Assumption.export
-  val add_defs: ((binding * mixfix) * (Thm.binding * term)) list -> Proof.context ->
+  val define: ((binding * mixfix) * (Thm.binding * term)) list -> Proof.context ->
     (term * (string * thm)) list * Proof.context
-  val add_def: (binding * mixfix) * term -> Proof.context -> (term * thm) * Proof.context
   val fixed_abbrev: (binding * mixfix) * term -> Proof.context ->
     (term * term) * Proof.context
   val export: Proof.context -> Proof.context -> thm -> (thm list * thm list) * thm
@@ -66,7 +65,9 @@
   let
     val (bs, rhss) = split_list args;
     val Ts = map Term.fastype_of rhss;
-    val (xs, _) = Proof_Context.add_fixes (map2 (fn b => fn T => (b, SOME T, NoSyn)) bs Ts) ctxt;
+    val (xs, _) = ctxt
+      |> Context_Position.set_visible false
+      |> Proof_Context.add_fixes (map2 (fn b => fn T => (b, SOME T, NoSyn)) bs Ts);
     val lhss = ListPair.map Free (xs, Ts);
   in map Logic.mk_equals (lhss ~~ rhss) end;
 
@@ -94,13 +95,13 @@
 fun def_export _ defs = (expand defs, expand_term defs);
 
 
-(* add defs *)
+(* define *)
 
-fun add_defs defs ctxt =
+fun define defs ctxt =
   let
     val ((xs, mxs), specs) = defs |> split_list |>> split_list;
     val (bs, rhss) = specs |> split_list;
-    val eqs = mk_def (Context_Position.set_visible false ctxt) (xs ~~ rhss);
+    val eqs = mk_def ctxt (xs ~~ rhss);
     val lhss = map (fst o Logic.dest_equals) eqs;
   in
     ctxt
@@ -110,10 +111,6 @@
     |>> map2 (fn lhs => fn (name, [th]) => (lhs, (name, th))) lhss
   end;
 
-fun add_def (var, rhs) ctxt =
-  let val ([(lhs, (_, th))], ctxt') = add_defs [(var, (Thm.empty_binding, rhs))] ctxt
-  in ((lhs, th), ctxt') end;
-
 
 (* fixed_abbrev *)
 
--- a/src/Pure/Isar/proof.ML	Wed Jun 22 10:09:20 2016 +0200
+++ b/src/Pure/Isar/proof.ML	Wed Jun 22 10:40:53 2016 +0200
@@ -699,7 +699,7 @@
         let
           val defs = (vars ~~ (name_atts ~~ rhss)) |> map (fn ((x, mx), ((a, atts), rhs)) =>
             ((x, mx), ((Thm.def_binding_optional x a, atts), rhs)));
-        in map_context_result (Local_Defs.add_defs defs) end))
+        in map_context_result (Local_Defs.define defs) end))
     |-> (set_facts o map (#2 o #2))
   end;
 
@@ -868,7 +868,7 @@
     val derived_def = Local_Defs.derived_def ctxt {conditional = false};
     val defs1 = map (derived_def o Logic.close_prop (map #2 fixes) []) (flat propss);
     val defs2 = match_defs decls defs1;
-    val (defs3, defs_ctxt) = Local_Defs.add_defs defs2 ctxt;
+    val (defs3, defs_ctxt) = Local_Defs.define defs2 ctxt;
 
     (*notes*)
     val def_thmss =
--- a/src/Tools/induct.ML	Wed Jun 22 10:09:20 2016 +0200
+++ b/src/Tools/induct.ML	Wed Jun 22 10:40:53 2016 +0200
@@ -725,7 +725,7 @@
     fun add (SOME (_, (t, true))) ctxt = ((SOME t, []), ctxt)
       | add (SOME (SOME x, (t, _))) ctxt =
           let val ([(lhs, (_, th))], ctxt') =
-            Local_Defs.add_defs [((x, NoSyn), ((Thm.def_binding x, []), t))] ctxt
+            Local_Defs.define [((x, NoSyn), ((Thm.def_binding x, []), t))] ctxt
           in ((SOME lhs, [th]), ctxt') end
       | add (SOME (NONE, (t as Free _, _))) ctxt = ((SOME t, []), ctxt)
       | add (SOME (NONE, (t, _))) ctxt =
@@ -733,7 +733,7 @@
             val (s, _) = Name.variant "x" (Variable.names_of ctxt);
             val x = Binding.name s;
             val ([(lhs, (_, th))], ctxt') = ctxt
-              |> Local_Defs.add_defs [((x, NoSyn), ((Thm.def_binding x, []), t))];
+              |> Local_Defs.define [((x, NoSyn), ((Thm.def_binding x, []), t))];
           in ((SOME lhs, [th]), ctxt') end
       | add NONE ctxt = ((NONE, []), ctxt);
   in fold_map add def_insts #> apfst (split_list #> apsnd flat) end;