A Clojure inspired (race free) memoize function

A Clojure inspired (race free) memoize function, that uses a mutable atom cell.

 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:

// Info: http://clojure.org/atoms

open System
open System.Threading

type Atom<'T when 'T : not struct>(value : 'T) =
    let refCell = ref value
    
    let rec swap f = 
        let currentValue = !refCell
        let result = Interlocked.CompareExchange<'T>(refCell, f currentValue, currentValue)
        if obj.ReferenceEquals(result, currentValue) then ()
        else Thread.SpinWait 20; swap f
        
    member self.Value with get() : 'T = !refCell
    member self.Swap (f : 'T -> 'T) : unit = swap f

module Atom =

    let atom value = new Atom<_>(value)
        
    let (!) (atom : Atom<_>) = atom.Value
    
    let swap (atom : Atom<_>) (f : _ -> _) = atom.Swap f

    let (|AtomCell|) (atomCell : Atom<'T>) = !atomCell


open Atom

let memoize f =
    let cacheAtom = atom Map.empty
    fun x ->
        match (!cacheAtom).TryFind(x) with
        | Some res -> res
        | None ->
             let res = f x
             swap cacheAtom (fun cache -> cache.Add(x,res))
             res


let rec fibonacci =  
  memoize(fun n -> if n <= 2 then 1 else fibonacci(n - 1) + fibonacci(n - 2))

fibonacci 20

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 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 refCell : '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 = Object

Full name: Microsoft.FSharp.Core.obj

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 self : Atom<'T> (requires reference type)

member Atom.Value : 'T

Full name: Script.Atom`1.Value

member Atom.Swap : f:('T -> 'T) -> unit

Full name: Script.Atom`1.Swap

type unit = Unit

Full name: Microsoft.FSharp.Core.unit

val atom : value:'a -> Atom<'a> (requires reference type)

Full name: Script.Atom.atom

val value : 'a (requires reference type)

val atom : Atom<'a> (requires reference type)

property Atom.Value: 'a

val swap : atom:Atom<'a> -> f:('a -> 'a) -> unit (requires reference type)

Full name: Script.Atom.swap

val f : ('a -> 'a) (requires reference type)

member Atom.Swap : f:('T -> 'T) -> unit

val atomCell : Atom<'T> (requires reference type)

Multiple items
module Atom

from Script

--------------------
type Atom<'T (requires reference type)> =
  new : value:'T -> Atom<'T>
  member Swap : f:('T -> 'T) -> unit
  member Value : 'T

Full name: Script.Atom<_>

--------------------
new : value:'T -> Atom<'T>

val memoize : f:('a -> 'b) -> ('a -> 'b) (requires comparison)

Full name: Script.memoize

val f : ('a -> 'b) (requires comparison)

val cacheAtom : Atom<Map<'a,'b>> (requires comparison)

Multiple items
module Map

from Microsoft.FSharp.Collections

--------------------
type Map<'Key,'Value (requires comparison)> =
  interface IEnumerable
  interface IComparable
  interface IEnumerable<KeyValuePair<'Key,'Value>>
  interface ICollection<KeyValuePair<'Key,'Value>>
  interface IDictionary<'Key,'Value>
  new : elements:seq<'Key * 'Value> -> Map<'Key,'Value>
  member Add : key:'Key * value:'Value -> Map<'Key,'Value>
  member ContainsKey : key:'Key -> bool
  override Equals : obj -> bool
  member Remove : key:'Key -> Map<'Key,'Value>
  ...

Full name: Microsoft.FSharp.Collections.Map<_,_>

--------------------
new : elements:seq<'Key * 'Value> -> Map<'Key,'Value>

val empty<'Key,'T (requires comparison)> : Map<'Key,'T> (requires comparison)

Full name: Microsoft.FSharp.Collections.Map.empty

val x : 'a (requires comparison)

union case Option.Some: Value: 'T -> Option<'T>

val res : 'b

union case Option.None: Option<'T>

val cache : Map<'a,'b> (requires comparison)

member Map.Add : key:'Key * value:'Value -> Map<'Key,'Value>

val fibonacci : (int -> int)

Full name: Script.fibonacci

val n : int

Raw view Test code New version

More information

Link:	http://fssnip.net/2r
Posted:	13 years ago
Author:	Nick Palladinos
Tags:	memoize , clojure , atom