28 people like it.

Clojure's Atoms

Clojure's Atoms are ref like structures, with the addition of (Compare And Swap) update semantics

 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: 
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 result
        else Thread.SpinWait 20; swap f
        
    member self.Value with get() = !refCell
    member self.Swap (f : 'T -> 'T) = swap f
        
    

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

// example

let counter = atom (fun () -> 0)

let listOfIncrementAsync = 
  [ for _ in [1..1000000] do
      yield async { 
             swap counter (fun f -> (fun result () -> result + 1) <| f()) |> ignore
      } ]

listOfIncrementAsync |> Async.Parallel |> Async.RunSynchronously

let value = (!counter)() // returns 1000000

printfn "%d" value
namespace System
namespace System.Threading
Multiple items
type Atom<'T (requires reference type)> =
  new : value:'T -> Atom<'T>
  member Swap : f:('T -> 'T) -> 'T
  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) -> 'T) (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 self : Atom<'T> (requires reference type)
member Atom.Value : 'T

Full name: Script.Atom`1.Value
member Atom.Swap : f:('T -> 'T) -> 'T

Full name: Script.Atom`1.Swap
val atom : value:'a -> Atom<'a> (requires reference type)

Full name: Script.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) -> 'a (requires reference type)

Full name: Script.swap
val f : ('a -> 'a) (requires reference type)
member Atom.Swap : f:('T -> 'T) -> 'T
val counter : Atom<(unit -> int)>

Full name: Script.counter
val listOfIncrementAsync : Async<unit> list

Full name: Script.listOfIncrementAsync
val async : AsyncBuilder

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.async
val f : (unit -> int)
val result : int
val ignore : value:'T -> unit

Full name: Microsoft.FSharp.Core.Operators.ignore
Multiple items
type Async
static member AsBeginEnd : computation:('Arg -> Async<'T>) -> ('Arg * AsyncCallback * obj -> IAsyncResult) * (IAsyncResult -> 'T) * (IAsyncResult -> unit)
static member AwaitEvent : event:IEvent<'Del,'T> * ?cancelAction:(unit -> unit) -> Async<'T> (requires delegate and 'Del :> Delegate)
static member AwaitIAsyncResult : iar:IAsyncResult * ?millisecondsTimeout:int -> Async<bool>
static member AwaitTask : task:Task<'T> -> Async<'T>
static member AwaitWaitHandle : waitHandle:WaitHandle * ?millisecondsTimeout:int -> Async<bool>
static member CancelDefaultToken : unit -> unit
static member Catch : computation:Async<'T> -> Async<Choice<'T,exn>>
static member FromBeginEnd : beginAction:(AsyncCallback * obj -> IAsyncResult) * endAction:(IAsyncResult -> 'T) * ?cancelAction:(unit -> unit) -> Async<'T>
static member FromBeginEnd : arg:'Arg1 * beginAction:('Arg1 * AsyncCallback * obj -> IAsyncResult) * endAction:(IAsyncResult -> 'T) * ?cancelAction:(unit -> unit) -> Async<'T>
static member FromBeginEnd : arg1:'Arg1 * arg2:'Arg2 * beginAction:('Arg1 * 'Arg2 * AsyncCallback * obj -> IAsyncResult) * endAction:(IAsyncResult -> 'T) * ?cancelAction:(unit -> unit) -> Async<'T>
static member FromBeginEnd : arg1:'Arg1 * arg2:'Arg2 * arg3:'Arg3 * beginAction:('Arg1 * 'Arg2 * 'Arg3 * AsyncCallback * obj -> IAsyncResult) * endAction:(IAsyncResult -> 'T) * ?cancelAction:(unit -> unit) -> Async<'T>
static member FromContinuations : callback:(('T -> unit) * (exn -> unit) * (OperationCanceledException -> unit) -> unit) -> Async<'T>
static member Ignore : computation:Async<'T> -> Async<unit>
static member OnCancel : interruption:(unit -> unit) -> Async<IDisposable>
static member Parallel : computations:seq<Async<'T>> -> Async<'T []>
static member RunSynchronously : computation:Async<'T> * ?timeout:int * ?cancellationToken:CancellationToken -> 'T
static member Sleep : millisecondsDueTime:int -> Async<unit>
static member Start : computation:Async<unit> * ?cancellationToken:CancellationToken -> unit
static member StartAsTask : computation:Async<'T> * ?taskCreationOptions:TaskCreationOptions * ?cancellationToken:CancellationToken -> Task<'T>
static member StartChild : computation:Async<'T> * ?millisecondsTimeout:int -> Async<Async<'T>>
static member StartChildAsTask : computation:Async<'T> * ?taskCreationOptions:TaskCreationOptions -> Async<Task<'T>>
static member StartImmediate : computation:Async<unit> * ?cancellationToken:CancellationToken -> unit
static member StartWithContinuations : computation:Async<'T> * continuation:('T -> unit) * exceptionContinuation:(exn -> unit) * cancellationContinuation:(OperationCanceledException -> unit) * ?cancellationToken:CancellationToken -> unit
static member SwitchToContext : syncContext:SynchronizationContext -> Async<unit>
static member SwitchToNewThread : unit -> Async<unit>
static member SwitchToThreadPool : unit -> Async<unit>
static member TryCancelled : computation:Async<'T> * compensation:(OperationCanceledException -> unit) -> Async<'T>
static member CancellationToken : Async<CancellationToken>
static member DefaultCancellationToken : CancellationToken

Full name: Microsoft.FSharp.Control.Async

--------------------
type Async<'T>

Full name: Microsoft.FSharp.Control.Async<_>
static member Async.Parallel : computations:seq<Async<'T>> -> Async<'T []>
static member Async.RunSynchronously : computation:Async<'T> * ?timeout:int * ?cancellationToken:CancellationToken -> 'T
val value : int

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

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.printfn

More information

Link:http://fssnip.net/1V
Posted:13 years ago
Author:Nick Palladinos
Tags: clojure , atom , concurrency