src/Pure/Isar/isar.ML
author wenzelm
Thu, 10 Apr 2008 13:24:22 +0200
changeset 26605 24e60e823d22
child 26606 379596d12f25
permissions -rw-r--r--
The global Isabelle/Isar state and main read-eval-print loop.

(*  Title:      Pure/Isar/isar.ML
    ID:         $Id$
    Author:     Makarius

The global Isabelle/Isar state and main read-eval-print loop.
*)

signature ISAR =
sig
  val state: unit -> Toplevel.state
  val exn: unit -> (exn * string) option
  val context: unit -> Proof.context
  val goal: unit -> thm
  val >> : Toplevel.transition -> bool
  val >>> : Toplevel.transition list -> unit
  val init: unit -> unit
  val crashes: exn list ref
  val main: unit -> unit
  val loop: unit -> unit
  val sync_main: unit -> unit
  val sync_loop: unit -> unit
  val secure_main: unit -> unit
end;

structure Isar: ISAR =
struct

(* the global state *)

val global_state = ref (Toplevel.toplevel, NONE: (exn * string) option);

fun state () = #1 (! global_state);
fun exn () = #2 (! global_state);

fun context () =
  Toplevel.context_of (state ())
    handle Toplevel.UNDEF => error "Unknown context";

fun goal () =
  #2 (#2 (Proof.get_goal (Toplevel.proof_of (state ()))))
    handle Toplevel.UNDEF => error "No goal present";


(* interactive state transformations --- NOT THREAD-SAFE! *)

nonfix >> >>>;

fun >> tr =
  (case Toplevel.transition true tr (state ()) of
    NONE => false
  | SOME (state', exn_info) =>
      (global_state := (state', exn_info);
        (case exn_info of
          NONE => ()
        | SOME err => Toplevel.error_msg tr err);
        true));

fun >>> [] = ()
  | >>> (tr :: trs) = if >> tr then >>> trs else ();

fun init () = (>> (Toplevel.init_empty (K true) (K ()) Toplevel.empty); ());


(* main loop *)

val crashes = ref ([]: exn list);

local

(*Spurious interrupts ahead!  Race condition?*)
fun get_interrupt src = SOME (Source.get_single src) handle Interrupt => NONE;

fun raw_loop secure src =
  let
    fun check_secure () =
      (if secure then warning "Secure loop -- cannot exit to ML" else (); secure);
  in
    (case get_interrupt (Source.set_prompt Source.default_prompt src) of
      NONE => (writeln "\nInterrupt."; raw_loop secure src)
    | SOME NONE => if secure then quit () else ()
    | SOME (SOME (tr, src')) => if >> tr orelse check_secure () then raw_loop secure src' else ())
    handle exn => (Output.error_msg (Toplevel.exn_message exn) handle crash =>
      (CRITICAL (fn () => change crashes (cons crash));
        warning "Recovering after Isar toplevel crash -- see also Isar.crashes");
      raw_loop secure src)
  end;

in

fun gen_loop secure do_terminate =
 (Context.set_thread_data NONE;
  uninterruptible (fn _ => fn () => raw_loop secure (OuterSyntax.isar do_terminate)) ());

fun gen_main secure do_terminate =
 (init ();
  writeln (Session.welcome ());
  gen_loop secure do_terminate);

end;

fun main () = gen_main (Secure.is_secure ()) false;
fun loop () = gen_loop (Secure.is_secure ()) false;
fun sync_main () = gen_main (Secure.is_secure ()) true;
fun sync_loop () = gen_loop (Secure.is_secure ()) true;
fun secure_main () = (init (); gen_loop true true);

end;