| 32840 |      1 | (*  Title:      Pure/Concurrent/cache.ML
 | 
|  |      2 |     Author:     Makarius
 | 
|  |      3 | 
 | 
|  |      4 | Concurrently cached values, with minimal locking time and singleton
 | 
|  |      5 | evaluation due to lazy storage.
 | 
|  |      6 | *)
 | 
|  |      7 | 
 | 
|  |      8 | signature CACHE =
 | 
|  |      9 | sig
 | 
|  |     10 |   val create: 'table -> ('table -> 'key -> 'value lazy option) ->
 | 
|  |     11 |     ('key * 'value lazy -> 'table -> 'table) -> ('key -> 'value) -> 'key -> 'value
 | 
|  |     12 | end;
 | 
|  |     13 | 
 | 
|  |     14 | structure Cache: CACHE =
 | 
|  |     15 | struct
 | 
|  |     16 | 
 | 
|  |     17 | fun create empty lookup update f =
 | 
|  |     18 |   let
 | 
|  |     19 |     val cache = Synchronized.var "cache" empty;
 | 
|  |     20 |     fun apply x =
 | 
|  |     21 |       Synchronized.change_result cache
 | 
|  |     22 |         (fn tab =>
 | 
|  |     23 |           (case lookup tab x of
 | 
|  |     24 |             SOME y => (y, tab)
 | 
|  |     25 |           | NONE =>
 | 
|  |     26 |               let val y = Lazy.lazy (fn () => f x)
 | 
|  |     27 |               in (y, update (x, y) tab) end))
 | 
|  |     28 |       |> Lazy.force;
 | 
|  |     29 |   in apply end;
 | 
|  |     30 | 
 | 
|  |     31 | end;
 | 
|  |     32 | 
 |