--- a/src/Pure/General/name_space.ML Tue Nov 08 17:47:22 2011 +0100
+++ b/src/Pure/General/name_space.ML Tue Nov 08 21:09:35 2011 +0100
@@ -83,11 +83,7 @@
id: serial};
fun entry_markup def kind (name, {pos, id, ...}: entry) =
- let
- val props =
- if def then (Markup.defN, string_of_int id) :: Position.properties_of pos
- else (Markup.refN, string_of_int id) :: Position.def_properties_of pos;
- in Markup.properties props (Markup.entity kind name) end;
+ Markup.properties (Position.entity_properties_of def id pos) (Markup.entity kind name);
fun print_entry def kind (name, entry) =
quote (Markup.markup (entry_markup def kind (name, entry)) name);
--- a/src/Pure/General/position.ML Tue Nov 08 17:47:22 2011 +0100
+++ b/src/Pure/General/position.ML Tue Nov 08 21:09:35 2011 +0100
@@ -29,6 +29,7 @@
val of_properties: Properties.T -> T
val properties_of: T -> Properties.T
val def_properties_of: T -> Properties.T
+ val entity_properties_of: bool -> serial -> T -> Properties.T
val default_properties: T -> Properties.T -> Properties.T
val markup: T -> Markup.T -> Markup.T
val is_reported: T -> bool
@@ -140,6 +141,10 @@
val def_properties_of = properties_of #> (map (fn (x, y) => ("def_" ^ x, y)));
+fun entity_properties_of def id pos =
+ if def then (Markup.defN, string_of_int id) :: properties_of pos
+ else (Markup.refN, string_of_int id) :: def_properties_of pos;
+
fun default_properties default props =
if exists (member (op =) Markup.position_properties o #1) props then props
else properties_of default @ props;
--- a/src/Pure/Syntax/syntax_phases.ML Tue Nov 08 17:47:22 2011 +0100
+++ b/src/Pure/Syntax/syntax_phases.ML Tue Nov 08 21:09:35 2011 +0100
@@ -37,8 +37,11 @@
fun markup_var xi = [Markup.name (Term.string_of_vname xi) Markup.var];
-fun markup_bound def id =
- [Markup.properties [(if def then Markup.defN else Markup.refN, id)] Markup.bound];
+fun markup_bound def ps (name, id) =
+ let val entity = Markup.entity "bound variable" name in
+ Markup.bound ::
+ map (fn pos => Markup.properties (Position.entity_properties_of def id pos) entity) ps
+ end;
fun markup_entity ctxt c =
(case Syntax.lookup_const (Proof_Context.syn_of ctxt) c of
@@ -219,9 +222,9 @@
| NONE => Type.constraint (decodeT typ --> dummyT) (decode ps qs bs t))
| decode _ qs bs (Abs (x, T, t)) =
let
- val id = serial_string ();
- val _ = report qs (markup_bound true) id;
- in Abs (x, T, decode [] [] (id :: bs) t) end
+ val id = serial ();
+ val _ = report qs (markup_bound true qs) (x, id);
+ in Abs (x, T, decode [] [] ((qs, (x, id)) :: bs) t) end
| decode _ _ bs (t $ u) = decode [] [] bs t $ decode [] [] bs u
| decode ps _ _ (Const (a, T)) =
(case try Lexicon.unmark_fixed a of
@@ -245,7 +248,7 @@
| decode ps _ _ (Var (xi, T)) = (report ps markup_var xi; Var (xi, T))
| decode ps _ bs (t as Bound i) =
(case try (nth bs) i of
- SOME id => (report ps (markup_bound false) id; t)
+ SOME (qs, (x, id)) => (report ps (markup_bound false qs) (x, id); t)
| NONE => t);
val tm' = Exn.interruptible_capture (fn () => decode [] [] [] tm) ();