tuned protocol -- resolve command positions in ML;
authorwenzelm
Mon, 16 Mar 2015 11:30:54 +0100
changeset 59714 ae322325adbb
parent 59713 6da3efec20ca
child 59715 4f0d0e4ad68d
tuned protocol -- resolve command positions in ML;
src/Pure/PIDE/protocol.ML
src/Pure/PIDE/protocol.scala
src/Pure/PIDE/protocol_message.ML
src/Pure/ROOT
src/Pure/ROOT.ML
--- a/src/Pure/PIDE/protocol.ML	Mon Mar 16 11:07:56 2015 +0100
+++ b/src/Pure/PIDE/protocol.ML	Mon Mar 16 11:30:54 2015 +0100
@@ -32,11 +32,15 @@
       let
         val (blobs, blobs_index) =
           YXML.parse_body blobs_yxml |>
-            let open XML.Decode in
+            let
+              val message =
+                YXML.string_of_body o Protocol_Message.command_positions id;
+              open XML.Decode;
+            in
               pair
                 (list (variant
                  [fn ([], a) => Exn.Res (pair string (option string) a),
-                  fn ([], a) => Exn.Exn (ERROR (YXML.string_of_body a))]))
+                  fn ([], a) => Exn.Exn (ERROR (message a))]))
                 int
             end;
         val toks =
--- a/src/Pure/PIDE/protocol.scala	Mon Mar 16 11:07:56 2015 +0100
+++ b/src/Pure/PIDE/protocol.scala	Mon Mar 16 11:30:54 2015 +0100
@@ -307,29 +307,6 @@
   def define_blob(digest: SHA1.Digest, bytes: Bytes): Unit =
     protocol_command_bytes("Document.define_blob", Bytes(digest.toString), bytes)
 
-  private def resolve_id(id: String, body: XML.Body): XML.Body =
-  {
-    def resolve_property(p: (String, String)): (String, String) =
-      if (p._1 == Markup.ID && p._2 == Markup.COMMAND) (Markup.ID, id) else p
-
-    def resolve_markup(markup: Markup): Markup =
-      Markup(markup.name, markup.properties.map(resolve_property))
-
-    def resolve_tree(t: XML.Tree): XML.Tree =
-      t match {
-        case XML.Wrapped_Elem(markup, ts1, ts2) =>
-          XML.Wrapped_Elem(resolve_markup(markup), ts1.map(resolve_tree _), ts2.map(resolve_tree _))
-        case XML.Elem(markup, ts) =>
-          XML.Elem(resolve_markup(markup), ts.map(resolve_tree _))
-        case text => text
-      }
-    body.map(resolve_tree _)
-  }
-
-  private def resolve_id(id: String, s: String): XML.Body =
-    try { resolve_id(id, YXML.parse_body(s)) }
-    catch { case ERROR(_) => XML.Encode.string(s) }
-
   def define_command(command: Command)
   {
     val blobs_yxml =
@@ -338,7 +315,7 @@
         variant(List(
           { case Exn.Res((a, b)) =>
               (Nil, pair(string, option(string))((a.node, b.map(p => p._1.toString)))) },
-          { case Exn.Exn(e) => (Nil, resolve_id(command.id.toString, Exn.message(e))) }))
+          { case Exn.Exn(e) => (Nil, string(Exn.message(e))) }))
 
       YXML.string_of_body(pair(list(encode_blob), int)(command.blobs, command.blobs_index))
     }
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/Pure/PIDE/protocol_message.ML	Mon Mar 16 11:30:54 2015 +0100
@@ -0,0 +1,27 @@
+(*  Title:      Pure/PIDE/protocol_message.ML
+    Author:     Makarius
+
+Auxiliary operations on protocol messages.
+*)
+
+signature PROTOCOL_MESSAGE =
+sig
+  val command_positions: string -> XML.body -> XML.body
+  val command_positions_yxml: string -> string -> string
+end;
+
+structure Protocol_Message: PROTOCOL_MESSAGE =
+struct
+
+fun command_positions id =
+  let
+    fun attribute (a, b) =
+      if a = Markup.idN andalso b = Markup.commandN then (a, id) else (a, b);
+    fun tree (XML.Elem ((a, atts), ts)) = XML.Elem ((a, map attribute atts), map tree ts)
+      | tree text = text;
+  in map tree end;
+
+fun command_positions_yxml id =
+  YXML.string_of_body o command_positions id o YXML.parse_body;
+
+end;
--- a/src/Pure/ROOT	Mon Mar 16 11:07:56 2015 +0100
+++ b/src/Pure/ROOT	Mon Mar 16 11:30:54 2015 +0100
@@ -172,6 +172,7 @@
     "PIDE/execution.ML"
     "PIDE/markup.ML"
     "PIDE/protocol.ML"
+    "PIDE/protocol_message.ML"
     "PIDE/query_operation.ML"
     "PIDE/resources.ML"
     "PIDE/session.ML"
--- a/src/Pure/ROOT.ML	Mon Mar 16 11:07:56 2015 +0100
+++ b/src/Pure/ROOT.ML	Mon Mar 16 11:30:54 2015 +0100
@@ -310,6 +310,7 @@
 use "PIDE/resources.ML";
 use "Thy/thy_info.ML";
 use "PIDE/session.ML";
+use "PIDE/protocol_message.ML";
 use "PIDE/document.ML";
 
 (*theory and proof operations*)