16 val use_file: Path.T -> theory -> string * theory |
16 val use_file: Path.T -> theory -> string * theory |
17 val loaded_files: theory -> Path.T list |
17 val loaded_files: theory -> Path.T list |
18 val all_current: theory -> bool |
18 val all_current: theory -> bool |
19 val use_ml: Path.T -> unit |
19 val use_ml: Path.T -> unit |
20 val exec_ml: Path.T -> generic_theory -> generic_theory |
20 val exec_ml: Path.T -> generic_theory -> generic_theory |
21 val begin_theory: Path.T -> string -> string list -> theory list -> (Path.T * bool) list -> theory |
21 val begin_theory: Path.T -> string -> string list -> (Path.T * bool) list -> |
|
22 theory list -> theory |
|
23 val load_thy: int -> Path.T -> string -> string list -> (Path.T * bool) list -> |
|
24 Position.T -> string -> theory list -> theory * unit future |
22 val set_master_path: Path.T -> unit |
25 val set_master_path: Path.T -> unit |
23 val get_master_path: unit -> Path.T |
26 val get_master_path: unit -> Path.T |
24 end; |
27 end; |
25 |
28 |
26 structure Thy_Load: THY_LOAD = |
29 structure Thy_Load: THY_LOAD = |
147 in () end; |
150 in () end; |
148 |
151 |
149 fun exec_ml src_path = ML_Context.exec (fn () => use_ml src_path); |
152 fun exec_ml src_path = ML_Context.exec (fn () => use_ml src_path); |
150 |
153 |
151 |
154 |
152 (* begin theory *) |
155 (* load_thy *) |
153 |
156 |
154 fun begin_theory dir name imports parents uses = |
157 fun begin_theory dir name imports uses parents = |
155 Theory.begin_theory name parents |
158 Theory.begin_theory name parents |
156 |> put_deps dir imports |
159 |> put_deps dir imports |
157 |> fold (require o fst) uses |
160 |> fold (require o fst) uses |
158 |> fold (fn (path, true) => Context.theory_map (exec_ml path) o Theory.checkpoint | _ => I) uses |
161 |> fold (fn (path, true) => Context.theory_map (exec_ml path) o Theory.checkpoint | _ => I) uses |
159 |> Theory.checkpoint; |
162 |> Theory.checkpoint; |
160 |
163 |
|
164 fun load_thy update_time dir name imports uses pos text parents = |
|
165 let |
|
166 val (lexs, outer_syntax) = Outer_Syntax.get_syntax (); |
|
167 val time = ! Toplevel.timing; |
|
168 |
|
169 val _ = Present.init_theory name; |
|
170 fun init _ = |
|
171 begin_theory dir name imports uses parents |
|
172 |> Present.begin_theory update_time dir uses; |
|
173 |
|
174 val toks = Source.exhausted (Thy_Syntax.token_source lexs pos (Source.of_string text)); |
|
175 val spans = Source.exhaust (Thy_Syntax.span_source toks); |
|
176 val _ = List.app Thy_Syntax.report_span spans; (* FIXME ?? *) |
|
177 val elements = |
|
178 Source.exhaust (Thy_Syntax.element_source (Source.of_list spans)) |
|
179 |> Par_List.map_name "Outer_Syntax.prepare_element" |
|
180 (Outer_Syntax.prepare_element outer_syntax init) |
|
181 |> flat; |
|
182 |
|
183 val _ = Present.theory_source name |
|
184 (fn () => HTML.html_mode (implode o map Thy_Syntax.present_span) spans); |
|
185 |
|
186 val _ = if time then writeln ("\n**** Starting theory " ^ quote name ^ " ****") else (); |
|
187 val (results, thy) = cond_timeit time "" (fn () => Toplevel.excursion elements); |
|
188 val _ = if time then writeln ("**** Finished theory " ^ quote name ^ " ****\n") else (); |
|
189 |
|
190 val present = |
|
191 singleton (Future.cond_forks {name = "Outer_Syntax.present:" ^ name, group = NONE, |
|
192 deps = map Future.task_of results, pri = 0}) |
|
193 (fn () => |
|
194 Thy_Output.present_thy (#1 lexs) Keyword.command_tags |
|
195 (Outer_Syntax.is_markup outer_syntax) |
|
196 (maps Future.join results) toks |
|
197 |> Buffer.content |
|
198 |> Present.theory_output name); |
|
199 |
|
200 in (thy, present) end; |
|
201 |
161 |
202 |
162 (* global master path *) |
203 (* global master path *) |
163 |
204 |
164 local |
205 local |
165 val master_path = Unsynchronized.ref Path.current; |
206 val master_path = Unsynchronized.ref Path.current; |