entity markup for bound variables;
authorwenzelm
Tue, 08 Nov 2011 21:09:35 +0100
changeset 45412 7797f5351ec4
parent 45411 af607f4945f4
child 45413 117ff038f8f7
entity markup for bound variables;
src/Pure/General/name_space.ML
src/Pure/General/position.ML
src/Pure/Syntax/syntax_phases.ML
--- 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) ();