2 people like it.
Like the snippet!
Alternative Async.RunSynchronously
An alternative Async.RunSynchronously implementation that avoids the performance bug as recorded in https://github.com/Microsoft/visualfsharp/issues/581
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
|
open System
open System.Threading
open System.Threading.Tasks
type Async with
static member RunSynchronously2(workflow : Async<'T>, ?timeout : int, ?cancellationToken : CancellationToken) =
let tcs = new TaskCompletionSource<'T>()
match timeout with
| Some 0 -> raise <| new TimeoutException()
| Some t when t < 0 -> invalidArg "timeout" "must be positive."
| Some t -> let timer = new Timer((fun _ -> ignore <| tcs.TrySetException(new TimeoutException())), null, t, Timeout.Infinite) in ()
| None -> ()
let start _ = Async.StartWithContinuations(workflow,
ignore << tcs.TrySetResult,
ignore << tcs.TrySetException,
(fun _ -> ignore <| tcs.TrySetCanceled ()),
?cancellationToken = cancellationToken)
if not <| ThreadPool.QueueUserWorkItem(new WaitCallback(start)) then invalidOp "Could not queue to thread pool."
try tcs.Task.Result
with :? AggregateException as e when e.InnerExceptions.Count = 1 -> raise e.InnerExceptions.[0]
|
namespace System
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.RunSynchronously2 : workflow:Async<'T> * ?timeout:int * ?cancellationToken:CancellationToken -> 'T
Full name: Script.RunSynchronously2
val workflow : Async<'T>
val timeout : 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 cancellationToken : CancellationToken option
Multiple items
type CancellationToken =
struct
new : canceled:bool -> CancellationToken
member CanBeCanceled : bool
member Equals : other:CancellationToken -> bool + 1 overload
member GetHashCode : unit -> int
member IsCancellationRequested : bool
member Register : callback:Action -> CancellationTokenRegistration + 3 overloads
member ThrowIfCancellationRequested : unit -> unit
member WaitHandle : WaitHandle
static member None : CancellationToken
end
Full name: System.Threading.CancellationToken
--------------------
CancellationToken()
CancellationToken(canceled: bool) : unit
val tcs : TaskCompletionSource<'T>
Multiple items
type TaskCompletionSource<'TResult> =
new : unit -> TaskCompletionSource<'TResult> + 3 overloads
member SetCanceled : unit -> unit
member SetException : exception:Exception -> unit + 1 overload
member SetResult : result:'TResult -> unit
member Task : Task<'TResult>
member TrySetCanceled : unit -> bool
member TrySetException : exception:Exception -> bool + 1 overload
member TrySetResult : result:'TResult -> bool
Full name: System.Threading.Tasks.TaskCompletionSource<_>
--------------------
TaskCompletionSource() : unit
TaskCompletionSource(creationOptions: TaskCreationOptions) : unit
TaskCompletionSource(state: obj) : unit
TaskCompletionSource(state: obj, creationOptions: TaskCreationOptions) : unit
union case Option.Some: Value: 'T -> Option<'T>
val raise : exn:Exception -> 'T
Full name: Microsoft.FSharp.Core.Operators.raise
Multiple items
type TimeoutException =
inherit SystemException
new : unit -> TimeoutException + 2 overloads
Full name: System.TimeoutException
--------------------
TimeoutException() : unit
TimeoutException(message: string) : unit
TimeoutException(message: string, innerException: exn) : unit
val t : int
val invalidArg : argumentName:string -> message:string -> 'T
Full name: Microsoft.FSharp.Core.Operators.invalidArg
val timer : 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 ignore : value:'T -> unit
Full name: Microsoft.FSharp.Core.Operators.ignore
TaskCompletionSource.TrySetException(exceptions: Collections.Generic.IEnumerable<exn>) : bool
TaskCompletionSource.TrySetException(exception: exn) : bool
type Timeout =
static val Infinite : int
Full name: System.Threading.Timeout
field Timeout.Infinite = -1
union case Option.None: Option<'T>
val start : ('a -> unit)
static member Async.StartWithContinuations : computation:Async<'T> * continuation:('T -> unit) * exceptionContinuation:(exn -> unit) * cancellationContinuation:(OperationCanceledException -> unit) * ?cancellationToken:CancellationToken -> unit
TaskCompletionSource.TrySetResult(result: 'T) : bool
TaskCompletionSource.TrySetCanceled() : bool
val not : value:bool -> bool
Full name: Microsoft.FSharp.Core.Operators.not
type ThreadPool =
static member BindHandle : osHandle:nativeint -> bool + 1 overload
static member GetAvailableThreads : workerThreads:int * completionPortThreads:int -> unit
static member GetMaxThreads : workerThreads:int * completionPortThreads:int -> unit
static member GetMinThreads : workerThreads:int * completionPortThreads:int -> unit
static member QueueUserWorkItem : callBack:WaitCallback -> bool + 1 overload
static member RegisterWaitForSingleObject : waitObject:WaitHandle * callBack:WaitOrTimerCallback * state:obj * millisecondsTimeOutInterval:uint32 * executeOnlyOnce:bool -> RegisteredWaitHandle + 3 overloads
static member SetMaxThreads : workerThreads:int * completionPortThreads:int -> bool
static member SetMinThreads : workerThreads:int * completionPortThreads:int -> bool
static member UnsafeQueueNativeOverlapped : overlapped:NativeOverlapped -> bool
static member UnsafeQueueUserWorkItem : callBack:WaitCallback * state:obj -> bool
...
Full name: System.Threading.ThreadPool
ThreadPool.QueueUserWorkItem(callBack: WaitCallback) : bool
ThreadPool.QueueUserWorkItem(callBack: WaitCallback, state: obj) : bool
type WaitCallback =
delegate of obj -> unit
Full name: System.Threading.WaitCallback
val invalidOp : message:string -> 'T
Full name: Microsoft.FSharp.Core.Operators.invalidOp
property TaskCompletionSource.Task: Task<'T>
property Task.Result: 'T
Multiple items
type AggregateException =
inherit Exception
new : unit -> AggregateException + 6 overloads
member Flatten : unit -> AggregateException
member GetBaseException : unit -> Exception
member GetObjectData : info:SerializationInfo * context:StreamingContext -> unit
member Handle : predicate:Func<Exception, bool> -> unit
member InnerExceptions : ReadOnlyCollection<Exception>
member ToString : unit -> string
Full name: System.AggregateException
--------------------
AggregateException() : unit
AggregateException(message: string) : unit
AggregateException(innerExceptions: Collections.Generic.IEnumerable<exn>) : unit
AggregateException([<ParamArray>] innerExceptions: exn []) : unit
AggregateException(message: string, innerException: exn) : unit
AggregateException(message: string, innerExceptions: Collections.Generic.IEnumerable<exn>) : unit
AggregateException(message: string, [<ParamArray>] innerExceptions: exn []) : unit
val e : AggregateException
property AggregateException.InnerExceptions: Collections.ObjectModel.ReadOnlyCollection<exn>
property Collections.ObjectModel.ReadOnlyCollection.Count: int
More information