src/Pure/System/message_channel.ML
author wenzelm
Wed, 29 Nov 2023 00:07:54 +0100
changeset 79074 7f24c5be57bd
parent 78753 f40b59292288
permissions -rw-r--r--
compact representation of sets of integers;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
52584
5cad4a5f5615 more abstract message channel;
wenzelm
parents:
diff changeset
     1
(*  Title:      Pure/System/message_channel.ML
5cad4a5f5615 more abstract message channel;
wenzelm
parents:
diff changeset
     2
    Author:     Makarius
5cad4a5f5615 more abstract message channel;
wenzelm
parents:
diff changeset
     3
5cad4a5f5615 more abstract message channel;
wenzelm
parents:
diff changeset
     4
Preferably asynchronous channel for Isabelle messages.
5cad4a5f5615 more abstract message channel;
wenzelm
parents:
diff changeset
     5
*)
5cad4a5f5615 more abstract message channel;
wenzelm
parents:
diff changeset
     6
5cad4a5f5615 more abstract message channel;
wenzelm
parents:
diff changeset
     7
signature MESSAGE_CHANNEL =
5cad4a5f5615 more abstract message channel;
wenzelm
parents:
diff changeset
     8
sig
5cad4a5f5615 more abstract message channel;
wenzelm
parents:
diff changeset
     9
  type T
5cad4a5f5615 more abstract message channel;
wenzelm
parents:
diff changeset
    10
  val shutdown: T -> unit
73578
629868f96c81 misc tuning and clarification;
wenzelm
parents: 73577
diff changeset
    11
  val message: T -> string -> Properties.T -> XML.body list -> unit
69449
b516fdf8005c more uniform multi-language operations;
wenzelm
parents: 62359
diff changeset
    12
  val make: BinIO.outstream -> T
52584
5cad4a5f5615 more abstract message channel;
wenzelm
parents:
diff changeset
    13
end;
5cad4a5f5615 more abstract message channel;
wenzelm
parents:
diff changeset
    14
5cad4a5f5615 more abstract message channel;
wenzelm
parents:
diff changeset
    15
structure Message_Channel: MESSAGE_CHANNEL =
5cad4a5f5615 more abstract message channel;
wenzelm
parents:
diff changeset
    16
struct
5cad4a5f5615 more abstract message channel;
wenzelm
parents:
diff changeset
    17
73578
629868f96c81 misc tuning and clarification;
wenzelm
parents: 73577
diff changeset
    18
datatype message = Shutdown | Message of XML.body list;
629868f96c81 misc tuning and clarification;
wenzelm
parents: 73577
diff changeset
    19
78648
852ec09aef13 more explicit type Isabelle_Thread.T;
wenzelm
parents: 73578
diff changeset
    20
datatype T = Message_Channel of {mbox: message Mailbox.T, thread: Isabelle_Thread.T};
52800
1baa5d19ac44 less aggressive flushing: cope with massive amounts of protocol messages, e.g. from threads_trace;
wenzelm
parents: 52584
diff changeset
    21
73578
629868f96c81 misc tuning and clarification;
wenzelm
parents: 73577
diff changeset
    22
fun shutdown (Message_Channel {mbox, thread}) =
629868f96c81 misc tuning and clarification;
wenzelm
parents: 73577
diff changeset
    23
 (Mailbox.send mbox Shutdown;
629868f96c81 misc tuning and clarification;
wenzelm
parents: 73577
diff changeset
    24
  Mailbox.await_empty mbox;
629868f96c81 misc tuning and clarification;
wenzelm
parents: 73577
diff changeset
    25
  Isabelle_Thread.join thread);
629868f96c81 misc tuning and clarification;
wenzelm
parents: 73577
diff changeset
    26
629868f96c81 misc tuning and clarification;
wenzelm
parents: 73577
diff changeset
    27
fun message (Message_Channel {mbox, ...}) name raw_props chunks =
52800
1baa5d19ac44 less aggressive flushing: cope with massive amounts of protocol messages, e.g. from threads_trace;
wenzelm
parents: 52584
diff changeset
    28
  let
59058
a78612c67ec0 renamed "pairself" to "apply2", in accordance to @{apply 2};
wenzelm
parents: 58857
diff changeset
    29
    val robust_props = map (apply2 YXML.embed_controls) raw_props;
73559
22b5ecb53dd9 more uniform use of Byte_Message;
wenzelm
parents: 73558
diff changeset
    30
    val header = [XML.Elem ((name, robust_props), [])];
73578
629868f96c81 misc tuning and clarification;
wenzelm
parents: 73577
diff changeset
    31
  in Mailbox.send mbox (Message (header :: chunks)) end;
52584
5cad4a5f5615 more abstract message channel;
wenzelm
parents:
diff changeset
    32
69449
b516fdf8005c more uniform multi-language operations;
wenzelm
parents: 62359
diff changeset
    33
fun make stream =
62359
6709e51d5c11 unconditional Multithreading;
wenzelm
parents: 61556
diff changeset
    34
  let
6709e51d5c11 unconditional Multithreading;
wenzelm
parents: 61556
diff changeset
    35
    val mbox = Mailbox.create ();
73578
629868f96c81 misc tuning and clarification;
wenzelm
parents: 73577
diff changeset
    36
    fun loop () = Mailbox.receive NONE mbox |> dispatch
629868f96c81 misc tuning and clarification;
wenzelm
parents: 73577
diff changeset
    37
    and dispatch [] = loop ()
629868f96c81 misc tuning and clarification;
wenzelm
parents: 73577
diff changeset
    38
      | dispatch (Shutdown :: _) = ()
629868f96c81 misc tuning and clarification;
wenzelm
parents: 73577
diff changeset
    39
      | dispatch (Message chunks :: rest) =
629868f96c81 misc tuning and clarification;
wenzelm
parents: 73577
diff changeset
    40
          (Byte_Message.write_message_yxml stream chunks; dispatch rest);
78753
f40b59292288 clarified signature;
wenzelm
parents: 78648
diff changeset
    41
    val thread = Isabelle_Thread.fork (Isabelle_Thread.params "message_channel") loop;
73578
629868f96c81 misc tuning and clarification;
wenzelm
parents: 73577
diff changeset
    42
  in Message_Channel {mbox = mbox, thread = thread} end;
52584
5cad4a5f5615 more abstract message channel;
wenzelm
parents:
diff changeset
    43
5cad4a5f5615 more abstract message channel;
wenzelm
parents:
diff changeset
    44
end;