|
1 (* Title: Pure/Isar/isar.ML |
|
2 ID: $Id$ |
|
3 Author: Makarius |
|
4 |
|
5 The global Isabelle/Isar state and main read-eval-print loop. |
|
6 *) |
|
7 |
|
8 signature ISAR = |
|
9 sig |
|
10 val state: unit -> Toplevel.state |
|
11 val exn: unit -> (exn * string) option |
|
12 val context: unit -> Proof.context |
|
13 val goal: unit -> thm |
|
14 val >> : Toplevel.transition -> bool |
|
15 val >>> : Toplevel.transition list -> unit |
|
16 val init: unit -> unit |
|
17 val crashes: exn list ref |
|
18 val main: unit -> unit |
|
19 val loop: unit -> unit |
|
20 val sync_main: unit -> unit |
|
21 val sync_loop: unit -> unit |
|
22 val secure_main: unit -> unit |
|
23 end; |
|
24 |
|
25 structure Isar: ISAR = |
|
26 struct |
|
27 |
|
28 (* the global state *) |
|
29 |
|
30 val global_state = ref (Toplevel.toplevel, NONE: (exn * string) option); |
|
31 |
|
32 fun state () = #1 (! global_state); |
|
33 fun exn () = #2 (! global_state); |
|
34 |
|
35 fun context () = |
|
36 Toplevel.context_of (state ()) |
|
37 handle Toplevel.UNDEF => error "Unknown context"; |
|
38 |
|
39 fun goal () = |
|
40 #2 (#2 (Proof.get_goal (Toplevel.proof_of (state ())))) |
|
41 handle Toplevel.UNDEF => error "No goal present"; |
|
42 |
|
43 |
|
44 (* interactive state transformations --- NOT THREAD-SAFE! *) |
|
45 |
|
46 nonfix >> >>>; |
|
47 |
|
48 fun >> tr = |
|
49 (case Toplevel.transition true tr (state ()) of |
|
50 NONE => false |
|
51 | SOME (state', exn_info) => |
|
52 (global_state := (state', exn_info); |
|
53 (case exn_info of |
|
54 NONE => () |
|
55 | SOME err => Toplevel.error_msg tr err); |
|
56 true)); |
|
57 |
|
58 fun >>> [] = () |
|
59 | >>> (tr :: trs) = if >> tr then >>> trs else (); |
|
60 |
|
61 fun init () = (>> (Toplevel.init_empty (K true) (K ()) Toplevel.empty); ()); |
|
62 |
|
63 |
|
64 (* main loop *) |
|
65 |
|
66 val crashes = ref ([]: exn list); |
|
67 |
|
68 local |
|
69 |
|
70 (*Spurious interrupts ahead! Race condition?*) |
|
71 fun get_interrupt src = SOME (Source.get_single src) handle Interrupt => NONE; |
|
72 |
|
73 fun raw_loop secure src = |
|
74 let |
|
75 fun check_secure () = |
|
76 (if secure then warning "Secure loop -- cannot exit to ML" else (); secure); |
|
77 in |
|
78 (case get_interrupt (Source.set_prompt Source.default_prompt src) of |
|
79 NONE => (writeln "\nInterrupt."; raw_loop secure src) |
|
80 | SOME NONE => if secure then quit () else () |
|
81 | SOME (SOME (tr, src')) => if >> tr orelse check_secure () then raw_loop secure src' else ()) |
|
82 handle exn => (Output.error_msg (Toplevel.exn_message exn) handle crash => |
|
83 (CRITICAL (fn () => change crashes (cons crash)); |
|
84 warning "Recovering after Isar toplevel crash -- see also Isar.crashes"); |
|
85 raw_loop secure src) |
|
86 end; |
|
87 |
|
88 in |
|
89 |
|
90 fun gen_loop secure do_terminate = |
|
91 (Context.set_thread_data NONE; |
|
92 uninterruptible (fn _ => fn () => raw_loop secure (OuterSyntax.isar do_terminate)) ()); |
|
93 |
|
94 fun gen_main secure do_terminate = |
|
95 (init (); |
|
96 writeln (Session.welcome ()); |
|
97 gen_loop secure do_terminate); |
|
98 |
|
99 end; |
|
100 |
|
101 fun main () = gen_main (Secure.is_secure ()) false; |
|
102 fun loop () = gen_loop (Secure.is_secure ()) false; |
|
103 fun sync_main () = gen_main (Secure.is_secure ()) true; |
|
104 fun sync_loop () = gen_loop (Secure.is_secure ()) true; |
|
105 fun secure_main () = (init (); gen_loop true true); |
|
106 |
|
107 end; |
|
108 |