src/Tools/cache_io.ML
changeset 50317 4d1590544b91
parent 50316 7bdc53fb7282
child 59058 a78612c67ec0
equal deleted inserted replaced
50316:7bdc53fb7282 50317:4d1590544b91
    14   val raw_run: (Path.T -> Path.T -> string) -> string -> Path.T -> Path.T -> result
    14   val raw_run: (Path.T -> Path.T -> string) -> string -> Path.T -> Path.T -> result
    15   val run: (Path.T -> Path.T -> string) -> string -> result
    15   val run: (Path.T -> Path.T -> string) -> string -> result
    16 
    16 
    17   (*cache*)
    17   (*cache*)
    18   type cache
    18   type cache
    19   val make: Path.T -> cache
    19   val unsynchronized_init: Path.T -> cache
    20   val cache_path_of: cache -> Path.T
    20   val cache_path_of: cache -> Path.T
    21   val lookup: cache -> string -> result option * string
    21   val lookup: cache -> string -> result option * string
    22   val run_and_cache: cache -> string -> (Path.T -> Path.T -> string) -> string -> result
    22   val run_and_cache: cache -> string -> (Path.T -> Path.T -> string) -> string -> result
    23   val run_cached: cache -> (Path.T -> Path.T -> string) -> string -> result
    23   val run_cached: cache -> (Path.T -> Path.T -> string) -> string -> result
    24 end
    24 end
    55   table: (int * (int * int * int) Symtab.table) Synchronized.var }
    55   table: (int * (int * int * int) Symtab.table) Synchronized.var }
    56 with
    56 with
    57 
    57 
    58 fun cache_path_of (Cache {path, ...}) = path
    58 fun cache_path_of (Cache {path, ...}) = path
    59 
    59 
    60 fun make cache_path =
    60 fun unsynchronized_init cache_path =
    61   let
    61   let
    62     val table =
    62     val table =
    63       if File.exists cache_path then
    63       if File.exists cache_path then
    64         let
    64         let
    65           fun err () = error ("Cache IO: corrupted cache file: " ^ File.shell_path cache_path)
    65           fun err () = error ("Cache IO: corrupted cache file: " ^ File.shell_path cache_path)
    82             else ((i+1, l), tab)
    82             else ((i+1, l), tab)
    83         in apfst fst (File.fold_lines parse cache_path ((1, 1), Symtab.empty)) end
    83         in apfst fst (File.fold_lines parse cache_path ((1, 1), Symtab.empty)) end
    84       else (1, Symtab.empty)
    84       else (1, Symtab.empty)
    85   in Cache {path = cache_path, table = Synchronized.var "Cache_IO" table} end
    85   in Cache {path = cache_path, table = Synchronized.var "Cache_IO" table} end
    86 
    86 
    87 fun load_cached_result cache_path (p, len1, len2) =
       
    88   let
       
    89     fun load line (i, xsp) =
       
    90       if i < p then (i+1, xsp)
       
    91       else if i < p + len1 then (i+1, apfst (cons line) xsp)
       
    92       else if i < p + len2 then (i+1, apsnd (cons line) xsp)
       
    93       else (i, xsp)
       
    94     val (out, err) =
       
    95       pairself rev (snd (File.fold_lines load cache_path (1, ([], []))))
       
    96   in {output = err, redirected_output = out, return_code = 0} end
       
    97 
       
    98 fun lookup (Cache {path = cache_path, table}) str =
    87 fun lookup (Cache {path = cache_path, table}) str =
    99   let val key = SHA1.rep (SHA1.digest str)
    88   let val key = SHA1.rep (SHA1.digest str)
   100   in
    89   in
   101     (case Symtab.lookup (snd (Synchronized.value table)) key of
    90     Synchronized.change_result table (fn tab =>
   102       NONE => (NONE, key)
    91       (case Symtab.lookup (snd tab) key of
   103     | SOME pos => (SOME (load_cached_result cache_path pos), key))
    92         NONE => ((NONE, key), tab)
       
    93       | SOME (p, len1, len2) =>
       
    94           let
       
    95             fun load line (i, xsp) =
       
    96               if i < p then (i+1, xsp)
       
    97               else if i < p + len1 then (i+1, apfst (cons line) xsp)
       
    98               else if i < p + len2 then (i+1, apsnd (cons line) xsp)
       
    99               else (i, xsp)
       
   100             val (out, err) =
       
   101               pairself rev (snd (File.fold_lines load cache_path (1, ([], []))))
       
   102           in ((SOME {output = err, redirected_output = out, return_code = 0}, key), tab) end))
   104   end
   103   end
   105 
   104 
   106 fun run_and_cache (Cache {path = cache_path, table}) key make_cmd str =
   105 fun run_and_cache (Cache {path = cache_path, table}) key make_cmd str =
   107   let
   106   let
   108     val {output = err, redirected_output=out, return_code} = run make_cmd str
   107     val {output = err, redirected_output=out, return_code} = run make_cmd str