src/Pure/Syntax/term_position.ML
changeset 81558 b57996a0688c
parent 81251 89ea66c2045b
--- 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;