src/Pure/Thy/thy_load.ML
changeset 48874 ff9cd47be39b
parent 48869 4371a8d029f2
child 48876 157dd47032e0
equal deleted inserted replaced
48873:18b17f15bc62 48874:ff9cd47be39b
     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
    12   val check_file: Path.T -> Path.T -> Path.T
    13   val thy_path: Path.T -> Path.T
    13   val thy_path: Path.T -> Path.T
    14   val check_thy: Path.T -> string ->
    14   val check_thy: (string * Keyword.T option) list -> Path.T -> string ->
    15     {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,
       
    16     uses: (Path.T * bool) list, keywords: (string * Keyword.T option) list}
    16   val load_file: theory -> Path.T -> (Path.T * SHA1.digest) * string
    17   val load_file: theory -> Path.T -> (Path.T * SHA1.digest) * string
    17   val use_file: Path.T -> theory -> string * theory
    18   val use_file: Path.T -> theory -> string * theory
    18   val loaded_files: theory -> Path.T list
    19   val loaded_files: theory -> Path.T list
    19   val all_current: theory -> bool
    20   val all_current: theory -> bool
    20   val use_ml: Path.T -> unit
    21   val use_ml: Path.T -> unit
    73     else (master_dir, imports, required, (src_path, path_id) :: provided));
    74     else (master_dir, imports, required, (src_path, path_id) :: provided));
    74 
    75 
    75 
    76 
    76 (* inlined files *)
    77 (* inlined files *)
    77 
    78 
    78 fun command_files cmd path =
    79 local
    79   (case Keyword.command_files cmd of
    80 
    80     [] => [path]
    81 fun clean ((i1, t1) :: (i2, t2) :: toks) =
    81   | exts => map (fn ext => Path.ext ext path) exts);
    82       if Token.keyword_with (fn s => s = "%" orelse s = "--") t1 then clean toks
       
    83       else (i1, t1) :: clean ((i2, t2) :: toks)
       
    84   | clean toks = toks;
       
    85 
       
    86 fun clean_tokens toks =
       
    87   ((0 upto length toks - 1) ~~ toks)
       
    88   |> filter (fn (_, tok) => Token.is_proper tok)
       
    89   |> clean;
       
    90 
       
    91 fun find_file toks =
       
    92   rev (clean_tokens toks) |> get_first (fn (i, tok) =>
       
    93     if Token.is_name tok then SOME (i, Path.explode (Token.content_of tok))
       
    94     else NONE);
       
    95 
       
    96 fun command_files path exts =
       
    97   if null exts then [path]
       
    98   else map (fn ext => Path.ext ext path) exts;
       
    99 
       
   100 in
       
   101 
       
   102 fun find_files syntax text =
       
   103   let val thy_load_commands = Keyword.thy_load_commands syntax in
       
   104     if exists (fn (cmd, _) => String.isSubstring cmd text) thy_load_commands then
       
   105       Thy_Syntax.parse_tokens (Keyword.lexicons_of syntax) Position.none text
       
   106       |> Thy_Syntax.parse_spans
       
   107       |> maps
       
   108         (fn Thy_Syntax.Span (Thy_Syntax.Command cmd, toks) =>
       
   109               (case AList.lookup (op =) thy_load_commands cmd of
       
   110                 SOME exts =>
       
   111                   (case find_file toks of
       
   112                     SOME (_, path) => command_files path exts
       
   113                   | NONE => [])
       
   114               | NONE => [])
       
   115           | _ => [])
       
   116     else []
       
   117   end;
    82 
   118 
    83 fun read_files cmd dir tok =
   119 fun read_files cmd dir tok =
    84   let
   120   let
    85     val path = Path.explode (Token.content_of tok);
   121     val path = Path.explode (Token.content_of tok);
    86     val files =
   122     val files =
    87       command_files cmd path
   123       command_files path (Keyword.command_files cmd)
    88       |> map (Path.append dir #> (fn p => (File.read p, Path.position p)));
   124       |> map (Path.append dir #> (fn path => (File.read path, Path.position path)));
    89   in (dir, files) end;
   125   in (dir, files) end;
    90 
   126 
    91 fun parse_files cmd =
   127 fun parse_files cmd =
    92   Scan.ahead Parse.not_eof -- Parse.group (fn () => "file name/path specification") Parse.name
   128   Scan.ahead Parse.not_eof -- Parse.group (fn () => "file name/path specification") Parse.name
    93     >> (fn (tok, name) => fn thy =>
   129     >> (fn (tok, name) => fn thy =>
    95         SOME files => files
   131         SOME files => files
    96       | NONE =>
   132       | NONE =>
    97           (warning ("Dynamic loading of files: " ^ quote name ^ Token.pos_of tok);
   133           (warning ("Dynamic loading of files: " ^ quote name ^ Token.pos_of tok);
    98             read_files cmd (master_directory thy) tok)));
   134             read_files cmd (master_directory thy) tok)));
    99 
   135 
   100 local
   136 fun resolve_files dir span =
   101 
   137   (case span of
   102 fun clean ((i1, t1) :: (i2, t2) :: toks) =
   138     Thy_Syntax.Span (Thy_Syntax.Command cmd, toks) =>
   103       if Token.keyword_with (fn s => s = "%" orelse s = "--") t1 then clean toks
       
   104       else (i1, t1) :: clean ((i2, t2) :: toks)
       
   105   | clean toks = toks;
       
   106 
       
   107 fun clean_tokens toks =
       
   108   ((0 upto length toks - 1) ~~ toks)
       
   109   |> filter (fn (_, tok) => Token.is_proper tok) |> clean;
       
   110 
       
   111 in
       
   112 
       
   113 fun resolve_files dir (span as Thy_Syntax.Span (Thy_Syntax.Command cmd, toks)) =
       
   114       if Keyword.is_theory_load cmd then
   139       if Keyword.is_theory_load cmd then
   115         (case find_first (Token.is_name o #2) (rev (clean_tokens toks)) of
   140         (case find_first (Token.is_name o #2) (rev (clean_tokens toks)) of
   116           NONE => span
   141           NONE => span  (* FIXME error *)
   117         | SOME (i, _) =>
   142         | SOME (i, path) =>
   118             let
   143             let
   119               val toks' = toks |> map_index (fn (j, tok) =>
   144               val toks' = toks |> map_index (fn (j, tok) =>
   120                 if i = j then Token.put_files (read_files cmd dir tok) tok
   145                 if i = j then Token.put_files (read_files cmd dir path) tok
   121                 else tok);
   146                 else tok);
   122             in Thy_Syntax.Span (Thy_Syntax.Command cmd, toks') end)
   147             in Thy_Syntax.Span (Thy_Syntax.Command cmd, toks') end)
   123       else span
   148       else span
   124   | resolve_files _ span = span;
   149   | span => span);
   125 
   150 
   126 end;
   151 end;
   127 
   152 
   128 
   153 
   129 (* check files *)
   154 (* check files *)
   130 
   155 
   131 fun check_file dir file = File.check_file (File.full_path dir file);
   156 fun check_file dir file = File.check_file (File.full_path dir file);
   132 
   157 
   133 val thy_path = Path.ext "thy";
   158 val thy_path = Path.ext "thy";
   134 
   159 
   135 fun check_thy dir name =
   160 fun check_thy base_keywords dir name =
   136   let
   161   let
   137     val path = thy_path (Path.basic name);
   162     val path = thy_path (Path.basic name);
   138     val master_file = check_file dir path;
   163     val master_file = check_file dir path;
   139     val text = File.read master_file;
   164     val text = File.read master_file;
   140     val (name', imports, uses) =
   165     val (name', imports, uses, more_keywords) =
   141       if name = Context.PureN then (Context.PureN, [], [])
   166       if name = Context.PureN then (Context.PureN, [], [], [])
   142       else
   167       else
   143         let val {name, imports, uses, ...} = Thy_Header.read (Path.position master_file) text
   168         let
   144         in (name, imports, uses) end;
   169           val {name, imports, uses, keywords} = Thy_Header.read (Path.position master_file) text;
       
   170           val more_keywords = map (apsnd (Option.map Keyword.spec)) keywords;
       
   171           val syntax =
       
   172             Keyword.get_keywords ()
       
   173             |> fold Keyword.define_keywords base_keywords
       
   174             |> fold Keyword.define_keywords more_keywords;
       
   175           val more_uses = map (rpair false) (find_files syntax text);
       
   176         in (name, imports, uses @ more_uses, more_keywords) end;
   145     val _ = name <> name' andalso
   177     val _ = name <> name' andalso
   146       error ("Bad file name " ^ Path.print path ^ " for theory " ^ quote name');
   178       error ("Bad file name " ^ Path.print path ^ " for theory " ^ quote name');
   147   in {master = (master_file, SHA1.digest text), text = text, imports = imports, uses = uses} end;
   179   in
       
   180    {master = (master_file, SHA1.digest text), text = text,
       
   181     imports = imports, uses = uses, keywords = more_keywords}
       
   182   end;
   148 
   183 
   149 
   184 
   150 (* load files *)
   185 (* load files *)
   151 
   186 
   152 fun load_file thy src_path =
   187 fun load_file thy src_path =