src/Pure/Thy/thy_info.ML
changeset 73046 32edc2b4e243
parent 73045 1edf30bc1008
child 73559 22b5ecb53dd9
equal deleted inserted replaced
73045:1edf30bc1008 73046:32edc2b4e243
   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