14 type exec = eval * print list |
14 type exec = eval * print list |
15 val no_exec: exec |
15 val no_exec: exec |
16 val exec_ids: exec option -> Document_ID.exec list |
16 val exec_ids: exec option -> Document_ID.exec list |
17 val read: (unit -> theory) -> Token.T list -> Toplevel.transition |
17 val read: (unit -> theory) -> Token.T list -> Toplevel.transition |
18 val eval: (unit -> theory) -> Token.T list -> eval -> eval |
18 val eval: (unit -> theory) -> Token.T list -> eval -> eval |
19 val print: string -> eval -> print list |
19 val print: bool -> string -> eval -> print list -> print list option |
20 type print_fn = Toplevel.transition -> Toplevel.state -> unit |
20 type print_fn = Toplevel.transition -> Toplevel.state -> unit |
21 val print_function: {name: string, pri: int} -> (string -> print_fn option) -> unit |
21 val print_function: {name: string, pri: int} -> (string -> print_fn option) -> unit |
22 val execute: exec -> unit |
22 val execute: exec -> unit |
23 val stable_eval: eval -> bool |
23 val stable_eval: eval -> bool |
24 val stable_print: print -> bool |
24 val stable_print: print -> bool |
90 type exec = eval * print list; |
90 type exec = eval * print list; |
91 val no_exec: exec = ({exec_id = Document_ID.none, eval_process = memo_value init_eval_state}, []); |
91 val no_exec: exec = ({exec_id = Document_ID.none, eval_process = memo_value init_eval_state}, []); |
92 |
92 |
93 fun exec_ids (NONE: exec option) = [] |
93 fun exec_ids (NONE: exec option) = [] |
94 | exec_ids (SOME ({exec_id, ...}, prints)) = exec_id :: map #exec_id prints; |
94 | exec_ids (SOME ({exec_id, ...}, prints)) = exec_id :: map #exec_id prints; |
|
95 |
|
96 |
|
97 (* stable results *) |
|
98 |
|
99 fun stable_goals exec_id = |
|
100 not (Par_Exn.is_interrupted (Future.join_results (Goal.peek_futures exec_id))); |
|
101 |
|
102 fun stable_eval ({exec_id, eval_process}: eval) = |
|
103 stable_goals exec_id andalso memo_stable eval_process; |
|
104 |
|
105 fun stable_print ({exec_id, print_process, ...}: print) = |
|
106 stable_goals exec_id andalso memo_stable print_process; |
95 |
107 |
96 |
108 |
97 (* read *) |
109 (* read *) |
98 |
110 |
99 fun read init span = |
111 fun read init span = |
198 local |
210 local |
199 |
211 |
200 type print_function = string * (int * (string -> print_fn option)); |
212 type print_function = string * (int * (string -> print_fn option)); |
201 val print_functions = Synchronized.var "Command.print_functions" ([]: print_function list); |
213 val print_functions = Synchronized.var "Command.print_functions" ([]: print_function list); |
202 |
214 |
203 fun output_error tr exn = |
215 fun print_error tr e = |
204 List.app (Future.error_msg (Toplevel.pos_of tr)) (ML_Compiler.exn_messages_ids exn); |
216 (Toplevel.setmp_thread_position tr o Runtime.controlled_execution) e () handle exn => |
205 |
217 List.app (Future.error_msg (Toplevel.pos_of tr)) (ML_Compiler.exn_messages_ids exn); |
206 fun print_error tr f x = |
|
207 (Toplevel.setmp_thread_position tr o Runtime.controlled_execution) f x |
|
208 handle exn => output_error tr exn; |
|
209 |
218 |
210 in |
219 in |
211 |
220 |
212 fun print command_name eval = |
221 fun print command_visible command_name eval old_prints = |
213 rev (Synchronized.value print_functions) |> map_filter (fn (name, (pri, get_print_fn)) => |
222 let |
214 (case Exn.capture (Runtime.controlled_execution get_print_fn) command_name of |
223 fun new_print (name, (pri, get_print_fn)) = |
215 Exn.Res NONE => NONE |
224 let |
216 | Exn.Res (SOME print_fn) => |
225 fun make_print strict print_fn = |
217 let |
226 let |
218 val exec_id = Document_ID.make (); |
227 val exec_id = Document_ID.make (); |
219 fun process () = |
228 fun process () = |
220 let |
229 let |
221 val {failed, command, state = st', ...} = eval_result eval; |
230 val {failed, command, state = st', ...} = eval_result eval; |
222 val tr = Toplevel.exec_id exec_id command; |
231 val tr = Toplevel.exec_id exec_id command; |
223 in if failed then () else print_error tr (fn () => print_fn tr st') () end; |
232 in |
224 in SOME {name = name, pri = pri, exec_id = exec_id, print_process = memo process} end |
233 if failed andalso not strict then () |
225 | Exn.Exn exn => |
234 else print_error tr (fn () => print_fn tr st') |
226 let |
235 end; |
227 val exec_id = Document_ID.make (); |
236 in {name = name, pri = pri, exec_id = exec_id, print_process = memo process} end; |
228 fun process () = |
237 in |
229 let |
238 (case Exn.capture (Runtime.controlled_execution get_print_fn) command_name of |
230 val {command, ...} = eval_result eval; |
239 Exn.Res NONE => NONE |
231 val tr = Toplevel.exec_id exec_id command; |
240 | Exn.Res (SOME print_fn) => SOME (make_print false print_fn) |
232 in output_error tr exn end; |
241 | Exn.Exn exn => SOME (make_print true (fn _ => fn _ => reraise exn))) |
233 in SOME {name = name, pri = pri, exec_id = exec_id, print_process = memo process} end)); |
242 end; |
|
243 |
|
244 val new_prints = |
|
245 if command_visible then |
|
246 rev (Synchronized.value print_functions) |> map_filter (fn pr => |
|
247 (case find_first (equal (fst pr) o #name) old_prints of |
|
248 SOME print => if stable_print print then SOME print else new_print pr |
|
249 | NONE => new_print pr)) |
|
250 else filter stable_print old_prints; |
|
251 in |
|
252 if eq_list (op = o pairself #exec_id) (old_prints, new_prints) then NONE |
|
253 else SOME new_prints |
|
254 end; |
234 |
255 |
235 fun print_function {name, pri} f = |
256 fun print_function {name, pri} f = |
236 Synchronized.change print_functions (fn funs => |
257 Synchronized.change print_functions (fn funs => |
237 (if not (AList.defined (op =) funs name) then () |
258 (if not (AList.defined (op =) funs name) then () |
238 else warning ("Redefining command print function: " ^ quote name); |
259 else warning ("Redefining command print function: " ^ quote name); |
259 else memo_eval) print_process; |
280 else memo_eval) print_process; |
260 |
281 |
261 fun execute (({eval_process, ...}, prints): exec) = |
282 fun execute (({eval_process, ...}, prints): exec) = |
262 (memo_eval eval_process; List.app run_print prints); |
283 (memo_eval eval_process; List.app run_print prints); |
263 |
284 |
264 fun stable_goals exec_id = |
285 end; |
265 not (Par_Exn.is_interrupted (Future.join_results (Goal.peek_futures exec_id))); |
286 |
266 |
|
267 fun stable_eval ({exec_id, eval_process}: eval) = |
|
268 stable_goals exec_id andalso memo_stable eval_process; |
|
269 |
|
270 fun stable_print ({exec_id, print_process, ...}: print) = |
|
271 stable_goals exec_id andalso memo_stable print_process; |
|
272 |
|
273 end; |
|
274 |
|