src/Pure/Tools/isabelle_process.ML
changeset 25841 af7566faaa0f
parent 25820 8228b198c49e
child 25842 fdabeed7ccd9
equal deleted inserted replaced
25840:8a84f00f7139 25841:af7566faaa0f
     7 General format of process output:
     7 General format of process output:
     8 
     8 
     9   (a) unmarked stdout/stderr, no line structure (output should be
     9   (a) unmarked stdout/stderr, no line structure (output should be
    10   processed immediately as it arrives)
    10   processed immediately as it arrives)
    11 
    11 
    12   (b) echo of my pid on stdout, appears *relatively* early after
    12   (b) properly marked-up messages, e.g. for writeln channel
    13   startup on a separate line, e.g. "\nPID=4711\n"
       
    14 
       
    15   (c) properly marked-up messages, e.g. for writeln channel
       
    16 
    13 
    17   "\002A" ^ props ^ "\002,\n" ^ text ^ "\002.\n"
    14   "\002A" ^ props ^ "\002,\n" ^ text ^ "\002.\n"
    18 
    15 
    19   where the props consist of name=value lines terminated by "\002,"
    16   where the props consist of name=value lines terminated by "\002,\n"
    20   each, and the remaining text is any number of lines (output is
    17   each, and the remaining text is any number of lines (output is
    21   supposed to be processed in one piece).
    18   supposed to be processed in one piece).
       
    19 
       
    20   (c) Special init message holds "pid" and "session" property.
    22 *)
    21 *)
    23 
    22 
    24 signature ISABELLE_PROCESS =
    23 signature ISABELLE_PROCESS =
    25 sig
    24 sig
    26   val test_markupN: string
    25   val test_markupN: string
    41   enclose "</" ">" name);
    40   enclose "</" ">" name);
    42 
    41 
    43 val _ = Markup.add_mode test_markupN test_markup;
    42 val _ = Markup.add_mode test_markupN test_markup;
    44 
    43 
    45 
    44 
    46 (* channels *)
    45 (* symbol output *)
    47 
    46 
    48 val isabelle_processN = "isabelle_process";
    47 val isabelle_processN = "isabelle_process";
    49 
    48 
    50 local
    49 local
    51 
    50 
    52 fun special c = chr 2 ^ c;
    51 fun output str =
       
    52   let
       
    53     fun out s = if Symbol.is_raw s then Symbol.decode_raw s else XML.text s;
       
    54     val syms = Symbol.explode str;
       
    55   in (implode (map out syms), Symbol.length syms) end;
       
    56 
       
    57 in
       
    58 
       
    59 val _ = Output.add_mode isabelle_processN output Symbol.encode_raw;
       
    60 
       
    61 end;
       
    62 
       
    63 
       
    64 (* message markup *)
       
    65 
       
    66 val STX = chr 2;
       
    67 val DEL = chr 127;
       
    68 
       
    69 fun special ch = STX ^ ch;
    53 val special_sep = special ",";
    70 val special_sep = special ",";
    54 val special_end = special ".";
    71 val special_end = special ".";
    55 
    72 
    56 fun position_props () =
    73 local
    57   let val props = Position.properties_of (Position.thread_data ())
       
    58   in implode (map (fn (x, y) => x ^ "=" ^ y ^ special_sep ^ "\n") props) end;
       
    59 
    74 
    60 fun output ch markup txt =
    75 fun print_props props =
    61   Output.writeln_default (special ch ^ position_props () ^ Markup.enclose markup txt ^ special_end);
    76   let
       
    77     val clean = translate_string (fn c =>
       
    78       if c = STX orelse c = "\n" orelse c = "\r" then DEL else c);
       
    79   in implode (map (fn (x, y) => clean x ^ "=" ^ clean y ^ special_sep ^ "\n") props) end;
       
    80 
       
    81 fun get_pos (elem as XML.Elem (name, atts, ts)) =
       
    82       if name = Markup.positionN then SOME (Position.of_properties atts)
       
    83       else get_first get_pos ts
       
    84   | get_pos _ = NONE;
    62 
    85 
    63 in
    86 in
    64 
    87 
    65 fun setup_channels () =
    88 fun message ch markup raw_txt =
    66  (Output.writeln_fn  := output "A" Markup.writeln;
    89   let
    67   Output.priority_fn := output "B" Markup.priority;
    90     val (txt, pos) =
    68   Output.tracing_fn  := output "C" Markup.tracing;
    91       (case try XML.tree_of_string (XML.element "message" [] [raw_txt]) of
    69   Output.warning_fn  := output "D" Markup.warning;
    92         NONE => (raw_txt, Position.none)
    70   Output.error_fn    := output "E" Markup.error;
    93       | SOME xml => (XML.plain_content xml, the_default Position.none (get_pos xml)))
    71   Output.debug_fn    := output "F" Markup.debug);
    94       |>> translate_string (fn c => if c = STX then DEL else c);
       
    95     val props =
       
    96       (case Position.properties_of (Position.thread_data ()) of
       
    97         [] => Position.properties_of pos
       
    98       | props => props);
       
    99     val s = special ch ^ print_props props ^ Markup.enclose markup txt ^ special_end;
       
   100   in Output.writeln_default s end;
    72 
   101 
    73 val _ = Markup.add_mode isabelle_processN (fn (name, _) =>
   102 fun init_message () =
    74   if name = Markup.promptN then (special "G", special_end ^ "\n")
   103   let
    75   else ("", ""));
   104     val pid = string_of_pid (Posix.ProcEnv.getpid ());
       
   105     val session = List.last (Session.id ()) handle List.Empty => "unknown";
       
   106     val welcome = Session.welcome ();
       
   107     val s = special "H" ^ print_props [("pid", pid), ("session", session)] ^ welcome ^ special_end;
       
   108   in Output.writeln_default s end;
    76 
   109 
    77 end;
   110 end;
       
   111 
       
   112 
       
   113 (* channels *)
       
   114 
       
   115 fun setup_channels () =
       
   116  (Output.writeln_fn  := message "A" Markup.writeln;
       
   117   Output.priority_fn := message "B" Markup.priority;
       
   118   Output.tracing_fn  := message "C" Markup.tracing;
       
   119   Output.warning_fn  := message "D" Markup.warning;
       
   120   Output.error_fn    := message "E" Markup.error;
       
   121   Output.debug_fn    := message "F" Markup.debug);
       
   122 
       
   123 val _ = Markup.add_mode isabelle_processN (fn (name, props) =>
       
   124   if name = Markup.promptN then (special "G", special_end ^ "\n")
       
   125   else if name = Markup.positionN then test_markup (name, props)
       
   126   else ("", ""));
    78 
   127 
    79 
   128 
    80 (* init *)
   129 (* init *)
    81 
   130 
    82 fun init () =
   131 fun init () =
    83  (Output.writeln_default ("\nPID=" ^ string_of_pid (Posix.ProcEnv.getpid ()));
   132  (change print_mode (update (op =) isabelle_processN);
    84   setup_channels ();
   133   setup_channels ();
    85   change print_mode (update (op =) isabelle_processN);
   134   init_message ();
    86   Isar.secure_main ());
   135   Isar.secure_main ());
    87 
   136 
    88 end;
   137 end;
    89 
   138