author | wenzelm |
Sat, 11 Dec 2021 11:24:48 +0100 | |
changeset 74913 | c2a2be496f35 |
parent 73225 | 3ab0cedaccad |
child 75577 | c51e1cef1eae |
permissions | -rw-r--r-- |
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; |