2 people like it.

Async.Sleep with immediate cancellation

Implementation of Async.Sleep in f# 2.0 doesn't allow break it execution until the time elapsed. Here is the alternate implementation which support immediate cancellation. According to discussion http://stackoverflow.com/questions/9041491/is-there-any-reason-why-async-sleep-can-not-be-canceled-immediately .

 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: 
module async_sleep_fix
    open System
    open System.Collections
    open System.Collections.Generic
    open System.Reactive.Concurrency
    open System.Reactive.Disposables
    open System.Threading
    open System.Threading.Tasks

    type Async with
        static member SleepEx(milliseconds:int) = async{
            if milliseconds > 0 then
                let disp = new SerialDisposable()
                use! ch = Async.OnCancel(fun()->disp.Dispose())
                do! Async.FromContinuations(fun (success, error, cancel) ->
                    let timerSubscription = new SerialDisposable()
                    let CompleteWith = 
                        let completed = ref 0
                        fun cont ->
                            if Interlocked.Exchange(completed, 1) = 0 then
                                timerSubscription.Dispose()
                                try cont() with _->()

                    disp.Disposable <- Disposable.Create(fun()->
                        CompleteWith (fun ()-> cancel(new OperationCanceledException()))
                    )
                    let tmr = new Timer(
                        callback = (fun state -> CompleteWith(success)), 
                        state = null, dueTime = milliseconds, period = Timeout.Infinite
                    )
                    if tmr = null then
                        CompleteWith(fun ()->error(new Exception("failed to create timer")))
                    else
                        timerSubscription.Disposable <- Disposable.Create(fun()->
                            try tmr.Dispose() with _ -> ()
                        )
                )
            else
                return ()
        }
module async_sleep_fix
namespace System
namespace System.Collections
namespace System.Collections.Generic
namespace System.Threading
namespace System.Threading.Tasks
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.SleepEx : milliseconds:int -> Async<unit>

Full name: async_sleep_fix.SleepEx
val milliseconds : int
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 async : AsyncBuilder

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.async
val disp : obj
val ch : IDisposable
static member Async.OnCancel : interruption:(unit -> unit) -> Async<IDisposable>
static member Async.FromContinuations : callback:(('T -> unit) * (exn -> unit) * (OperationCanceledException -> unit) -> unit) -> Async<'T>
val success : (unit -> unit)
val error : (exn -> unit)
val cancel : (OperationCanceledException -> unit)
val timerSubscription : obj
val CompleteWith : ((unit -> unit) -> unit)
val completed : int ref
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 cont : (unit -> unit)
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.Exchange<'T (requires reference type)>(location1: byref<'T>, value: 'T) : 'T
Interlocked.Exchange(location1: byref<nativeint>, value: nativeint) : nativeint
Interlocked.Exchange(location1: byref<obj>, value: obj) : obj
Interlocked.Exchange(location1: byref<float>, value: float) : float
Interlocked.Exchange(location1: byref<float32>, value: float32) : float32
Interlocked.Exchange(location1: byref<int64>, value: int64) : int64
Interlocked.Exchange(location1: byref<int>, value: int) : int
Multiple items
type OperationCanceledException =
  inherit SystemException
  new : unit -> OperationCanceledException + 5 overloads
  member CancellationToken : CancellationToken with get, set

Full name: System.OperationCanceledException

--------------------
OperationCanceledException() : unit
OperationCanceledException(message: string) : unit
OperationCanceledException(token: CancellationToken) : unit
OperationCanceledException(message: string, innerException: exn) : unit
OperationCanceledException(message: string, token: CancellationToken) : unit
OperationCanceledException(message: string, innerException: exn, token: CancellationToken) : unit
val tmr : Timer
Multiple items
type Timer =
  inherit MarshalByRefObject
  new : callback:TimerCallback -> Timer + 4 overloads
  member Change : dueTime:int * period:int -> bool + 3 overloads
  member Dispose : unit -> unit + 1 overload

Full name: System.Threading.Timer

--------------------
Timer(callback: TimerCallback) : unit
Timer(callback: TimerCallback, state: obj, dueTime: int, period: int) : unit
Timer(callback: TimerCallback, state: obj, dueTime: TimeSpan, period: TimeSpan) : unit
Timer(callback: TimerCallback, state: obj, dueTime: uint32, period: uint32) : unit
Timer(callback: TimerCallback, state: obj, dueTime: int64, period: int64) : unit
val state : obj
type Timeout =
  static val Infinite : int

Full name: System.Threading.Timeout
field Timeout.Infinite = -1
Multiple items
type Exception =
  new : unit -> Exception + 2 overloads
  member Data : IDictionary
  member GetBaseException : unit -> Exception
  member GetObjectData : info:SerializationInfo * context:StreamingContext -> unit
  member GetType : unit -> Type
  member HelpLink : string with get, set
  member InnerException : Exception
  member Message : string
  member Source : string with get, set
  member StackTrace : string
  ...

Full name: System.Exception

--------------------
Exception() : unit
Exception(message: string) : unit
Exception(message: string, innerException: exn) : unit
Timer.Dispose() : unit
Timer.Dispose(notifyObject: WaitHandle) : bool
Raw view Test code New version

More information

Link:http://fssnip.net/ai
Posted:12 years ago
Author:Andrei Kolomentsev
Tags: async , asynchronous , sleep