src/Pure/Concurrent/cache.ML
author wenzelm
Sat, 24 Mar 2018 20:51:42 +0100
changeset 67945 984c3dc46cc0
parent 66167 1bd268ab885c
permissions -rw-r--r--
tuned output;

(*  Title:      Pure/Concurrent/cache.ML
    Author:     Makarius

Concurrently cached values, with minimal locking time and singleton
evaluation due to lazy storage.
*)

signature CACHE =
sig
  val create: 'table -> ('table -> 'key -> 'value lazy option) ->
    ('key * 'value lazy -> 'table -> 'table) -> ('key -> 'value) -> 'key -> 'value
end;

structure Cache: CACHE =
struct

fun create empty lookup update f =
  let
    val cache = Synchronized.var "cache" empty;
    fun apply x =
      Synchronized.change_result cache
        (fn tab =>
          (case lookup tab x of
            SOME y => (y, tab)
          | NONE =>
              let val y = Lazy.lazy_name "cache" (fn () => f x)
              in (y, update (x, y) tab) end))
      |> Lazy.force;
  in apply end;

end;