src/Pure/System/session.ML
author wenzelm
Fri, 16 Mar 2012 21:40:21 +0100
changeset 47841 9667e0dcb5e2
parent 47836 5c6955f487e5
child 49433 1a634f9614fb
permissions -rw-r--r--
check declared vs. defined commands at end of session;
     1 (*  Title:      Pure/System/session.ML
     2     Author:     Markus Wenzel, TU Muenchen
     3 
     4 Session management -- maintain state of logic images.
     5 *)
     6 
     7 signature SESSION =
     8 sig
     9   val id: unit -> string list
    10   val name: unit -> string
    11   val welcome: unit -> string
    12   val use_dir: string -> string -> bool -> string list -> bool -> bool ->
    13     string -> bool -> string list -> string -> string -> bool * string ->
    14     string -> int -> bool -> bool -> int -> int -> int -> int -> unit
    15   val finish: unit -> unit
    16 end;
    17 
    18 structure Session: SESSION =
    19 struct
    20 
    21 
    22 (* session state *)
    23 
    24 val session = Unsynchronized.ref ([Context.PureN]: string list);
    25 val session_path = Unsynchronized.ref ([]: string list);
    26 val session_finished = Unsynchronized.ref false;
    27 val remote_path = Unsynchronized.ref (NONE: Url.T option);
    28 
    29 
    30 (* access path *)
    31 
    32 fun id () = ! session;
    33 fun path () = ! session_path;
    34 
    35 fun str_of [] = Context.PureN
    36   | str_of elems = space_implode "/" elems;
    37 
    38 fun name () = "Isabelle/" ^ str_of (path ());
    39 
    40 
    41 (* welcome *)
    42 
    43 fun welcome () =
    44   if Distribution.is_official then
    45     "Welcome to " ^ name () ^ " (" ^ Distribution.version ^ ")"
    46   else
    47     "Unofficial version of " ^ name () ^ " (" ^ Distribution.version ^ ")" ^
    48     (if Distribution.changelog <> "" then "\nSee also " ^ Distribution.changelog else "");
    49 
    50 val _ =
    51   Outer_Syntax.improper_command ("welcome", Keyword.diag) "print welcome message"
    52     (Scan.succeed (Toplevel.no_timing o Toplevel.imperative (writeln o welcome)));
    53 
    54 
    55 (* add_path *)
    56 
    57 fun add_path reset s =
    58   let val sess = ! session @ [s] in
    59     (case duplicates (op =) sess of
    60       [] => (session := sess; session_path := ((if reset then [] else ! session_path) @ [s]))
    61     | dups => error ("Duplicate session identifiers " ^ commas_quote dups ^ " in " ^ str_of sess))
    62   end;
    63 
    64 
    65 (* init *)
    66 
    67 fun init reset parent name =
    68   if not (member (op =) (! session) parent) orelse not (! session_finished) then
    69     error ("Unfinished parent session " ^ quote parent ^ " for " ^ quote name)
    70   else (add_path reset name; session_finished := false);
    71 
    72 
    73 (* finish *)
    74 
    75 fun finish () =
    76   (Thy_Info.finish ();
    77     Present.finish ();
    78     Outer_Syntax.check_syntax ();
    79     Future.shutdown ();
    80     session_finished := true);
    81 
    82 
    83 (* use_dir *)
    84 
    85 fun get_rpath rpath =
    86   (if rpath = "" then () else
    87      if is_some (! remote_path) then
    88        error "Path for remote theory browsing information may only be set once"
    89      else
    90        remote_path := SOME (Url.explode rpath);
    91    (! remote_path, rpath <> ""));
    92 
    93 fun dumping (_, "") = NONE
    94   | dumping (cp, path) = SOME (cp, Path.explode path);
    95 
    96 fun use_dir item root build modes reset info doc doc_graph doc_variants parent
    97     name dump rpath level timing verbose max_threads trace_threads
    98     parallel_proofs parallel_proofs_threshold =
    99   ((fn () =>
   100      (init reset parent name;
   101       Present.init build info doc doc_graph doc_variants (path ()) name
   102         (dumping dump) (get_rpath rpath) verbose (map Thy_Info.get_theory (Thy_Info.get_names ()));
   103       if timing then
   104         let
   105           val start = Timing.start ();
   106           val _ = use root;
   107           val timing = Timing.result start;
   108           val factor = Time.toReal (#cpu timing) / Time.toReal (#elapsed timing)
   109             |> Real.fmt (StringCvt.FIX (SOME 2));
   110           val _ =
   111             Output.physical_stderr ("Timing " ^ item ^ " (" ^
   112               string_of_int (Multithreading.max_threads_value ()) ^ " threads, " ^
   113               Timing.message timing ^ ", factor " ^ factor ^ ")\n");
   114         in () end
   115       else use root;
   116       finish ()))
   117     |> Unsynchronized.setmp Proofterm.proofs level
   118     |> Unsynchronized.setmp print_mode (modes @ print_mode_value ())
   119     |> Unsynchronized.setmp Goal.parallel_proofs parallel_proofs
   120     |> Unsynchronized.setmp Goal.parallel_proofs_threshold parallel_proofs_threshold
   121     |> Unsynchronized.setmp Multithreading.trace trace_threads
   122     |> Unsynchronized.setmp Multithreading.max_threads
   123       (if Multithreading.available then max_threads
   124        else (if max_threads = 1 then () else warning "Multithreading support unavailable"; 1))) ()
   125   handle exn => (Output.error_msg (ML_Compiler.exn_message exn); exit 1);
   126 
   127 end;