src/Pure/PIDE/query_operation.ML
author wenzelm
Mon, 21 Sep 2015 16:55:37 +0200
changeset 61214 a00bee2dfbd1
parent 61209 7a421e7ef97c
child 61223 dfccf6c06201
permissions -rw-r--r--
tuned priority (like other query operations, e.g. "find_theorems");

(*  Title:      Pure/PIDE/query_operation.ML
    Author:     Makarius

One-shot query operations via asynchronous print functions and temporary
document overlays.
*)

signature QUERY_OPERATION =
sig
  val register: {name: string, pri: int} ->
    ({state: Toplevel.state, args: string list, output_result: string -> unit} -> unit) -> unit
end;

structure Query_Operation: QUERY_OPERATION =
struct

fun register {name, pri} f =
  Command.print_function (name ^ "_query")
    (fn {args = instance :: args, ...} =>
      SOME {delay = NONE, pri = pri, persistent = false, strict = false,
        print_fn = fn _ => uninterruptible (fn restore_attributes => fn state =>
          let
            fun result s = Output.result [(Markup.instanceN, instance)] [s];
            fun status m = result (Markup.markup_only m);
            fun output_result s = result (Markup.markup Markup.writeln s);
            fun toplevel_error exn = result (Markup.markup Markup.error (Runtime.exn_message exn));

            val _ = status Markup.running;
            fun run () = f {state = state, args = args, output_result = output_result};
            val _ =
              (case Exn.capture (*sic!*) (restore_attributes run) () of
                Exn.Res () => ()
              | Exn.Exn exn => toplevel_error exn);
            val _ = status Markup.finished;
          in () end)}
    | _ => NONE);


(* print_state *)

val _ =
  register {name = "print_state", pri = Task_Queue.urgent_pri}
    (fn {state = st, output_result, ...} =>
      if Toplevel.is_proof st
      then output_result (Markup.markup Markup.state (Toplevel.string_of_state st))
      else ());

end;