src/Pure/Thy/thy_load.ML
changeset 42003 6e45dc518ebb
parent 42002 ac7097bd8611
child 43700 e4ece46a9ca7
equal deleted inserted replaced
42002:ac7097bd8611 42003:6e45dc518ebb
     7 signature THY_LOAD =
     7 signature THY_LOAD =
     8 sig
     8 sig
     9   val master_directory: theory -> Path.T
     9   val master_directory: theory -> Path.T
    10   val imports_of: theory -> string list
    10   val imports_of: theory -> string list
    11   val provide: Path.T * (Path.T * SHA1.digest) -> theory -> theory
    11   val provide: Path.T * (Path.T * SHA1.digest) -> theory -> theory
    12   val check_file: Path.T -> Path.T -> Path.T * SHA1.digest
    12   val check_file: Path.T -> Path.T -> Path.T
    13   val check_thy: Path.T -> string -> Path.T * SHA1.digest
    13   val check_thy: Path.T -> string ->
    14   val deps_thy: Path.T -> string ->
    14     {master: Path.T * SHA1.digest, text: string, imports: string list, uses: (Path.T * bool) list}
    15    {master: Path.T * SHA1.digest, text: string, imports: string list, uses: Path.T list}
       
    16   val loaded_files: theory -> Path.T list
    15   val loaded_files: theory -> Path.T list
    17   val all_current: theory -> bool
    16   val all_current: theory -> bool
    18   val provide_file: Path.T -> theory -> theory
    17   val provide_file: Path.T -> theory -> theory
    19   val use_ml: Path.T -> unit
    18   val use_ml: Path.T -> unit
    20   val exec_ml: Path.T -> generic_theory -> generic_theory
    19   val exec_ml: Path.T -> generic_theory -> generic_theory
    68     else (master_dir, imports, required, (src_path, path_id) :: provided));
    67     else (master_dir, imports, required, (src_path, path_id) :: provided));
    69 
    68 
    70 
    69 
    71 (* check files *)
    70 (* check files *)
    72 
    71 
    73 fun get_file dir src_path =
    72 fun check_file dir file = File.check_file (File.full_path dir file);
       
    73 
       
    74 fun digest_file dir file =
    74   let
    75   let
    75     val path = Path.expand src_path;
    76     val full_path = check_file dir file;
    76     val _ = Path.is_current path andalso error "Bad file specification";
    77     val id = SHA1.digest (File.read full_path);
    77     val full_path = File.full_path (Path.append dir path);
    78   in (full_path, id) end;
    78   in
       
    79     if File.exists full_path
       
    80     then SOME (full_path, SHA1.digest (File.read full_path))
       
    81     else NONE
       
    82   end;
       
    83 
       
    84 fun check_file dir file =
       
    85   (case get_file dir file of
       
    86     SOME path_id => path_id
       
    87   | NONE => error ("Could not find file " ^ Path.print file ^ "\nin " ^ Path.print dir));
       
    88 
    79 
    89 fun check_thy dir name =
    80 fun check_thy dir name =
    90   check_file dir (Thy_Header.thy_path name);
       
    91 
       
    92 
       
    93 (* theory deps *)
       
    94 
       
    95 fun deps_thy master_dir name =
       
    96   let
    81   let
    97     val master as (thy_path, _) = check_thy master_dir name;
    82     val master_file = check_file dir (Thy_Header.thy_path name);
    98     val text = File.read thy_path;
    83     val text = File.read master_file;
    99     val (name', imports, uses) = Thy_Header.read (Path.position thy_path) text;
    84     val (name', imports, uses) =
       
    85       if name = Context.PureN then (Context.PureN, [], [])
       
    86       else Thy_Header.read (Path.position master_file) text;
   100     val _ = Thy_Header.consistent_name name name';
    87     val _ = Thy_Header.consistent_name name name';
   101     val uses = map (Path.explode o #1) uses;
    88   in {master = (master_file, SHA1.digest text), text = text, imports = imports, uses = uses} end;
   102   in {master = master, text = text, imports = imports, uses = uses} end;
       
   103 
       
   104 
    89 
   105 
    90 
   106 (* loaded files *)
    91 (* loaded files *)
   107 
    92 
   108 val loaded_files = map (#1 o #2) o #provided o Files.get;
    93 val loaded_files = map (#1 o #2) o #provided o Files.get;
   123 
   108 
   124 fun all_current thy =
   109 fun all_current thy =
   125   let
   110   let
   126     val {master_dir, provided, ...} = Files.get thy;
   111     val {master_dir, provided, ...} = Files.get thy;
   127     fun current (src_path, (_, id)) =
   112     fun current (src_path, (_, id)) =
   128       (case get_file master_dir src_path of
   113       (case try (digest_file master_dir) src_path of
   129         NONE => false
   114         NONE => false
   130       | SOME (_, id') => id = id');
   115       | SOME (_, id') => id = id');
   131   in can check_loaded thy andalso forall current provided end;
   116   in can check_loaded thy andalso forall current provided end;
   132 
   117 
   133 val _ = Context.>> (Context.map_theory (Theory.at_end (fn thy => (check_loaded thy; NONE))));
   118 val _ = Context.>> (Context.map_theory (Theory.at_end (fn thy => (check_loaded thy; NONE))));
   134 
   119 
   135 
   120 
   136 (* provide files *)
   121 (* provide files *)
   137 
   122 
   138 fun provide_file src_path thy =
   123 fun provide_file src_path thy =
   139   provide (src_path, check_file (master_directory thy) src_path) thy;
   124   provide (src_path, digest_file (master_directory thy) src_path) thy;
   140 
   125 
   141 fun use_ml src_path =
   126 fun use_ml src_path =
   142   if is_none (Context.thread_data ()) then
   127   if is_none (Context.thread_data ()) then
   143     ML_Context.eval_file (#1 (check_file Path.current src_path))
   128     ML_Context.eval_file (check_file Path.current src_path)
   144   else
   129   else
   145     let
   130     let
   146       val thy = ML_Context.the_global_context ();
   131       val thy = ML_Context.the_global_context ();
   147       val (path, id) = check_file (master_directory thy) src_path;
   132       val (path, id) = digest_file (master_directory thy) src_path;
   148 
   133 
   149       val _ = ML_Context.eval_file path;
   134       val _ = ML_Context.eval_file path;
   150       val _ = Context.>> Local_Theory.propagate_ml_env;
   135       val _ = Context.>> Local_Theory.propagate_ml_env;
   151 
   136 
   152       val provide = provide (src_path, (path, id));
   137       val provide = provide (src_path, (path, id));