--- a/src/Pure/General/name_space.ML Thu Oct 25 14:04:37 2018 +0200
+++ b/src/Pure/General/name_space.ML Thu Oct 25 15:41:40 2018 +0200
@@ -30,7 +30,7 @@
val extern_shortest: Proof.context -> T -> string -> xstring
val markup_extern: Proof.context -> T -> string -> Markup.T * xstring
val pretty: Proof.context -> T -> string -> Pretty.T
- val completion: Context.generic -> T -> xstring * Position.T -> Completion.T
+ val completion: Context.generic -> T -> (string -> bool) -> xstring * Position.T -> Completion.T
val merge: T * T -> T
type naming
val get_scopes: naming -> Binding.scope list
@@ -257,7 +257,7 @@
(* completion *)
-fun completion context space (xname, pos) =
+fun completion context space pred (xname, pos) =
Completion.make (xname, pos) (fn completed =>
let
fun result_ord ((pri1, (xname1, (_, name1))), (pri2, (xname2, (_, name2)))) =
@@ -276,7 +276,7 @@
fun complete xname' name =
if (completed xname' orelse exists completed (Long_Name.explode xname')) andalso
- not (is_concealed space name)
+ not (is_concealed space name) andalso pred name
then
let
val xname'' = ext name;
@@ -565,7 +565,7 @@
in ((name, reports), x) end
| NONE =>
let
- val completions = map (fn pos => completion context space (xname, pos)) ps;
+ val completions = map (fn pos => completion context space (K true) (xname, pos)) ps;
in
error (undefined space name ^ Position.here_list ps ^
Markup.markup_report (implode (map Completion.reported_text completions)))
--- a/src/Pure/Isar/proof_context.ML Thu Oct 25 14:04:37 2018 +0200
+++ b/src/Pure/Isar/proof_context.ML Thu Oct 25 15:41:40 2018 +0200
@@ -451,7 +451,7 @@
handle TYPE (msg, _, _) =>
error (msg ^ Position.here pos ^
Markup.markup_report (Completion.reported_text
- (Name_Space.completion (Context.Proof ctxt) class_space (xname, pos))));
+ (Name_Space.completion (Context.Proof ctxt) class_space (K true) (xname, pos))));
val reports =
if Context_Position.is_reported ctxt pos
then [(pos, Name_Space.markup class_space name)] else [];
@@ -535,7 +535,7 @@
fun consts_completion_message ctxt (c, ps) =
ps |> map (fn pos =>
- Name_Space.completion (Context.Proof ctxt) (Consts.space_of (consts_of ctxt)) (c, pos)
+ Name_Space.completion (Context.Proof ctxt) (Consts.space_of (consts_of ctxt)) (K true) (c, pos)
|> Completion.reported_text)
|> implode
|> Markup.markup_report;
--- a/src/Pure/Tools/named_theorems.ML Thu Oct 25 14:04:37 2018 +0200
+++ b/src/Pure/Tools/named_theorems.ML Thu Oct 25 15:41:40 2018 +0200
@@ -38,6 +38,8 @@
fun undeclared name = "Undeclared named theorems " ^ quote name;
+val defined_entry = Symtab.defined o Data.get;
+
fun the_entry context name =
(case Symtab.lookup (Data.get context) name of
NONE => error (undeclared name)
@@ -71,10 +73,17 @@
let
val context = Context.Proof ctxt;
val fact_ref = Facts.Named ((xname, Position.none), NONE);
- fun err () = error (undeclared xname ^ Position.here pos);
+ fun err () =
+ let
+ val space = Facts.space_of (Proof_Context.facts_of ctxt);
+ val completion = Name_Space.completion context space (defined_entry context) (xname, pos);
+ in
+ error (undeclared xname ^ Position.here pos ^
+ Markup.markup_report (Completion.reported_text completion))
+ end;
in
(case try (Proof_Context.get_fact_generic context) fact_ref of
- SOME (SOME name, _) => if can (the_entry context) name then name else err ()
+ SOME (SOME name, _) => if defined_entry context name then name else err ()
| _ => err ())
end;