literal facts `prop` may contain dummy patterns;
authorwenzelm
Thu, 28 Apr 2011 21:06:04 +0200
changeset 42502 13b41fb77649
parent 42501 2b8c34f53388
child 42503 27514b6fbe93
literal facts `prop` may contain dummy patterns;
NEWS
src/Pure/Isar/proof_context.ML
--- a/NEWS	Thu Apr 28 20:20:49 2011 +0200
+++ b/NEWS	Thu Apr 28 21:06:04 2011 +0200
@@ -44,6 +44,10 @@
 
   declare [[unique_names = false]]
 
+* Literal facts `prop` may contain dummy patterns, e.g. `_ = _`.  Note
+that the result needs to be unique, which means fact specifications
+may have to be refined after enriching a proof context.
+
 
 *** HOL ***
 
--- a/src/Pure/Isar/proof_context.ML	Thu Apr 28 20:20:49 2011 +0200
+++ b/src/Pure/Isar/proof_context.ML	Thu Apr 28 21:06:04 2011 +0200
@@ -841,16 +841,20 @@
 fun retrieve_thms pick ctxt (Facts.Fact s) =
       let
         val (_, pos) = Syntax.read_token s;
-        val prop = Syntax.read_prop (set_mode mode_default ctxt) s
+        val prop =
+          Syntax.read_prop (ctxt |> set_mode mode_default |> allow_dummies) s
           |> singleton (Variable.polymorphic ctxt);
+        fun err msg = error (msg ^ Position.str_of pos ^ ":\n" ^ Syntax.string_of_term ctxt prop);
 
+        val (prop', _) = Term.replace_dummy_patterns prop (Variable.maxidx_of ctxt + 1);
         fun prove_fact th =
-          Goal.prove ctxt [] [] prop (K (ALLGOALS (fact_tac [th])));
+          Goal.prove ctxt [] [] prop' (K (ALLGOALS (fact_tac [th])));
+        val results = map_filter (try prove_fact) (potential_facts ctxt prop');
         val res =
-          (case get_first (try prove_fact) (potential_facts ctxt prop) of
-            SOME res => res
-          | NONE => error ("Failed to retrieve literal fact" ^ Position.str_of pos ^ ":\n" ^
-              Syntax.string_of_term ctxt prop))
+          (case distinct Thm.eq_thm_prop results of
+            [res] => res
+          | [] => err "Failed to retrieve literal fact"
+          | _ => err "Ambiguous specification of literal fact");
       in pick "" [res] end
   | retrieve_thms pick ctxt xthmref =
       let