270 in () end); |
270 in () end); |
271 |
271 |
272 |
272 |
273 (* eval theory *) |
273 (* eval theory *) |
274 |
274 |
275 fun excursion keywords master_dir init text_pos elements = |
|
276 let |
|
277 fun prepare_span st span = |
|
278 let |
|
279 val tr = |
|
280 Position.setmp_thread_data (Position.copy_id text_pos Position.none) |
|
281 (fn () => Command.read_span keywords st master_dir init span) (); |
|
282 in Toplevel.timing (Resources.last_timing tr) tr end; |
|
283 |
|
284 fun element_result span_elem (st, _) = |
|
285 let |
|
286 val elem = Thy_Element.map_element (prepare_span st) span_elem; |
|
287 val (results, st') = Toplevel.element_result keywords elem st; |
|
288 val pos' = Toplevel.pos_of (Thy_Element.last_element elem); |
|
289 in (results, (st', pos')) end; |
|
290 |
|
291 val (results, (end_state, end_pos)) = |
|
292 fold_map element_result elements (Toplevel.init_toplevel (), Position.none); |
|
293 |
|
294 val thy = Toplevel.end_theory end_pos end_state; |
|
295 in (results, thy) end; |
|
296 |
|
297 fun eval_thy options master_dir header text_pos text parents = |
275 fun eval_thy options master_dir header text_pos text parents = |
298 let |
276 let |
299 val (name, _) = #name header; |
277 val (name, _) = #name header; |
300 val keywords = |
278 val keywords = |
301 fold (curry Keyword.merge_keywords o Thy_Header.get_keywords) parents |
279 fold (curry Keyword.merge_keywords o Thy_Header.get_keywords) parents |
302 (Keyword.add_keywords (#keywords header) Keyword.empty_keywords); |
280 (Keyword.add_keywords (#keywords header) Keyword.empty_keywords); |
303 |
281 |
304 val spans = Outer_Syntax.parse_spans (Token.explode keywords text_pos text); |
282 val spans = Outer_Syntax.parse_spans (Token.explode keywords text_pos text); |
305 val elements = Thy_Element.parse_elements keywords spans; |
283 val elements = Thy_Element.parse_elements keywords spans; |
306 |
284 |
|
285 val text_id = Position.copy_id text_pos Position.none; |
|
286 |
307 fun init () = Resources.begin_theory master_dir header parents; |
287 fun init () = Resources.begin_theory master_dir header parents; |
308 val (results, thy) = |
288 |
309 cond_timeit true ("theory " ^ quote name) |
289 fun excursion () = |
310 (fn () => excursion keywords master_dir init text_pos elements); |
290 let |
|
291 fun element_result span_elem (st, _) = |
|
292 let |
|
293 fun prepare span = |
|
294 let |
|
295 val tr = |
|
296 Position.setmp_thread_data text_id |
|
297 (fn () => Command.read_span keywords st master_dir init span) (); |
|
298 in Toplevel.timing (Resources.last_timing tr) tr end; |
|
299 val elem = Thy_Element.map_element prepare span_elem; |
|
300 val (results, st') = Toplevel.element_result keywords elem st; |
|
301 val pos' = Toplevel.pos_of (Thy_Element.last_element elem); |
|
302 in (results, (st', pos')) end; |
|
303 |
|
304 val (results, (end_state, end_pos)) = |
|
305 fold_map element_result elements (Toplevel.init_toplevel (), Position.none); |
|
306 |
|
307 val thy = Toplevel.end_theory end_pos end_state; |
|
308 in (results, thy) end; |
|
309 |
|
310 val (results, thy) = cond_timeit true ("theory " ^ quote name) excursion; |
311 |
311 |
312 fun present () = |
312 fun present () = |
313 let |
313 let |
314 val segments = (spans ~~ maps Toplevel.join_results results) |
314 val segments = (spans ~~ maps Toplevel.join_results results) |
315 |> map (fn (span, (tr, st')) => {span = span, command = tr, state = st'}); |
315 |> map (fn (span, (tr, st')) => {span = span, command = tr, state = st'}); |
316 val context: presentation_context = |
316 val context: presentation_context = |
317 {options = options, file_pos = text_pos, adjust_pos = I, segments = segments}; |
317 {options = options, file_pos = text_pos, adjust_pos = I, segments = segments}; |
318 in apply_presentation context thy end; |
318 in apply_presentation context thy end; |
|
319 |
319 in (thy, present, size text) end; |
320 in (thy, present, size text) end; |
320 |
321 |
321 |
322 |
322 (* require_thy -- checking database entries wrt. the file-system *) |
323 (* require_thy -- checking database entries wrt. the file-system *) |
323 |
324 |