clarified term positions and markup: syntax = true means this is via concrete syntax;
authorwenzelm
Sat, 07 Dec 2024 23:50:18 +0100
changeset 81558 b57996a0688c
parent 81557 8dc9453889ca
child 81559 770a1644c951
clarified term positions and markup: syntax = true means this is via concrete syntax; clarified text color rendering;
src/HOL/ex/Cartouche_Examples.thy
src/Pure/Build/browser_info.scala
src/Pure/General/position.ML
src/Pure/Isar/proof_context.ML
src/Pure/Isar/specification.ML
src/Pure/PIDE/markup.ML
src/Pure/PIDE/markup.scala
src/Pure/PIDE/rendering.scala
src/Pure/Syntax/ast.ML
src/Pure/Syntax/syntax_phases.ML
src/Pure/Syntax/term_position.ML
src/Pure/type_infer_context.ML
src/Tools/VSCode/src/pretty_text_panel.scala
src/Tools/VSCode/src/vscode_rendering.scala
src/Tools/jEdit/src/jedit_rendering.scala
--- a/src/HOL/ex/Cartouche_Examples.thy	Sat Dec 07 23:08:51 2024 +0100
+++ b/src/HOL/ex/Cartouche_Examples.thy	Sat Dec 07 23:50:18 2024 +0100
@@ -71,7 +71,7 @@
         (case args of
           [(c as Const (\<^syntax_const>\<open>_constrain\<close>, _)) $ Free (s, _) $ p] =>
             (case Term_Position.decode_position1 p of
-              SOME pos => c $ mk_string (content (s, pos)) $ p
+              SOME {pos, ...} => c $ mk_string (content (s, pos)) $ p
             | NONE => err ())
         | _ => err ())
       end;
--- a/src/Pure/Build/browser_info.scala	Sat Dec 07 23:08:51 2024 +0100
+++ b/src/Pure/Build/browser_info.scala	Sat Dec 07 23:50:18 2024 +0100
@@ -522,7 +522,7 @@
                 case _ =>
                   body1
               }
-            Rendering.foreground.get(name) orElse Rendering.get_text_color(name) match {
+            Rendering.foreground.get(name) orElse Rendering.get_text_color(markup) match {
               case Some(c) => (html_class(c.toString, html), offset)
               case None => (html_class(name, html), offset)
             }
--- a/src/Pure/General/position.ML	Sat Dec 07 23:08:51 2024 +0100
+++ b/src/Pure/General/position.ML	Sat Dec 07 23:50:18 2024 +0100
@@ -54,8 +54,6 @@
   type report_text = report * string
   val reports_text: report_text list -> unit
   val reports: report list -> unit
-  val store_reports: report_text list Unsynchronized.ref ->
-    T list -> ('a -> Markup.T list) -> 'a -> unit
   val append_reports: report_text list Unsynchronized.ref -> report list -> unit
   val here_strs: T -> string * string
   val here: T -> string
@@ -271,11 +269,6 @@
 
 val reports = map (rpair "") #> reports_text;
 
-fun store_reports _ [] _ _ = ()
-  | store_reports (r: report_text list Unsynchronized.ref) ps markup x =
-      let val ms = markup x
-      in Unsynchronized.change r (fold (fn p => fold (fn m => cons ((p, m), "")) ms) ps) end;
-
 fun append_reports (r: report_text list Unsynchronized.ref) reports =
   Unsynchronized.change r (append (map (rpair "") reports));
 
--- a/src/Pure/Isar/proof_context.ML	Sat Dec 07 23:08:51 2024 +0100
+++ b/src/Pure/Isar/proof_context.ML	Sat Dec 07 23:50:18 2024 +0100
@@ -790,7 +790,7 @@
           Vartab.insert (op =) (xi, Type.minimize_sort tsig S) env
             handle Vartab.DUP _ =>
               error ("Inconsistent sort constraints for type variable " ^
-                quote (Term.string_of_vname' xi) ^ Position.here_list ps)
+                quote (Term.string_of_vname' xi) ^ Position.here_list (map #pos ps))
       end;
 
     val env =
@@ -821,7 +821,7 @@
 
     fun get_sort_reports xi raw_S =
       let
-        val ps = #1 (Term_Position.decode_positionS raw_S);
+        val ps = map #pos (#1 (Term_Position.decode_positionS raw_S));
         val S = get_sort xi raw_S handle ERROR msg => error (msg ^ Position.here_list ps);
       in fold (add_report S) ps end;
 
--- a/src/Pure/Isar/specification.ML	Sat Dec 07 23:08:51 2024 +0100
+++ b/src/Pure/Isar/specification.ML	Sat Dec 07 23:50:18 2024 +0100
@@ -100,7 +100,7 @@
       | get _ (t $ u) = get [] t @ get [] u
       | get _ (Abs (_, _, t)) = get [] t
       | get _ _ = [];
-  in get [] end;
+  in map #pos o get [] end;
 
 local
 
--- a/src/Pure/PIDE/markup.ML	Sat Dec 07 23:08:51 2024 +0100
+++ b/src/Pure/PIDE/markup.ML	Sat Dec 07 23:50:18 2024 +0100
@@ -196,6 +196,8 @@
   val comment1N: string val comment1: T
   val comment2N: string val comment2: T
   val comment3N: string val comment3: T
+  val syntaxN: string val syntax_properties: bool -> T -> T
+  val has_syntax: Properties.T -> bool
   val elapsedN: string
   val cpuN: string
   val gcN: string
@@ -675,6 +677,19 @@
 val (comment3N, comment3) = markup_elem "comment3";
 
 
+(* concrete syntax (notably mixfix notation) *)
+
+val syntaxN = "syntax";
+
+val syntax_elements = [improperN, freeN, skolemN];
+
+fun syntax_properties syntax (m as (elem, props): T) =
+  if syntax andalso member (op =) syntax_elements elem
+  then (elem, Properties.put (syntaxN, "true") props) else m;
+
+fun has_syntax props = Properties.get_bool props syntaxN;
+
+
 (* timing *)
 
 val elapsedN = "elapsed";
--- a/src/Pure/PIDE/markup.scala	Sat Dec 07 23:08:51 2024 +0100
+++ b/src/Pure/PIDE/markup.scala	Sat Dec 07 23:50:18 2024 +0100
@@ -479,6 +479,13 @@
   val COMMENT3 = "comment3"
 
 
+  /* concrete syntax (notably mixfix notation) */
+
+  val Syntax = new Properties.Boolean("syntax")
+
+  def has_syntax(props: Properties.T): Boolean = Syntax.get(props)
+
+
   /* timing */
 
   val Elapsed = new Properties.Double("elapsed")
--- a/src/Pure/PIDE/rendering.scala	Sat Dec 07 23:08:51 2024 +0100
+++ b/src/Pure/PIDE/rendering.scala	Sat Dec 07 23:50:18 2024 +0100
@@ -105,14 +105,20 @@
 
   /* text color */
 
-  def get_text_color(name: String): Option[Color.Value] = text_colors.get(name)
+  def get_text_color(markup: Markup): Option[Color.Value] =
+    if (Markup.has_syntax(markup.properties)) text_color2.get(markup.name)
+    else text_color1.get(markup.name) orElse text_color2.get(markup.name)
 
-  private val text_colors = Map(
+  private val text_color1 = Map(
+    Markup.IMPROPER -> Color.improper,
+    Markup.FREE -> Color.free,
+    Markup.SKOLEM -> Color.skolem)
+
+  private val text_color2 = Map(
     Markup.KEYWORD1 -> Color.keyword1,
     Markup.KEYWORD2 -> Color.keyword2,
     Markup.KEYWORD3 -> Color.keyword3,
     Markup.QUASI_KEYWORD -> Color.quasi_keyword,
-    Markup.IMPROPER -> Color.improper,
     Markup.OPERATOR -> Color.operator,
     Markup.STRING -> Color.main,
     Markup.ALT_STRING -> Color.main,
@@ -121,8 +127,6 @@
     Markup.DELIMITER -> Color.main,
     Markup.TFREE -> Color.tfree,
     Markup.TVAR -> Color.tvar,
-    Markup.FREE -> Color.free,
-    Markup.SKOLEM -> Color.skolem,
     Markup.BOUND -> Color.bound,
     Markup.VAR -> Color.`var`,
     Markup.INNER_STRING -> Color.inner_quoted,
@@ -222,7 +226,7 @@
 
   val foreground_elements = Markup.Elements(foreground.keySet)
 
-  val text_color_elements = Markup.Elements(text_colors.keySet)
+  val text_color_elements = Markup.Elements(text_color1.keySet ++ text_color2.keySet)
 
   val structure_elements =
     Markup.Elements(Markup.NOTATION, Markup.EXPRESSION, Markup.LANGUAGE, Markup.ML_TYPING,
--- a/src/Pure/Syntax/ast.ML	Sat Dec 07 23:08:51 2024 +0100
+++ b/src/Pure/Syntax/ast.ML	Sat Dec 07 23:50:18 2024 +0100
@@ -89,7 +89,7 @@
 fun pretty_var x =
   (case Term_Position.decode x of
     [] => Pretty.str x
-  | ps => Term_Position.pretty ps);
+  | ps => Term_Position.pretty (map #pos ps));
 
 fun pretty_ast (Constant a) = Pretty.quote (Pretty.str a)
   | pretty_ast (Variable x) = pretty_var x
--- a/src/Pure/Syntax/syntax_phases.ML	Sat Dec 07 23:08:51 2024 +0100
+++ b/src/Pure/Syntax/syntax_phases.ML	Sat Dec 07 23:50:18 2024 +0100
@@ -61,8 +61,9 @@
 
 fun markup_var xi = [Markup.name (Term.string_of_vname xi) Markup.var];
 
-fun markup_bound def ps (name, id) =
-  Markup.bound :: map (fn pos => Position.make_entity_markup def id Markup.boundN (name, pos)) ps;
+fun markup_bound def (ps: Term_Position.T list) (name, id) =
+  Markup.bound ::
+    map (fn {pos, ...} => Position.make_entity_markup def id Markup.boundN (name, pos)) ps;
 
 fun markup_entity ctxt c =
   Syntax.get_consts (Proof_Context.syntax_of ctxt) c
@@ -158,7 +159,7 @@
 fun parsetree_to_ast ctxt trf parsetree =
   let
     val reports = Unsynchronized.ref ([]: Position.report_text list);
-    fun report pos = Position.store_reports reports [pos];
+    fun report pos = Term_Position.store_reports reports [pos];
     val append_reports = Position.append_reports reports;
 
     fun report_pos tok =
@@ -168,8 +169,11 @@
     val markup_cache = Symtab.apply_unsynchronized_cache (markup_entity ctxt);
 
     val ast_of_pos = Ast.Variable o Term_Position.encode;
-    val ast_of_position = ast_of_pos o single o report_pos;
-    fun ast_of_position' a = Ast.constrain (Ast.Constant a) o ast_of_position;
+    val ast_of_position = Ast.Variable o Term_Position.encode_no_syntax o single o report_pos;
+
+    val syntax_ast_of_pos = Ast.Variable o Term_Position.encode_syntax;
+    val syntax_ast_of_position = syntax_ast_of_pos o single o report_pos;
+    fun syntax_ast_of_position' a = Ast.constrain (Ast.Constant a) o syntax_ast_of_position;
 
     fun asts_of_token tok =
       if Lexicon.valued_token tok
@@ -201,21 +205,21 @@
             val _ = append_reports rs;
           in [Ast.Constant (Lexicon.mark_type c)] end
       | asts_of (Parser.Node ({const = "_DDDOT", ...}, [Parser.Tip tok])) =
-          [Ast.constrain (Ast.Variable Auto_Bind.dddot_vname) (ast_of_position tok)]
+          [Ast.constrain (Ast.Variable Auto_Bind.dddot_vname) (syntax_ast_of_position tok)]
       | asts_of (Parser.Node ({const = "_position", ...}, [Parser.Tip tok])) =
           asts_of_position "_constrain" tok
       | asts_of (Parser.Node ({const = "_position_sort", ...}, [Parser.Tip tok])) =
           asts_of_position "_ofsort" tok
       | asts_of (Parser.Node ({const = a as "\<^const>Pure.dummy_pattern", ...}, [Parser.Tip tok])) =
-          [ast_of_position' a tok]
+          [syntax_ast_of_position' a tok]
       | asts_of (Parser.Node ({const = a as "_idtdummy", ...}, [Parser.Tip tok])) =
-          [ast_of_position' a tok]
+          [syntax_ast_of_position' a tok]
       | asts_of (Parser.Node ({const = "_idtypdummy", ...}, pts as [Parser.Tip tok, _, _])) =
           let val args = maps asts_of pts
-          in [Ast.Appl (Ast.Constant "_constrain" :: ast_of_position' "_idtdummy" tok :: args)] end
+          in [Ast.Appl (Ast.Constant "_constrain" :: syntax_ast_of_position' "_idtdummy" tok :: args)] end
       | asts_of (Parser.Node ({const = a, ...}, pts)) =
           let
-            val ps = maps parsetree_literals pts;
+            val ps = map Term_Position.syntax (maps parsetree_literals pts);
             val args = maps asts_of pts;
             fun head () =
               if not (null ps) andalso (Lexicon.is_fixed a orelse Lexicon.is_const a)
@@ -272,7 +276,7 @@
       | decode (reports0, Exn.Res tm) =
           let
             val reports = Unsynchronized.ref reports0;
-            fun report ps = Position.store_reports reports ps;
+            fun report ps = Term_Position.store_reports reports ps;
             val append_reports = Position.append_reports reports;
 
             fun decode ps qs bs (Const ("_constrain", _) $ t $ typ) =
@@ -299,13 +303,13 @@
                           let val c = #1 (decode_const ctxt (a, []))
                           in report ps markup_const_cache c; Const (c, T) end))
               | decode ps _ _ (Free (a, T)) =
-                  ((Name.reject_internal (a, ps) handle ERROR msg =>
-                      error (msg ^ Proof_Context.consts_completion_message ctxt (a, ps)));
+                  ((Name.reject_internal (a, map #pos ps) handle ERROR msg =>
+                      error (msg ^ Proof_Context.consts_completion_message ctxt (a, map #pos ps)));
                     (case Proof_Context.lookup_free ctxt a of
                       SOME x => (report ps markup_free_cache x; Free (x, T))
                     | NONE =>
                         let
-                          val (c, rs) = decode_const ctxt (a, ps);
+                          val (c, rs) = decode_const ctxt (a, map #pos ps);
                           val _ = append_reports rs;
                         in Const (c, T) end))
               | decode ps _ _ (Var (xi, T)) = (report ps markup_var xi; Var (xi, T))
@@ -462,7 +466,7 @@
     val syn = Proof_Context.syntax_of ctxt;
 
     val reports = Unsynchronized.ref ([]: Position.report_text list);
-    fun report ps = Position.store_reports reports ps;
+    fun report ps = Term_Position.store_reports reports ps;
 
     val markup_cache = Symtab.apply_unsynchronized_cache (markup_entity ctxt);
 
@@ -765,11 +769,12 @@
     val pretty_free_cache = Symtab.apply_unsynchronized_cache (pretty_free ctxt);
     val pretty_var_cache = Symtab.apply_unsynchronized_cache pretty_var;
 
-    val markup_syntax_cache = Symtab.apply_unsynchronized_cache (markup_entity ctxt);
+    val markup_syntax_cache =
+      Symtab.apply_unsynchronized_cache (markup_entity ctxt #> map (Markup.syntax_properties true));
 
     val pretty_entity_cache =
       Symtab.apply_unsynchronized_cache (fn a =>
-        Pretty.marks_str (markup_syntax_cache a, extern ctxt a));
+        Pretty.marks_str (markup_entity ctxt a, extern ctxt a));
 
     val cache1 = Unsynchronized.ref (Ast.Table.empty: Markup.output Pretty.block Ast.Table.table);
     val cache2 = Unsynchronized.ref (Ast.Table.empty: Markup.output Pretty.block Ast.Table.table);
@@ -872,7 +877,7 @@
   (case asts of
     [Ast.Appl [Ast.Constant "_constrain", Ast.Variable c, T as Ast.Variable p]] =>
       let
-        val (c', _) = decode_const ctxt (c, Term_Position.decode p);
+        val (c', _) = decode_const ctxt (c, map #pos (Term_Position.decode p));
         val d = if intern then Lexicon.mark_const c' else c;
       in Ast.constrain (Ast.Constant d) T end
   | _ => raise Ast.AST ("const_ast_tr", asts));
@@ -995,7 +1000,7 @@
       |> apply_term_check ctxt
       |> chop (length ts);
     val typing_report =
-      fold2 (fn (pos, _) => fn ty =>
+      fold2 (fn ({pos, ...}, _) => fn ty =>
         if Position.is_reported pos then
           cons (Position.reported_text pos Markup.typing
             (Syntax.string_of_typ ctxt (Logic.dest_type ty)))
--- a/src/Pure/Syntax/term_position.ML	Sat Dec 07 23:08:51 2024 +0100
+++ b/src/Pure/Syntax/term_position.ML	Sat Dec 07 23:50:18 2024 +0100
@@ -6,16 +6,23 @@
 
 signature TERM_POSITION =
 sig
+  type T = {syntax: bool, pos: Position.T}
+  val syntax: Position.T -> T
+  val no_syntax: Position.T -> T
+  val store_reports: Position.report_text list Unsynchronized.ref ->
+    T list -> ('a -> Markup.T list) -> 'a -> unit
   val pretty: Position.T list -> Pretty.T
-  val encode: Position.T list -> string
+  val encode: T list -> string
+  val encode_syntax: Position.T list -> string
+  val encode_no_syntax: Position.T list -> string
   val detect: string -> bool
-  val decode: string -> Position.T list
+  val decode: string -> T list
   val detect_position: term -> bool
-  val decode_position: term -> (Position.T list * typ) option
-  val decode_position1: term -> Position.T option
+  val decode_position: term -> (T list * typ) option
+  val decode_position1: term -> T option
   val detect_positionT: typ -> bool
-  val decode_positionT: typ -> Position.T list
-  val decode_positionS: sort -> Position.T list * sort
+  val decode_positionT: typ -> T list
+  val decode_positionS: sort -> T list * sort
   val markers: string list
   val strip_positions: term -> term
 end;
@@ -23,6 +30,22 @@
 structure Term_Position: TERM_POSITION =
 struct
 
+(* type T *)
+
+type T = {syntax: bool, pos: Position.T};
+
+fun syntax pos : T = {syntax = true, pos = pos};
+fun no_syntax pos : T = {syntax = false, pos = pos};
+
+fun store_reports _ [] _ _ = ()
+  | store_reports (r: Position.report_text list Unsynchronized.ref) ps markup x =
+      let
+        val ms = markup x;
+        fun store {syntax, pos} =
+          fold (fn m => cons ((pos, Markup.syntax_properties syntax m), "")) ms;
+      in Unsynchronized.change r (fold store ps) end;
+
+
 (* markup *)
 
 val position_dummy = "<position>";
@@ -30,24 +53,28 @@
 
 fun pretty ps = Pretty.marks_str (map Position.markup ps, position_dummy);
 
-fun encode_pos pos = XML.Elem (Position.markup pos, [position_text]);
+fun encode_pos {syntax, pos} =
+  XML.Elem (Position.markup pos |> Markup.syntax_properties syntax, [position_text]);
 
 fun decode_pos (XML.Elem ((name, props), [arg])) =
       if name = Markup.positionN andalso arg = position_text
-      then SOME (Position.of_properties props)
+      then SOME {syntax = Markup.has_syntax props, pos = Position.of_properties props}
       else NONE
   | decode_pos _ = NONE;
 
 
 (* encode *)
 
-val encode_none = YXML.string_of (encode_pos Position.none);
+val encode_none = YXML.string_of (encode_pos (no_syntax Position.none));
 
 fun encode ps =
-  (case filter Position.is_reported ps of
+  (case filter (Position.is_reported o #pos) ps of
     [] => encode_none
   | ps' => YXML.string_of_body (map encode_pos ps'));
 
+val encode_syntax = encode o map syntax;
+val encode_no_syntax = encode o map no_syntax;
+
 val encode_prefix = YXML.XY ^ Markup.positionN;
 
 
@@ -56,7 +83,7 @@
 val detect = String.isPrefix encode_prefix;
 
 fun decode str =
-  if str = encode_none then [Position.none]
+  if str = encode_none then [no_syntax Position.none]
   else if detect str then
     let
       val xml = YXML.parse_body str handle Fail msg => error msg;
--- a/src/Pure/type_infer_context.ML	Sat Dec 07 23:08:51 2024 +0100
+++ b/src/Pure/type_infer_context.ML	Sat Dec 07 23:50:18 2024 +0100
@@ -8,7 +8,7 @@
 sig
   val const_sorts: bool Config.T
   val const_type: Proof.context -> string -> typ option
-  val prepare_positions: Proof.context -> term list -> term list * (Position.T * typ) list
+  val prepare_positions: Proof.context -> term list -> term list * (Term_Position.T * typ) list
   val prepare: Proof.context -> term list -> int * term list
   val infer_types: Proof.context -> term list -> term list
   val infer_types_finished: Proof.context -> term list -> term list
--- a/src/Tools/VSCode/src/pretty_text_panel.scala	Sat Dec 07 23:08:51 2024 +0100
+++ b/src/Tools/VSCode/src/pretty_text_panel.scala	Sat Dec 07 23:50:18 2024 +0100
@@ -75,13 +75,13 @@
 
       val document = Line.Document(text)
       val decorations =
-        tree.cumulate[Option[String]](Text.Range.full, None, Rendering.text_color_elements,
-          { case (_, m) => Some(Some(m.info.name)) }
+        tree.cumulate[Option[Markup]](Text.Range.full, None, Rendering.text_color_elements,
+          { case (_, m) => Some(Some(m.info.markup)) }
         ).flatMap(info =>
             info.info match {
-              case Some(name) =>
+              case Some(markup) =>
                 val range = document.range(info.range)
-                Some((range, "text_" + Rendering.get_text_color(name).get.toString))
+                Some((range, "text_" + Rendering.get_text_color(markup).get.toString))
               case None => None
             }
         ).groupMap(_._2)(e => LSP.Decoration_Options(e._1, Nil)).toList
--- a/src/Tools/VSCode/src/vscode_rendering.scala	Sat Dec 07 23:08:51 2024 +0100
+++ b/src/Tools/VSCode/src/vscode_rendering.scala	Sat Dec 07 23:50:18 2024 +0100
@@ -167,7 +167,7 @@
   def text_color(range: Text.Range): List[Text.Info[Rendering.Color.Value]] = {
     snapshot.select(range, Rendering.text_color_elements, _ =>
       {
-        case Text.Info(_, elem) => Rendering.get_text_color(elem.name)
+        case Text.Info(_, elem) => Rendering.get_text_color(elem.markup)
       })
   }
 
--- a/src/Tools/jEdit/src/jedit_rendering.scala	Sat Dec 07 23:08:51 2024 +0100
+++ b/src/Tools/jEdit/src/jedit_rendering.scala	Sat Dec 07 23:50:18 2024 +0100
@@ -375,7 +375,7 @@
     else
       snapshot.cumulate(range, current_color, Rendering.text_color_elements, _ =>
         {
-          case (_, Text.Info(_, elem)) => Rendering.get_text_color(elem.name).map(color)
+          case (_, Text.Info(_, elem)) => Rendering.get_text_color(elem.markup).map(color)
         })
   }