0 people like it.

Thread safe caching with expiry

A construct that caches the result of a computation/request up to a given expiration interval. Makes use of the atom implementation found in http://fssnip.net/bw

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 
24: 
25: 
26: 
27: 
28: 
29: 
30: 
31: 
32: 
33: 
34: 
35: 
36: 
37: 
38: 
39: 
40: 
41: 
42: 
43: 
44: 
45: 
46: 
47: 
48: 
49: 
50: 
51: 
52: 

// Atom definition

open System.Threading

type Atom<'T when 'T : not struct> (value : 'T) =
    let cell = ref value
    
    let rec swap f = 
        let currentValue = !cell
        let result = Interlocked.CompareExchange<'T>(cell, f currentValue, currentValue)
        if obj.ReferenceEquals(result, currentValue) then ()
        else Thread.SpinWait 20; swap f

    let transact f =
        let output = ref Unchecked.defaultof<'S>
        let f' x = let t,s = f x in output := s ; t
        swap f' ; !output
        
    member __.Value = !cell
    member __.Swap (f : 'T -> 'T) : unit = swap f
    member __.Transact (f : 'T -> 'T * 'S) : 'S = transact f

// implementation of the caching mechanism

open System

type Cache<'T> (factory : unit -> 'T, ?timeToLive : int) =
    let ttl = defaultArg timeToLive 1000 |> float |> TimeSpan.FromMilliseconds
    let container = Atom<(Choice<'T,exn> * DateTime) option> None

    member __.Value =
        let update () =
            let value = try factory () |> Choice1Of2 with e -> Choice2Of2 e
            Some (value, DateTime.Now), value
        
        let result =
            container.Transact(
                function
                | None -> update ()
                | Some(_, time) when DateTime.Now - time > ttl -> update ()
                | Some(value, _) as state -> state, value)

        match result with
        | Choice1Of2 v -> v
        | Choice2Of2 e -> raise e

// example

let cache = new Cache<_>(fun () -> printfn "computing..."; 42)

for _ in 1 .. 1000000 do
    cache.Value |> ignore
namespace System
namespace System.Threading
Multiple items
type Atom<'T (requires reference type)> =
  new : value:'T -> Atom<'T>
  member Swap : f:('T -> 'T) -> unit
  member Transact : f:('T -> 'T * 'S) -> 'S
  member Value : 'T

Full name: Script.Atom<_>

--------------------
new : value:'T -> Atom<'T>
val not : value:bool -> bool

Full name: Microsoft.FSharp.Core.Operators.not
val value : 'T (requires reference type)
val cell : 'T ref (requires reference type)
Multiple items
val ref : value:'T -> 'T ref

Full name: Microsoft.FSharp.Core.Operators.ref

--------------------
type 'T ref = Ref<'T>

Full name: Microsoft.FSharp.Core.ref<_>
val swap : (('T -> 'T) -> unit) (requires reference type)
val f : ('T -> 'T) (requires reference type)
val currentValue : 'T (requires reference type)
val result : 'T (requires reference type)
type Interlocked =
  static member Add : location1:int * value:int -> int + 1 overload
  static member CompareExchange : location1:int * value:int * comparand:int -> int + 6 overloads
  static member Decrement : location:int -> int + 1 overload
  static member Exchange : location1:int * value:int -> int + 6 overloads
  static member Increment : location:int -> int + 1 overload
  static member Read : location:int64 -> int64

Full name: System.Threading.Interlocked
Interlocked.CompareExchange<'T (requires reference type)>(location1: byref<'T>, value: 'T, comparand: 'T) : 'T
Interlocked.CompareExchange(location1: byref<nativeint>, value: nativeint, comparand: nativeint) : nativeint
Interlocked.CompareExchange(location1: byref<obj>, value: obj, comparand: obj) : obj
Interlocked.CompareExchange(location1: byref<float>, value: float, comparand: float) : float
Interlocked.CompareExchange(location1: byref<float32>, value: float32, comparand: float32) : float32
Interlocked.CompareExchange(location1: byref<int64>, value: int64, comparand: int64) : int64
Interlocked.CompareExchange(location1: byref<int>, value: int, comparand: int) : int
type obj = System.Object

Full name: Microsoft.FSharp.Core.obj
System.Object.ReferenceEquals(objA: obj, objB: obj) : bool
Multiple items
type Thread =
  inherit CriticalFinalizerObject
  new : start:ThreadStart -> Thread + 3 overloads
  member Abort : unit -> unit + 1 overload
  member ApartmentState : ApartmentState with get, set
  member CurrentCulture : CultureInfo with get, set
  member CurrentUICulture : CultureInfo with get, set
  member DisableComObjectEagerCleanup : unit -> unit
  member ExecutionContext : ExecutionContext
  member GetApartmentState : unit -> ApartmentState
  member GetCompressedStack : unit -> CompressedStack
  member GetHashCode : unit -> int
  ...

Full name: System.Threading.Thread

--------------------
Thread(start: ThreadStart) : unit
Thread(start: ParameterizedThreadStart) : unit
Thread(start: ThreadStart, maxStackSize: int) : unit
Thread(start: ParameterizedThreadStart, maxStackSize: int) : unit
Thread.SpinWait(iterations: int) : unit
val transact : (('T -> 'T * 'S) -> 'S) (requires reference type)
val f : ('T -> 'T * 'S) (requires reference type)
val output : 'S ref
module Unchecked

from Microsoft.FSharp.Core.Operators
val defaultof<'T> : 'T

Full name: Microsoft.FSharp.Core.Operators.Unchecked.defaultof
val f' : ('T -> 'T) (requires reference type)
val x : 'T (requires reference type)
val t : 'T (requires reference type)
val s : 'S
member Atom.Value : 'T

Full name: Script.Atom`1.Value
val __ : Atom<'T> (requires reference type)
member Atom.Swap : f:('T -> 'T) -> unit

Full name: Script.Atom`1.Swap
type unit = Unit

Full name: Microsoft.FSharp.Core.unit
member Atom.Transact : f:('T -> 'T * 'S) -> 'S

Full name: Script.Atom`1.Transact
Multiple items
type Cache<'T> =
  new : factory:(unit -> 'T) * ?timeToLive:int -> Cache<'T>
  member Value : 'T

Full name: Script.Cache<_>

--------------------
new : factory:(unit -> 'T) * ?timeToLive:int -> Cache<'T>
val factory : (unit -> 'T)
val timeToLive : int option
Multiple items
val int : value:'T -> int (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.int

--------------------
type int = int32

Full name: Microsoft.FSharp.Core.int

--------------------
type int<'Measure> = int

Full name: Microsoft.FSharp.Core.int<_>
val ttl : TimeSpan
val defaultArg : arg:'T option -> defaultValue:'T -> 'T

Full name: Microsoft.FSharp.Core.Operators.defaultArg
Multiple items
val float : value:'T -> float (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.float

--------------------
type float = Double

Full name: Microsoft.FSharp.Core.float

--------------------
type float<'Measure> = float

Full name: Microsoft.FSharp.Core.float<_>
Multiple items
type TimeSpan =
  struct
    new : ticks:int64 -> TimeSpan + 3 overloads
    member Add : ts:TimeSpan -> TimeSpan
    member CompareTo : value:obj -> int + 1 overload
    member Days : int
    member Duration : unit -> TimeSpan
    member Equals : value:obj -> bool + 1 overload
    member GetHashCode : unit -> int
    member Hours : int
    member Milliseconds : int
    member Minutes : int
    ...
  end

Full name: System.TimeSpan

--------------------
TimeSpan()
TimeSpan(ticks: int64) : unit
TimeSpan(hours: int, minutes: int, seconds: int) : unit
TimeSpan(days: int, hours: int, minutes: int, seconds: int) : unit
TimeSpan(days: int, hours: int, minutes: int, seconds: int, milliseconds: int) : unit
TimeSpan.FromMilliseconds(value: float) : TimeSpan
val container : Atom<(Choice<'T,exn> * DateTime) option>
Multiple items
type Choice<'T1,'T2> =
  | Choice1Of2 of 'T1
  | Choice2Of2 of 'T2

Full name: Microsoft.FSharp.Core.Choice<_,_>

--------------------
type Choice<'T1,'T2,'T3> =
  | Choice1Of3 of 'T1
  | Choice2Of3 of 'T2
  | Choice3Of3 of 'T3

Full name: Microsoft.FSharp.Core.Choice<_,_,_>

--------------------
type Choice<'T1,'T2,'T3,'T4> =
  | Choice1Of4 of 'T1
  | Choice2Of4 of 'T2
  | Choice3Of4 of 'T3
  | Choice4Of4 of 'T4

Full name: Microsoft.FSharp.Core.Choice<_,_,_,_>

--------------------
type Choice<'T1,'T2,'T3,'T4,'T5> =
  | Choice1Of5 of 'T1
  | Choice2Of5 of 'T2
  | Choice3Of5 of 'T3
  | Choice4Of5 of 'T4
  | Choice5Of5 of 'T5

Full name: Microsoft.FSharp.Core.Choice<_,_,_,_,_>

--------------------
type Choice<'T1,'T2,'T3,'T4,'T5,'T6> =
  | Choice1Of6 of 'T1
  | Choice2Of6 of 'T2
  | Choice3Of6 of 'T3
  | Choice4Of6 of 'T4
  | Choice5Of6 of 'T5
  | Choice6Of6 of 'T6

Full name: Microsoft.FSharp.Core.Choice<_,_,_,_,_,_>

--------------------
type Choice<'T1,'T2,'T3,'T4,'T5,'T6,'T7> =
  | Choice1Of7 of 'T1
  | Choice2Of7 of 'T2
  | Choice3Of7 of 'T3
  | Choice4Of7 of 'T4
  | Choice5Of7 of 'T5
  | Choice6Of7 of 'T6
  | Choice7Of7 of 'T7

Full name: Microsoft.FSharp.Core.Choice<_,_,_,_,_,_,_>
type exn = Exception

Full name: Microsoft.FSharp.Core.exn
Multiple items
type DateTime =
  struct
    new : ticks:int64 -> DateTime + 10 overloads
    member Add : value:TimeSpan -> DateTime
    member AddDays : value:float -> DateTime
    member AddHours : value:float -> DateTime
    member AddMilliseconds : value:float -> DateTime
    member AddMinutes : value:float -> DateTime
    member AddMonths : months:int -> DateTime
    member AddSeconds : value:float -> DateTime
    member AddTicks : value:int64 -> DateTime
    member AddYears : value:int -> DateTime
    ...
  end

Full name: System.DateTime

--------------------
DateTime()
   (+0 other overloads)
DateTime(ticks: int64) : unit
   (+0 other overloads)
DateTime(ticks: int64, kind: DateTimeKind) : unit
   (+0 other overloads)
DateTime(year: int, month: int, day: int) : unit
   (+0 other overloads)
DateTime(year: int, month: int, day: int, calendar: Globalization.Calendar) : unit
   (+0 other overloads)
DateTime(year: int, month: int, day: int, hour: int, minute: int, second: int) : unit
   (+0 other overloads)
DateTime(year: int, month: int, day: int, hour: int, minute: int, second: int, kind: DateTimeKind) : unit
   (+0 other overloads)
DateTime(year: int, month: int, day: int, hour: int, minute: int, second: int, calendar: Globalization.Calendar) : unit
   (+0 other overloads)
DateTime(year: int, month: int, day: int, hour: int, minute: int, second: int, millisecond: int) : unit
   (+0 other overloads)
DateTime(year: int, month: int, day: int, hour: int, minute: int, second: int, millisecond: int, kind: DateTimeKind) : unit
   (+0 other overloads)
type 'T option = Option<'T>

Full name: Microsoft.FSharp.Core.option<_>
union case Option.None: Option<'T>
member Cache.Value : 'T

Full name: Script.Cache`1.Value
val update : (unit -> (Choice<'T,exn> * DateTime) option * Choice<'T,exn>)
val value : Choice<'T,exn>
union case Choice.Choice1Of2: 'T1 -> Choice<'T1,'T2>
val e : exn
union case Choice.Choice2Of2: 'T2 -> Choice<'T1,'T2>
union case Option.Some: Value: 'T -> Option<'T>
property DateTime.Now: DateTime
val result : Choice<'T,exn>
member Atom.Transact : f:('T -> 'T * 'S) -> 'S
val time : DateTime
val state : (Choice<'T,exn> * DateTime) option
val v : 'T
val raise : exn:Exception -> 'T

Full name: Microsoft.FSharp.Core.Operators.raise
val cache : Cache<int>

Full name: Script.cache
val printfn : format:Printf.TextWriterFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.printfn
property Cache.Value: int
val ignore : value:'T -> unit

Full name: Microsoft.FSharp.Core.Operators.ignore
Raw view Test code New version

More information

Link:http://fssnip.net/gA
Posted:11 years ago
Author:Eirik Tsarpalis
Tags: atomic , caching

This web site is created using F# and Suave web server. It is hosted on Azure and the source code is on GitHub. Contributions are welcome!

The first version of fssnip.net has been created by @tomaspetricek back in 2010. This web site is a new, open-source and contribution-friendly version.