| author | wenzelm |
| Fri, 12 Feb 2021 12:13:24 +0100 | |
| changeset 73243 | 7f55a3e28c88 |
| 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; |