src/Pure/PIDE/command.ML
changeset 52570 26d84a0b9209
parent 52566 52a0eacf04d1
child 52571 344527354323
equal deleted inserted replaced
52569:18dde2cf7aa7 52570:26d84a0b9209
    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