clarified Local_Defs.add_def(s): refrain from hard-wiring Thm.def_binding_optional;
authorwenzelm
Tue, 09 Oct 2012 20:05:17 +0200
changeset 49748 a346daa8a1f4
parent 49747 2cf86639b77e
child 49749 f27c96e98672
clarified Local_Defs.add_def(s): refrain from hard-wiring Thm.def_binding_optional; clarified Generic_Target.define: avoid duplicate def binding via Local_Defs.add_def;
src/Pure/Isar/local_defs.ML
src/Pure/Isar/proof.ML
src/Tools/induct.ML
--- a/src/Pure/Isar/local_defs.ML	Tue Oct 09 19:24:19 2012 +0200
+++ b/src/Pure/Isar/local_defs.ML	Tue Oct 09 20:05:17 2012 +0200
@@ -89,16 +89,14 @@
 fun add_defs defs ctxt =
   let
     val ((xs, mxs), specs) = defs |> split_list |>> split_list;
-    val ((bfacts, atts), rhss) = specs |> split_list |>> split_list;
-    val names = map2 Thm.def_binding_optional xs bfacts;
+    val (bs, rhss) = specs |> split_list;
     val eqs = mk_def ctxt (xs ~~ rhss);
     val lhss = map (fst o Logic.dest_equals) eqs;
   in
     ctxt
     |> Proof_Context.add_fixes (map2 (fn x => fn mx => (x, NONE, mx)) xs mxs) |> #2
     |> fold Variable.declare_term eqs
-    |> Proof_Context.add_assms_i def_export
-      (map2 (fn a => fn eq => (a, [(eq, [])])) (names ~~ atts) eqs)
+    |> Proof_Context.add_assms_i def_export (map2 (fn b => fn eq => (b, [(eq, [])])) bs eqs)
     |>> map2 (fn lhs => fn (name, [th]) => (lhs, (name, th))) lhss
   end;
 
--- a/src/Pure/Isar/proof.ML	Tue Oct 09 19:24:19 2012 +0200
+++ b/src/Pure/Isar/proof.ML	Tue Oct 09 20:05:17 2012 +0200
@@ -643,7 +643,11 @@
     |>> map (fn (x, _, mx) => (x, mx))
     |-> (fn vars =>
       map_context_result (prep_binds false (map swap raw_rhss))
-      #-> (fn rhss => map_context_result (Local_Defs.add_defs (vars ~~ (name_atts ~~ rhss)))))
+      #-> (fn rhss =>
+        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))
     |-> (set_facts o map (#2 o #2))
   end;
 
--- a/src/Tools/induct.ML	Tue Oct 09 19:24:19 2012 +0200
+++ b/src/Tools/induct.ML	Tue Oct 09 20:05:17 2012 +0200
@@ -705,15 +705,15 @@
     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.empty_binding, t))] ctxt
+            Local_Defs.add_defs [((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 =
           let
             val (s, _) = Name.variant "x" (Variable.names_of ctxt);
-            val ([(lhs, (_, th))], ctxt') =
-              Local_Defs.add_defs [((Binding.name s, NoSyn),
-                (Thm.empty_binding, t))] ctxt
+            val x = Binding.name s;
+            val ([(lhs, (_, th))], ctxt') = ctxt
+              |> Local_Defs.add_defs [((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;