src/Pure/Thy/thy_load.ML
changeset 43712 3c2c912af2ef
parent 43702 24fb44c1086a
child 44113 0baa8bbd355a
equal deleted inserted replaced
43711:608d1b451f67 43712:3c2c912af2ef
    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;