1 (* Title: Pure/System/session.ML |
1 (* Title: Pure/System/session.ML |
2 Author: Markus Wenzel, TU Muenchen |
2 Author: Markus Wenzel, TU Muenchen |
3 |
3 |
4 Session management -- maintain state of logic images. |
4 Session management -- internal state of logic images. |
5 *) |
5 *) |
6 |
6 |
7 signature SESSION = |
7 signature SESSION = |
8 sig |
8 sig |
9 val id: unit -> string list |
|
10 val name: unit -> string |
9 val name: unit -> string |
11 val path: unit -> string list |
|
12 val welcome: unit -> string |
10 val welcome: unit -> string |
|
11 val init: bool -> bool -> Path.T -> string -> bool -> string -> (string * string) list -> |
|
12 string -> string * string -> bool * string -> bool -> unit |
13 val finish: unit -> unit |
13 val finish: unit -> unit |
14 val init: bool -> bool -> bool -> string -> string -> bool -> string -> (string * string) list -> |
|
15 string -> string -> bool * string -> bool -> unit |
|
16 val with_timing: string -> bool -> ('a -> 'b) -> 'a -> 'b |
14 val with_timing: string -> bool -> ('a -> 'b) -> 'a -> 'b |
17 val use_dir: string -> string -> bool -> string list -> bool -> bool -> string -> |
15 val use_dir: string -> string -> bool -> string list -> bool -> bool -> string -> |
18 string -> bool -> string list -> string -> string -> bool * string -> |
16 string -> bool -> string list -> string -> string -> bool * string -> |
19 string -> int -> bool -> bool -> int -> int -> int -> int -> unit |
17 string -> int -> bool -> bool -> int -> int -> int -> int -> unit |
20 end; |
18 end; |
22 structure Session: SESSION = |
20 structure Session: SESSION = |
23 struct |
21 struct |
24 |
22 |
25 (* session state *) |
23 (* session state *) |
26 |
24 |
27 val session = Unsynchronized.ref ([Context.PureN]: string list); |
25 val session = Unsynchronized.ref {chapter = "Pure", name = "Pure"}; |
28 val session_finished = Unsynchronized.ref false; |
26 val session_finished = Unsynchronized.ref false; |
29 |
27 |
30 fun id () = ! session; |
28 fun name () = "Isabelle/" ^ #name (! session); |
31 fun name () = "Isabelle/" ^ List.last (! session); |
|
32 |
|
33 |
|
34 (* access path *) |
|
35 |
|
36 val session_path = Unsynchronized.ref ([]: string list); |
|
37 |
|
38 fun path () = ! session_path; |
|
39 |
|
40 |
|
41 (* welcome *) |
|
42 |
29 |
43 fun welcome () = |
30 fun welcome () = |
44 if Distribution.is_official then |
31 if Distribution.is_official then |
45 "Welcome to " ^ name () ^ " (" ^ Distribution.version ^ ")" |
32 "Welcome to " ^ name () ^ " (" ^ Distribution.version ^ ")" |
46 else "Unofficial version of " ^ name () ^ " (" ^ Distribution.version ^ ")"; |
33 else "Unofficial version of " ^ name () ^ " (" ^ Distribution.version ^ ")"; |
47 |
34 |
48 |
35 |
49 (* add_path *) |
36 (* init *) |
50 |
37 |
51 fun add_path reset s = |
38 fun init build info info_path doc doc_graph doc_output doc_variants |
52 let val sess = ! session @ [s] in |
39 parent (chapter, name) doc_dump verbose = |
53 (case duplicates (op =) sess of |
40 if #name (! session) <> parent orelse not (! session_finished) then |
54 [] => (session := sess; session_path := ((if reset then [] else ! session_path) @ [s])) |
|
55 | dups => error ("Duplicate session identifiers " ^ commas_quote dups)) |
|
56 end; |
|
57 |
|
58 |
|
59 (* init_name *) |
|
60 |
|
61 fun init_name reset parent name = |
|
62 if not (member (op =) (! session) parent) orelse not (! session_finished) then |
|
63 error ("Unfinished parent session " ^ quote parent ^ " for " ^ quote name) |
41 error ("Unfinished parent session " ^ quote parent ^ " for " ^ quote name) |
64 else (add_path reset name; session_finished := false); |
42 else |
|
43 let |
|
44 val _ = session := {chapter = chapter, name = name}; |
|
45 val _ = session_finished := false; |
|
46 in |
|
47 Present.init build info info_path (if doc = "false" then "" else doc) |
|
48 doc_graph doc_output doc_variants (chapter, name) |
|
49 doc_dump verbose (map Thy_Info.get_theory (Thy_Info.get_names ())) |
|
50 end; |
65 |
51 |
66 |
52 |
67 (* finish *) |
53 (* finish *) |
68 |
54 |
69 fun finish () = |
55 fun finish () = |
97 Output.physical_stderr ("Timing " ^ name ^ " (" ^ |
83 Output.physical_stderr ("Timing " ^ name ^ " (" ^ |
98 threads ^ " threads, " ^ Timing.message timing ^ ", factor " ^ factor ^ ")\n") |
84 threads ^ " threads, " ^ Timing.message timing ^ ", factor " ^ factor ^ ")\n") |
99 else (); |
85 else (); |
100 in y end; |
86 in y end; |
101 |
87 |
102 fun init build reset info info_path doc doc_graph doc_output doc_variants |
|
103 parent name doc_dump verbose = |
|
104 (init_name reset parent name; |
|
105 Present.init build info info_path (if doc = "false" then "" else doc) doc_graph doc_output |
|
106 doc_variants (path ()) name doc_dump verbose |
|
107 (map Thy_Info.get_theory (Thy_Info.get_names ()))); |
|
108 |
88 |
109 local |
89 (* use_dir *) |
110 |
90 |
111 fun read_variants strs = |
91 fun read_variants strs = |
112 rev (distinct (eq_fst (op =)) (rev (("document", "") :: map Present.read_variant strs))) |
92 rev (distinct (eq_fst (op =)) (rev (("document", "") :: map Present.read_variant strs))) |
113 |> filter_out (fn (_, s) => s = "-"); |
93 |> filter_out (fn (_, s) => s = "-"); |
114 |
|
115 in |
|
116 |
94 |
117 fun use_dir item root build modes reset info info_path doc doc_graph doc_variants parent |
95 fun use_dir item root build modes reset info info_path doc doc_graph doc_variants parent |
118 name doc_dump rpath level timing verbose max_threads trace_threads |
96 name doc_dump rpath level timing verbose max_threads trace_threads |
119 parallel_proofs parallel_proofs_threshold = |
97 parallel_proofs parallel_proofs_threshold = |
120 ((fn () => |
98 ((fn () => |
121 let |
99 let |
122 val _ = |
100 val _ = |
123 Output.physical_stderr |
101 Output.physical_stderr |
124 "### Legacy feature: old \"isabelle usedir\" -- use \"isabelle build\" instead!\n"; |
102 "### Legacy feature: old \"isabelle usedir\" -- use \"isabelle build\" instead!\n"; |
125 val _ = |
103 val _ = |
|
104 if not reset then () |
|
105 else Output.physical_stderr "### Ignoring reset (historic usedir option -r)\n"; |
|
106 val _ = |
126 if rpath = "" then () |
107 if rpath = "" then () |
127 else |
108 else Output.physical_stderr "### Ignoring remote path (historic usedir option -P)\n"; |
128 Output.physical_stderr "### Ignoring remote path (historic usedir option -P)\n"; |
|
129 |
109 |
130 val _ = |
110 val _ = |
131 init build reset info info_path doc doc_graph "" (read_variants doc_variants) parent name |
111 init build info (Path.explode info_path) doc doc_graph "" (read_variants doc_variants) |
132 doc_dump verbose; |
112 parent ("Unsorted", name) doc_dump verbose; |
133 val res1 = (use |> with_timing item timing |> Exn.capture) root; |
113 val res1 = (use |> with_timing item timing |> Exn.capture) root; |
134 val res2 = Exn.capture finish (); |
114 val res2 = Exn.capture finish (); |
135 in ignore (Par_Exn.release_all [res1, res2]) end) |
115 in ignore (Par_Exn.release_all [res1, res2]) end) |
136 |> Unsynchronized.setmp Proofterm.proofs level |
116 |> Unsynchronized.setmp Proofterm.proofs level |
137 |> Unsynchronized.setmp print_mode (modes @ print_mode_value ()) |
117 |> Unsynchronized.setmp print_mode (modes @ print_mode_value ()) |