src/Pure/PIDE/protocol_command.ML
author wenzelm
Sat, 11 Dec 2021 11:24:48 +0100
changeset 74913 c2a2be496f35
parent 73225 3ab0cedaccad
child 75577 c51e1cef1eae
permissions -rw-r--r--
tuned;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
73225
3ab0cedaccad clarified modules: allow early definition of protocol commands;
wenzelm
parents:
diff changeset
     1
(*  Title:      Pure/PIDE/protocol_command.ML
3ab0cedaccad clarified modules: allow early definition of protocol commands;
wenzelm
parents:
diff changeset
     2
    Author:     Makarius
3ab0cedaccad clarified modules: allow early definition of protocol commands;
wenzelm
parents:
diff changeset
     3
3ab0cedaccad clarified modules: allow early definition of protocol commands;
wenzelm
parents:
diff changeset
     4
Protocol commands.
3ab0cedaccad clarified modules: allow early definition of protocol commands;
wenzelm
parents:
diff changeset
     5
*)
3ab0cedaccad clarified modules: allow early definition of protocol commands;
wenzelm
parents:
diff changeset
     6
3ab0cedaccad clarified modules: allow early definition of protocol commands;
wenzelm
parents:
diff changeset
     7
signature PROTOCOL_COMMAND =
3ab0cedaccad clarified modules: allow early definition of protocol commands;
wenzelm
parents:
diff changeset
     8
sig
3ab0cedaccad clarified modules: allow early definition of protocol commands;
wenzelm
parents:
diff changeset
     9
  exception STOP of int
3ab0cedaccad clarified modules: allow early definition of protocol commands;
wenzelm
parents:
diff changeset
    10
  val is_protocol_exn: exn -> bool
3ab0cedaccad clarified modules: allow early definition of protocol commands;
wenzelm
parents:
diff changeset
    11
  val define: string -> (string list -> unit) -> unit
3ab0cedaccad clarified modules: allow early definition of protocol commands;
wenzelm
parents:
diff changeset
    12
  val run: string -> string list -> unit
3ab0cedaccad clarified modules: allow early definition of protocol commands;
wenzelm
parents:
diff changeset
    13
end;
3ab0cedaccad clarified modules: allow early definition of protocol commands;
wenzelm
parents:
diff changeset
    14
3ab0cedaccad clarified modules: allow early definition of protocol commands;
wenzelm
parents:
diff changeset
    15
structure Protocol_Command: PROTOCOL_COMMAND =
3ab0cedaccad clarified modules: allow early definition of protocol commands;
wenzelm
parents:
diff changeset
    16
struct
3ab0cedaccad clarified modules: allow early definition of protocol commands;
wenzelm
parents:
diff changeset
    17
3ab0cedaccad clarified modules: allow early definition of protocol commands;
wenzelm
parents:
diff changeset
    18
exception STOP of int;
3ab0cedaccad clarified modules: allow early definition of protocol commands;
wenzelm
parents:
diff changeset
    19
3ab0cedaccad clarified modules: allow early definition of protocol commands;
wenzelm
parents:
diff changeset
    20
val is_protocol_exn = fn STOP _ => true | _ => false;
3ab0cedaccad clarified modules: allow early definition of protocol commands;
wenzelm
parents:
diff changeset
    21
3ab0cedaccad clarified modules: allow early definition of protocol commands;
wenzelm
parents:
diff changeset
    22
local
3ab0cedaccad clarified modules: allow early definition of protocol commands;
wenzelm
parents:
diff changeset
    23
3ab0cedaccad clarified modules: allow early definition of protocol commands;
wenzelm
parents:
diff changeset
    24
val commands =
3ab0cedaccad clarified modules: allow early definition of protocol commands;
wenzelm
parents:
diff changeset
    25
  Synchronized.var "Protocol_Command.commands"
3ab0cedaccad clarified modules: allow early definition of protocol commands;
wenzelm
parents:
diff changeset
    26
    (Symtab.empty: (string list -> unit) Symtab.table);
3ab0cedaccad clarified modules: allow early definition of protocol commands;
wenzelm
parents:
diff changeset
    27
3ab0cedaccad clarified modules: allow early definition of protocol commands;
wenzelm
parents:
diff changeset
    28
in
3ab0cedaccad clarified modules: allow early definition of protocol commands;
wenzelm
parents:
diff changeset
    29
3ab0cedaccad clarified modules: allow early definition of protocol commands;
wenzelm
parents:
diff changeset
    30
fun define name cmd =
3ab0cedaccad clarified modules: allow early definition of protocol commands;
wenzelm
parents:
diff changeset
    31
  Synchronized.change commands (fn cmds =>
3ab0cedaccad clarified modules: allow early definition of protocol commands;
wenzelm
parents:
diff changeset
    32
   (if not (Symtab.defined cmds name) then ()
3ab0cedaccad clarified modules: allow early definition of protocol commands;
wenzelm
parents:
diff changeset
    33
    else warning ("Redefining Isabelle protocol command " ^ quote name);
3ab0cedaccad clarified modules: allow early definition of protocol commands;
wenzelm
parents:
diff changeset
    34
    Symtab.update (name, cmd) cmds));
3ab0cedaccad clarified modules: allow early definition of protocol commands;
wenzelm
parents:
diff changeset
    35
3ab0cedaccad clarified modules: allow early definition of protocol commands;
wenzelm
parents:
diff changeset
    36
fun run name args =
3ab0cedaccad clarified modules: allow early definition of protocol commands;
wenzelm
parents:
diff changeset
    37
  (case Symtab.lookup (Synchronized.value commands) name of
3ab0cedaccad clarified modules: allow early definition of protocol commands;
wenzelm
parents:
diff changeset
    38
    NONE => error ("Undefined Isabelle protocol command " ^ quote name)
3ab0cedaccad clarified modules: allow early definition of protocol commands;
wenzelm
parents:
diff changeset
    39
  | SOME cmd =>
3ab0cedaccad clarified modules: allow early definition of protocol commands;
wenzelm
parents:
diff changeset
    40
      (Runtime.exn_trace_system (fn () => cmd args)
3ab0cedaccad clarified modules: allow early definition of protocol commands;
wenzelm
parents:
diff changeset
    41
        handle exn =>
3ab0cedaccad clarified modules: allow early definition of protocol commands;
wenzelm
parents:
diff changeset
    42
          if is_protocol_exn exn then Exn.reraise exn
3ab0cedaccad clarified modules: allow early definition of protocol commands;
wenzelm
parents:
diff changeset
    43
          else error ("Isabelle protocol command failure: " ^ quote name)));
3ab0cedaccad clarified modules: allow early definition of protocol commands;
wenzelm
parents:
diff changeset
    44
3ab0cedaccad clarified modules: allow early definition of protocol commands;
wenzelm
parents:
diff changeset
    45
end;
3ab0cedaccad clarified modules: allow early definition of protocol commands;
wenzelm
parents:
diff changeset
    46
3ab0cedaccad clarified modules: allow early definition of protocol commands;
wenzelm
parents:
diff changeset
    47
end;