From 9be59699cde137f6c20accde39fd741444ba3078 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Tue, 30 Jan 2018 17:12:16 -0500 Subject: [PATCH 01/39] very early prototype --- src/fsharp/FSharp.Core/control.fs | 324 ++++++++++++++++------------- src/fsharp/FSharp.Core/control.fsi | 29 ++- 2 files changed, 199 insertions(+), 154 deletions(-) diff --git a/src/fsharp/FSharp.Core/control.fs b/src/fsharp/FSharp.Core/control.fs index a614813e4ba..ad23c378be9 100644 --- a/src/fsharp/FSharp.Core/control.fs +++ b/src/fsharp/FSharp.Core/control.fs @@ -120,14 +120,7 @@ namespace Microsoft.FSharp.Control static let unfake FakeUnit = () // Install a trampolineStack if none exists - member this.ExecuteAction (firstAction : unit -> FakeUnitValue) = - let rec loop action = - action() |> unfake - match cont with - | None -> () - | Some newAction -> - cont <- None - loop newAction + member this.ExecuteAsyncAction (firstAction : unit -> FakeUnitValue) = let thisIsTopTrampoline = if Trampoline.thisThreadHasTrampoline then false @@ -135,7 +128,16 @@ namespace Microsoft.FSharp.Control Trampoline.thisThreadHasTrampoline <- true true try - loop firstAction + let mutable keepGoing = true + let mutable action = firstAction + while keepGoing do + action() |> unfake + match cont with + | None -> + keepGoing <- false + | Some newAction -> + cont <- None + action <- newAction finally if thisIsTopTrampoline then Trampoline.thisThreadHasTrampoline <- false @@ -148,10 +150,10 @@ namespace Microsoft.FSharp.Control member this.Set action = match cont with - | None -> - bindCount <- 0 - cont <- Some action - | _ -> failwith "Internal error: attempting to install continuation twice" + | None -> + bindCount <- 0 + cont <- Some action + | _ -> failwith "Internal error: attempting to install continuation twice" #if FSCORE_PORTABLE_NEW @@ -191,7 +193,7 @@ namespace Microsoft.FSharp.Control let sendOrPostCallback = SendOrPostCallback(fun o -> let f = unbox o : unit -> FakeUnitValue - this.Protect f |> unfake + this.ExecuteAsyncAction f |> unfake ) // Preallocate the delegate @@ -199,7 +201,7 @@ namespace Microsoft.FSharp.Control let waitCallbackForQueueWorkItemWithTrampoline = WaitCallback(fun o -> let f = unbox o : unit -> FakeUnitValue - this.Protect f |> unfake + this.ExecuteAsyncAction f |> unfake ) #if !FX_NO_PARAMETERIZED_THREAD_START @@ -207,7 +209,7 @@ namespace Microsoft.FSharp.Control let threadStartCallbackForStartThreadWithTrampoline = ParameterizedThreadStart(fun o -> let f = unbox o : unit -> FakeUnitValue - this.Protect f |> unfake + this.ExecuteAsyncAction f |> unfake ) #endif @@ -226,7 +228,7 @@ namespace Microsoft.FSharp.Control #if FX_NO_THREAD this.QueueWorkItem(f) #else - (new Thread((fun _ -> this.Protect f |> unfake), IsBackground=true)).Start() + (new Thread((fun _ -> this.ExecuteAsyncAction f |> unfake), IsBackground=true)).Start() FakeUnit #endif @@ -237,18 +239,26 @@ namespace Microsoft.FSharp.Control FakeUnit #endif - member this.Protect firstAction = + member this.ExecuteAsyncAction firstAction = trampoline <- new Trampoline() - trampoline.ExecuteAction(firstAction) + trampoline.ExecuteAsyncAction firstAction member this.Trampoline = trampoline + + member inline this.HijackCheck (res, cont : 'T -> FakeUnitValue) : FakeUnitValue = + if trampoline.IncrementBindCount() then + trampoline.Set(fun () -> cont res) + FakeUnit + else + // NOTE: this must be a tailcall + cont res [] [] type AsyncParamsAux = - { token : CancellationToken; - econt : econt; - ccont : ccont; + { token : CancellationToken + econt : econt + ccont : ccont trampolineHolder : TrampolineHolder } @@ -258,13 +268,23 @@ namespace Microsoft.FSharp.Control { cont : cont<'T> aux : AsyncParamsAux } + + member args.IsCancellationRequested = args.aux.token.IsCancellationRequested + + member args.CallSuccessContinuation res = + args.aux.trampolineHolder.HijackCheck (res, args.cont) + + // Call the cancellation continuation + member args.CallCancellationContinuation() = + args.aux.ccont (new OperationCanceledException(args.aux.token)) + [] [] type Async<'T> = P of (AsyncParams<'T> -> FakeUnitValue) - module AsyncBuilderImpl = + module AsyncActions = // To consider: augment with more exception traceability information // To consider: add the ability to suspend running ps in debug mode // To consider: add the ability to trace running ps in debug mode @@ -286,13 +306,6 @@ namespace Microsoft.FSharp.Control | Error of ExceptionDispatchInfo | Canceled of OperationCanceledException - let inline hijack (trampolineHolder:TrampolineHolder) res (cont : 'T -> FakeUnitValue) : FakeUnitValue = - if trampolineHolder.Trampoline.IncrementBindCount() then - trampolineHolder.Trampoline.Set(fun () -> cont res) - FakeUnit - else - // NOTE: this must be a tailcall - cont res /// Global mutable state used to associate Exception let associationTable = System.Runtime.CompilerServices.ConditionalWeakTable() @@ -330,10 +343,10 @@ namespace Microsoft.FSharp.Control match edi with | null -> // NOTE: this must be a tailcall - hijack trampolineHolder res cont + trampolineHolder.HijackCheck (res, cont) | _ -> // NOTE: this must be a tailcall - hijack trampolineHolder edi econt + trampolineHolder.HijackCheck (edi, econt) // Apply f to x and call either the continuation or exception continuation depending what happens let inline protectNoHijack econt f x (cont : 'T -> FakeUnitValue) : FakeUnitValue = @@ -396,7 +409,7 @@ namespace Microsoft.FSharp.Control let waitCallbackForQueueWorkItemWithTrampoline(trampolineHolder : TrampolineHolder) = WaitCallback(fun o -> let f = unbox o : unit -> FakeUnitValue - trampolineHolder.Protect f |> unfake + trampolineHolder.ExecuteAsyncAction f |> unfake ) let startThreadWithTrampoline (trampolineHolder:TrampolineHolder) (f : unit -> FakeUnitValue) = @@ -405,7 +418,7 @@ namespace Microsoft.FSharp.Control failwith "failed to queue user work item" FakeUnit #else - (new Thread((fun _ -> trampolineHolder.Protect f |> unfake), IsBackground=true)).Start() + (new Thread((fun _ -> trampolineHolder.ExecuteAsyncAction f |> unfake), IsBackground=true)).Start() FakeUnit #endif @@ -415,7 +428,7 @@ namespace Microsoft.FSharp.Control let threadStartCallbackForStartThreadWithTrampoline = ParameterizedThreadStart(fun o -> let (trampolineHolder,f) = unbox o : TrampolineHolder * (unit -> FakeUnitValue) - trampolineHolder.Protect f |> unfake + trampolineHolder.ExecuteAsyncAction f |> unfake ) // This should be the only call to Thread.Start in this library. We must always install a trampoline. @@ -427,7 +440,7 @@ namespace Microsoft.FSharp.Control let startAsync cancellationToken cont econt ccont p = let trampolineHolder = new TrampolineHolder() - trampolineHolder.Protect (fun () -> startA cancellationToken trampolineHolder cont econt ccont p) + trampolineHolder.ExecuteAsyncAction (fun () -> startA cancellationToken trampolineHolder cont econt ccont p) let queueAsync cancellationToken cont econt ccont p = let trampolineHolder = new TrampolineHolder() @@ -448,18 +461,15 @@ namespace Microsoft.FSharp.Control let errorT args edi = args.aux.econt edi - // Call the cancellation continuation - let cancelT (args:AsyncParams<_>) = - args.aux.ccont (new OperationCanceledException(args.aux.token)) - + // Build a primitive without any exception of resync protection // // Use carefully!! - let unprotectedPrimitive f = P f + let MakeAsync f = P f - let protectedPrimitiveCore args f = - if args.aux.token.IsCancellationRequested then - cancelT args + let protectedPrimitiveCore (args: AsyncParams<_>) f = + if args.IsCancellationRequested then + args.CallCancellationContinuation () else try f args @@ -471,10 +481,10 @@ namespace Microsoft.FSharp.Control // sent to the exception continuation. // let protectedPrimitive f = - unprotectedPrimitive (fun args -> protectedPrimitiveCore args f) + MakeAsync (fun args -> protectedPrimitiveCore args f) let reify res = - unprotectedPrimitive (fun args -> + MakeAsync (fun args -> match res with | AsyncImplResult.Ok r -> args.cont r | AsyncImplResult.Error e -> args.aux.econt e @@ -484,59 +494,70 @@ namespace Microsoft.FSharp.Control // BUILDER OPERATIONS // Generate async computation which calls its continuation with the given result - let resultA x = - unprotectedPrimitive (fun ({ aux = aux } as args) -> - if aux.token.IsCancellationRequested then - cancelT args + let inline resultA res = + MakeAsync (fun args -> + if args.IsCancellationRequested then + args.CallCancellationContinuation () else - hijack aux.trampolineHolder x args.cont) + args.CallSuccessContinuation res) - + [] + let BindUserCode keepStack args p1 f = + System.Console.WriteLine "BindUserCode" + let args = + let cont a = protectNoHijack args.aux.econt f a (fun p2 -> invokeA p2 args) + { cont=cont; aux = args.aux } + // Trampoline the continuation onto a new work item every so often + let trampoline = args.aux.trampolineHolder.Trampoline + if trampoline.IncrementBindCount() then + System.Console.WriteLine "trampoiline" + trampoline.Set(fun () -> invokeA p1 args) + FakeUnit + else + if keepStack then + // NOTE: this must be a tailcall + System.Console.WriteLine "keeping stack" + let res = invokeA p1 args + trampoline.IncrementBindCount() |> ignore + System.Console.WriteLine "returning stack" + res + else + invokeA p1 args // The primitive bind operation. Generate a process that runs the first process, takes // its result, applies f and then runs the new process produced. Hijack if necessary and // run 'f' with exception protection - let bindA p1 f = - unprotectedPrimitive (fun args -> - if args.aux.token.IsCancellationRequested then - cancelT args + let inline bindA keepStack p f = + MakeAsync (fun args -> + if args.IsCancellationRequested then + args.CallCancellationContinuation () else + BindUserCode keepStack args p f) - let args = - let cont a = protectNoHijack args.aux.econt f a (fun p2 -> invokeA p2 args) - { cont=cont; - aux = args.aux - } - // Trampoline the continuation onto a new work item every so often - let trampoline = args.aux.trampolineHolder.Trampoline - if trampoline.IncrementBindCount() then - trampoline.Set(fun () -> invokeA p1 args) - FakeUnit - else - // NOTE: this must be a tailcall - invokeA p1 args) - + [] + let ExecuteUserCode (args: AsyncParams<'T>) (f: 'U -> Async<'T>) x = + protect args.aux.trampolineHolder args.aux.econt f x (fun p2 -> invokeA p2 args) // callA = "bindA (return x) f" - let callA f x = - unprotectedPrimitive (fun args -> - if args.aux.token.IsCancellationRequested then - cancelT args + let inline callA f x = + MakeAsync (fun args -> + if args.IsCancellationRequested then + args.CallCancellationContinuation () else - protect args.aux.trampolineHolder args.aux.econt f x (fun p2 -> invokeA p2 args) + ExecuteUserCode args f x ) // delayPrim = "bindA (return ()) f" - let delayA f = callA f () + let inline delayA f = callA f () // Call p but augment the normal, exception and cancel continuations with a call to finallyFunction. // If the finallyFunction raises an exception then call the original exception continuation // with the new exception. If exception is raised after a cancellation, exception is ignored // and cancel continuation is called. let tryFinallyA finallyFunction p = - unprotectedPrimitive (fun args -> - if args.aux.token.IsCancellationRequested then - cancelT args + MakeAsync (fun args -> + if args.IsCancellationRequested then + args.CallCancellationContinuation () else let trampolineHolder = args.aux.trampolineHolder // The new continuation runs the finallyFunction and resumes the old continuation @@ -553,9 +574,9 @@ namespace Microsoft.FSharp.Control // Re-route the exception continuation to call to catchFunction. If catchFunction or the new process fail // then call the original exception continuation with the failure. let tryWithDispatchInfoA catchFunction p = - unprotectedPrimitive (fun args -> - if args.aux.token.IsCancellationRequested then - cancelT args + MakeAsync (fun args -> + if args.IsCancellationRequested then + args.CallCancellationContinuation () else let econt (edi: ExceptionDispatchInfo) = invokeA (callA catchFunction edi) args invokeA p { args with aux = { args.aux with econt = econt } }) @@ -565,18 +586,15 @@ namespace Microsoft.FSharp.Control /// Call the finallyFunction if the computation results in a cancellation let whenCancelledA (finallyFunction : OperationCanceledException -> unit) p = - unprotectedPrimitive (fun ({ aux = aux } as args)-> + MakeAsync (fun ({ aux = aux } as args)-> let ccont exn = protect aux.trampolineHolder (fun _ -> aux.ccont exn) finallyFunction exn (fun _ -> aux.ccont exn) invokeA p { args with aux = { aux with ccont = ccont } }) - let getCancellationToken() = - unprotectedPrimitive (fun ({ aux = aux } as args) -> args.cont aux.token) + let CancellationTokenAsync = + MakeAsync (fun ({ aux = aux } as args) -> args.cont aux.token) - let getTrampolineHolder() = - unprotectedPrimitive (fun ({ aux = aux } as args) -> args.cont aux.trampolineHolder) - /// Return a unit result - let doneA = + let UnitAsync = resultA() /// Implement use/Dispose @@ -587,15 +605,15 @@ namespace Microsoft.FSharp.Control Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicFunctions.Dispose r tryFinallyA disposeFunction (callA f r) |> whenCancelledA disposeFunction - let ignoreA p = - bindA p (fun _ -> doneA) + let inline ignoreA p = + bindA false p (fun _ -> UnitAsync) /// Implement the while loop let rec whileA gd prog = if gd() then - bindA prog (fun () -> whileA gd prog) + bindA false prog (fun () -> whileA gd prog) else - doneA + UnitAsync /// Implement the for loop let rec forA (e: seq<_>) prog = @@ -605,26 +623,36 @@ namespace Microsoft.FSharp.Control (delayA(fun () -> prog ie.Current))) - let sequentialA p1 p2 = - bindA p1 (fun () -> p2) + let inline sequentialA p1 p2 = + bindA false p1 (fun () -> p2) - open AsyncBuilderImpl + open AsyncActions [] [] type AsyncBuilder() = - member b.Zero() = doneA - member b.Delay(generator) = delayA(generator) - member b.Return(value) = resultA(value) - member b.ReturnFrom(computation:Async<_>) = computation - member b.Bind(computation, binder) = bindA computation binder - member b.Using(resource, binder) = usingA resource binder - member b.While(guard, computation) = whileA guard computation - member b.For(sequence, body) = forA sequence body - member b.Combine(computation1, computation2) = sequentialA computation1 computation2 - member b.TryFinally(computation, compensation) = tryFinallyA compensation computation - member b.TryWith(computation, catchHandler) = tryWithExnA catchHandler computation + member inline b.Zero() = UnitAsync + + member inline __.Delay(generator) = delayA generator + + member inline b.Return(value) = resultA value + + member inline b.ReturnFrom(computation:Async<_>) = computation + + member inline b.Bind(computation, binder) = bindA true computation binder + + member b.Using(resource, binder) = usingA resource binder + + member b.While(guard, computation) = whileA guard computation + + member b.For(sequence, body) = forA sequence body + + member inline b.Combine(computation1, computation2) = sequentialA computation1 computation2 + + member b.TryFinally(computation, compensation) = tryFinallyA compensation computation + + member b.TryWith(computation, catchHandler) = tryWithExnA catchHandler computation module AsyncImpl = let async = AsyncBuilder() @@ -686,7 +714,7 @@ namespace Microsoft.FSharp.Control f args) let unprotectedPrimitiveWithResync f = - unprotectedPrimitive(fun args -> + MakeAsync(fun args -> let args = delimitSyncContext args f args) @@ -715,7 +743,7 @@ namespace Microsoft.FSharp.Control let trampolineHolder = args.aux.trampolineHolder member this.ContinueImmediate res = let action () = args.cont res - let inline executeImmediately () = trampolineHolder.Protect action + let inline executeImmediately () = trampolineHolder.ExecuteAsyncAction action let currentCtxt = System.Threading.SynchronizationContext.Current match ctxt, currentCtxt with | null, null -> @@ -823,7 +851,7 @@ namespace Microsoft.FSharp.Control member x.ResultAvailable = result.IsSome member x.AwaitResult = - unprotectedPrimitive(fun args -> + MakeAsync(fun args -> // Check if a result is available synchronously let resOpt = match result with @@ -921,7 +949,7 @@ namespace Microsoft.FSharp.Control use resultCell = new ResultCell>() let trampolineHolder = TrampolineHolder() - trampolineHolder.Protect + trampolineHolder.ExecuteAsyncAction (fun () -> startA token @@ -990,14 +1018,14 @@ namespace Microsoft.FSharp.Control [] type Async = - static member CancellationToken = getCancellationToken() + static member CancellationToken = CancellationTokenAsync - static member CancelCheck () = doneA + static member CancelCheck () = UnitAsync static member FromContinuations (callback : ('T -> unit) * (exn -> unit) * (OperationCanceledException -> unit) -> unit) : Async<'T> = - unprotectedPrimitive (fun ({ aux = aux } as args) -> - if args.aux.token.IsCancellationRequested then - cancelT args + MakeAsync (fun ({ aux = aux } as args) -> + if args.IsCancellationRequested then + args.CallCancellationContinuation () else let underCurrentThreadStack = ref true let contToTailCall = ref None @@ -1011,7 +1039,7 @@ namespace Microsoft.FSharp.Control let ctxt = getSyncContext() postOrQueue ctxt aux.trampolineHolder (fun () -> cont x) |> unfake else - aux.trampolineHolder.Protect (fun () -> cont x ) |> unfake + aux.trampolineHolder.ExecuteAsyncAction (fun () -> cont x ) |> unfake try callback (once args.cont, (fun exn -> once aux.econt (MayLoseStackTrace(exn))), once aux.ccont) with exn -> @@ -1037,7 +1065,7 @@ namespace Microsoft.FSharp.Control // we do not dispose the old default CTS - let GC collect it static member Catch (computation: Async<'T>) = - unprotectedPrimitive (fun ({ aux = aux } as args) -> + MakeAsync (fun ({ aux = aux } as args) -> startA aux.token aux.trampolineHolder (Choice1Of2 >> args.cont) (fun edi -> args.cont (Choice2Of2 (edi.GetAssociatedSourceException()))) aux.ccont computation) static member RunSynchronously (computation: Async<'T>,?timeout,?cancellationToken:CancellationToken) = @@ -1057,12 +1085,12 @@ namespace Microsoft.FSharp.Control CancellationTokenOps.StartAsTask(token,computation,taskCreationOptions) static member StartChildAsTask (computation,?taskCreationOptions) = - async { let! token = getCancellationToken() - return CancellationTokenOps.StartAsTask(token,computation, taskCreationOptions) } + async { let! ct = CancellationTokenAsync + return CancellationTokenOps.StartAsTask(ct,computation, taskCreationOptions) } type Async with static member Parallel (computations: seq>) = - unprotectedPrimitive (fun args -> + MakeAsync (fun args -> let tasks,result = try Seq.toArray computations, None // manually protect eval of seq @@ -1087,9 +1115,9 @@ namespace Microsoft.FSharp.Control if (remaining = 0) then innerCTS.Dispose() match (!firstExn) with - | None -> trampolineHolder.Protect(fun () -> args.cont results) - | Some (Choice1Of2 exn) -> trampolineHolder.Protect(fun () -> aux.econt exn) - | Some (Choice2Of2 cexn) -> trampolineHolder.Protect(fun () -> aux.ccont cexn) + | None -> trampolineHolder.ExecuteAsyncAction(fun () -> args.cont results) + | Some (Choice1Of2 exn) -> trampolineHolder.ExecuteAsyncAction(fun () -> aux.econt exn) + | Some (Choice2Of2 cexn) -> trampolineHolder.ExecuteAsyncAction(fun () -> aux.ccont cexn) else FakeUnit @@ -1128,7 +1156,7 @@ namespace Microsoft.FSharp.Control FakeUnit)) static member Choice(computations : Async<'T option> seq) : Async<'T option> = - unprotectedPrimitive(fun args -> + MakeAsync(fun args -> let result = try Seq.toArray computations |> Choice1Of2 with exn -> ExceptionDispatchInfo.RestoreOrCapture exn |> Choice2Of2 @@ -1148,25 +1176,25 @@ namespace Microsoft.FSharp.Control match result with | Some _ -> if Interlocked.Increment exnCount = 1 then - innerCts.Cancel(); trampolineHolder.Protect(fun () -> args.cont result) + innerCts.Cancel(); trampolineHolder.ExecuteAsyncAction(fun () -> args.cont result) else FakeUnit | None -> if Interlocked.Increment noneCount = computations.Length then - innerCts.Cancel(); trampolineHolder.Protect(fun () -> args.cont None) + innerCts.Cancel(); trampolineHolder.ExecuteAsyncAction(fun () -> args.cont None) else FakeUnit let econt (exn : ExceptionDispatchInfo) = if Interlocked.Increment exnCount = 1 then - innerCts.Cancel(); trampolineHolder.Protect(fun () -> args.aux.econt exn) + innerCts.Cancel(); trampolineHolder.ExecuteAsyncAction(fun () -> args.aux.econt exn) else FakeUnit let ccont (exn : OperationCanceledException) = if Interlocked.Increment exnCount = 1 then - innerCts.Cancel(); trampolineHolder.Protect(fun () -> args.aux.ccont exn) + innerCts.Cancel(); trampolineHolder.ExecuteAsyncAction(fun () -> args.aux.ccont exn) else FakeUnit @@ -1181,7 +1209,7 @@ namespace Microsoft.FSharp.Control let continueWith (task : Task<'T>, args, useCcontForTaskCancellation) = let continuation (completedTask : Task<_>) : unit = - args.aux.trampolineHolder.Protect((fun () -> + args.aux.trampolineHolder.ExecuteAsyncAction((fun () -> if completedTask.IsCanceled then if useCcontForTaskCancellation then args.aux.ccont (new OperationCanceledException(args.aux.token)) @@ -1196,7 +1224,7 @@ namespace Microsoft.FSharp.Control let continueWithUnit (task : Task, args, useCcontForTaskCancellation) = let continuation (completedTask : Task) : unit = - args.aux.trampolineHolder.Protect((fun () -> + args.aux.trampolineHolder.ExecuteAsyncAction((fun () -> if completedTask.IsCanceled then if useCcontForTaskCancellation then args.aux.ccont (new OperationCanceledException(args.aux.token)) @@ -1253,7 +1281,7 @@ namespace Microsoft.FSharp.Control match !timer with | None -> () | Some t -> t.Dispose() - aux.trampolineHolder.Protect(fun () -> savedCCont(new OperationCanceledException(aux.token))) |> unfake + aux.trampolineHolder.ExecuteAsyncAction(fun () -> savedCCont(new OperationCanceledException(aux.token))) |> unfake ), null) let mutable edi = null @@ -1273,7 +1301,7 @@ namespace Microsoft.FSharp.Control | None -> () | Some t -> t.Dispose() // Now we're done, so call the continuation - aux.trampolineHolder.Protect (fun () -> savedCont()) |> unfake), + aux.trampolineHolder.ExecuteAsyncAction (fun () -> savedCont()) |> unfake), null, dueTime=millisecondsDueTime, period = -1) |> Some with exn -> if latch.Enter() then @@ -1328,7 +1356,7 @@ namespace Microsoft.FSharp.Control lock rwh (fun () -> rwh.Value.Value.Unregister(null) |> ignore) rwh := None registration.Dispose() - aux.trampolineHolder.Protect (fun () -> savedCont (not timeOut)) |> unfake), + aux.trampolineHolder.ExecuteAsyncAction (fun () -> savedCont (not timeOut)) |> unfake), state=null, millisecondsTimeOutInterval=millisecondsTimeout, executeOnlyOnce=true)); @@ -1349,7 +1377,7 @@ namespace Microsoft.FSharp.Control /// Await the result of a result cell without a timeout static member ReifyResult(result:AsyncImplResult<'T>) : Async<'T> = - unprotectedPrimitive(fun ({ aux = aux } as args) -> + MakeAsync(fun ({ aux = aux } as args) -> (match result with | Ok v -> args.cont v | Error exn -> aux.econt exn @@ -1397,7 +1425,7 @@ namespace Microsoft.FSharp.Control static member FromBeginEnd(beginAction,endAction,?cancelAction): Async<'T> = - async { let! cancellationToken = getCancellationToken() + async { let! ct = CancellationTokenAsync let resultCell = new ResultCell<_>() let once = Once() @@ -1409,14 +1437,14 @@ namespace Microsoft.FSharp.Control // Register the result. This may race with a successful result, but // ResultCell allows a race and throws away whichever comes last. once.Do(fun () -> - let canceledResult = Canceled (OperationCanceledException(cancellationToken)) + let canceledResult = Canceled (OperationCanceledException(ct)) resultCell.RegisterResult(canceledResult,reuseThread=true) |> unfake ) | Some cancel -> // If we get an exception from a cooperative cancellation function // we assume the operation has already completed. try cancel() with _ -> () - cancellationToken.Register(Action(onCancel), null) + ct.Register(Action(onCancel), null) let callback = new System.AsyncCallback(fun iar -> if not iar.CompletedSynchronously then @@ -1560,7 +1588,7 @@ namespace Microsoft.FSharp.Control beginAction, AsBeginEndHelpers.endAction<'T>, AsBeginEndHelpers.cancelAction<'T> static member AwaitEvent(event:IEvent<'Delegate,'T>, ?cancelAction) : Async<'T> = - async { let! token = getCancellationToken() + async { let! ct = CancellationTokenAsync let resultCell = new ResultCell<_>() // Set up the handlers to listen to events and cancellation let once = new Once() @@ -1573,12 +1601,12 @@ namespace Microsoft.FSharp.Control event.RemoveHandler(del) // Register the result. This may race with a successful result, but // ResultCell allows a race and throws away whichever comes last. - once.Do(fun () -> resultCell.RegisterResult(Canceled (OperationCanceledException(token)),reuseThread=true) |> unfake) + once.Do(fun () -> resultCell.RegisterResult(Canceled (OperationCanceledException(ct)),reuseThread=true) |> unfake) | Some cancel -> // If we get an exception from a cooperative cancellation function // we assume the operation has already completed. try cancel() with _ -> () - token.Register(Action(onCancel), null) + ct.Register(Action(onCancel), null) and obj = new Closure<'T>(fun eventArgs -> @@ -1605,7 +1633,7 @@ namespace Microsoft.FSharp.Control return! Async.AwaitAndReifyResult(resultCell) } type Async with - static member Ignore (computation: Async<'T>) = bindA computation (fun _ -> doneA) + static member Ignore (computation: Async<'T>) = ignoreA computation static member SwitchToNewThread() = switchToNewThread() static member SwitchToThreadPool() = switchToThreadPool() @@ -1614,7 +1642,7 @@ namespace Microsoft.FSharp.Control static member StartChild (computation:Async<'T>,?millisecondsTimeout) = async { let resultCell = new ResultCell<_>() - let! ct = getCancellationToken() + let! ct = CancellationTokenAsync let innerCTS = new CancellationTokenSource() // innerCTS does not require disposal let ctsRef = ref innerCTS let reg = ct.Register( @@ -1644,7 +1672,7 @@ namespace Microsoft.FSharp.Control return! switchTo ctxt } static member OnCancel interruption = - async { let! ct = getCancellationToken () + async { let! ct = CancellationTokenAsync // latch protects CancellationTokenRegistration.Dispose from being called twice let latch = Latch() let rec handler (_ : obj) = @@ -1675,7 +1703,7 @@ namespace Microsoft.FSharp.Control module CommonExtensions = - open AsyncBuilderImpl + open AsyncActions type System.IO.Stream with @@ -1733,7 +1761,7 @@ namespace Microsoft.FSharp.Control member x.OnCompleted() = () } module WebExtensions = - open AsyncBuilderImpl + open AsyncActions type System.Net.WebRequest with [] // give the extension member a 'nice', unmangled compiled name, unique within this module @@ -1831,7 +1859,7 @@ namespace Microsoft.FSharp.Control } let timeout msec cancellationToken = if msec < 0 then - unprotectedPrimitive(fun _ -> FakeUnit) // "block" forever + MakeAsync(fun _ -> FakeUnit) // "block" forever else let c = new ResultCell<_>() Async.StartWithContinuations( @@ -1868,7 +1896,7 @@ namespace Microsoft.FSharp.Control pulse let waitOneNoTimeoutOrCancellation = - unprotectedPrimitive (fun ({ aux = aux } as args) -> + MakeAsync (fun ({ aux = aux } as args) -> match savedCont with | None -> let descheduled = diff --git a/src/fsharp/FSharp.Core/control.fsi b/src/fsharp/FSharp.Core/control.fsi index 77be1ceae14..6bcbf64e991 100644 --- a/src/fsharp/FSharp.Core/control.fsi +++ b/src/fsharp/FSharp.Core/control.fsi @@ -414,6 +414,23 @@ namespace Microsoft.FSharp.Control static member StartImmediate: computation:Async * ?cancellationToken:CancellationToken-> unit + /// Opaque type for generated code + type FakeUnitValue + + /// Opaque type for generated code + [] + type AsyncParams<'T> = + member IsCancellationRequested: bool + member CallSuccessContinuation: 'T -> FakeUnitValue + member CallCancellationContinuation: unit -> FakeUnitValue + + [] + /// Entry points for generated code + module AsyncActions = + val MakeAsync: f:(AsyncParams<'T> -> FakeUnitValue) -> Async<'T> + val UnitAsync: Async + val ExecuteUserCode: args:AsyncParams<'T> -> f:('U -> Async<'T>) -> 'U -> FakeUnitValue + val BindUserCode: keepStack: bool -> args:AsyncParams<'T> -> Async<'U> -> f:('U -> Async<'T>) -> FakeUnitValue [] @@ -441,7 +458,7 @@ namespace Microsoft.FSharp.Control /// The existence of this method permits the use of empty else branches in the /// async { ... } computation expression syntax. /// An asynchronous computation that returns (). - member Zero : unit -> Async + member inline Zero : unit -> Async /// Creates an asynchronous computation that first runs computation1 /// and then runs computation2, returning the result of computation2. @@ -453,7 +470,7 @@ namespace Microsoft.FSharp.Control /// The first part of the sequenced computation. /// The second part of the sequenced computation. /// An asynchronous computation that runs both of the computations sequentially. - member Combine : computation1:Async * computation2:Async<'T> -> Async<'T> + member inline Combine : computation1:Async * computation2:Async<'T> -> Async<'T> /// Creates an asynchronous computation that runs computation repeatedly /// until guard() becomes false. @@ -476,7 +493,7 @@ namespace Microsoft.FSharp.Control /// async { ... } computation expression syntax. /// The value to return from the computation. /// An asynchronous computation that returns value when executed. - member Return : value:'T -> Async<'T> + member inline Return : value:'T -> Async<'T> /// Delegates to the input computation. /// @@ -484,14 +501,14 @@ namespace Microsoft.FSharp.Control /// async { ... } computation expression syntax. /// The input computation. /// The input computation. - member ReturnFrom : computation:Async<'T> -> Async<'T> + member inline ReturnFrom : computation:Async<'T> -> Async<'T> /// Creates an asynchronous computation that runs generator. /// /// A cancellation check is performed when the computation is executed. /// The function to run. /// An asynchronous computation that runs generator. - member Delay : generator:(unit -> Async<'T>) -> Async<'T> + member inline Delay : generator:(unit -> Async<'T>) -> Async<'T> /// Creates an asynchronous computation that runs binder(resource). /// The action resource.Dispose() is executed as this computation yields its result @@ -518,7 +535,7 @@ namespace Microsoft.FSharp.Control /// The function to bind the result of computation. /// An asynchronous computation that performs a monadic bind on the result /// of computation. - member Bind: computation: Async<'T> * binder: ('T -> Async<'U>) -> Async<'U> + member inline Bind: computation: Async<'T> * binder: ('T -> Async<'U>) -> Async<'U> /// Creates an asynchronous computation that runs computation. The action compensation is executed /// after computation completes, whether computation exits normally or by an exception. If compensation raises an exception itself From 41082e23e882520faf7db8758666a164f4c23126 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 14 Feb 2018 17:39:17 +0000 Subject: [PATCH 02/39] async stack traces --- src/fsharp/FSharp.Core/control.fs | 1387 ++++++++++++++-------------- src/fsharp/FSharp.Core/control.fsi | 24 +- 2 files changed, 699 insertions(+), 712 deletions(-) diff --git a/src/fsharp/FSharp.Core/control.fs b/src/fsharp/FSharp.Core/control.fs index ad23c378be9..8cb6878eb0a 100644 --- a/src/fsharp/FSharp.Core/control.fs +++ b/src/fsharp/FSharp.Core/control.fs @@ -88,13 +88,13 @@ namespace Microsoft.FSharp.Control // is represented as type 'void' in the underlying IL. // Hence we don't use the 'unit' return type here, and instead invent our own type. [] - type FakeUnitValue = + type AsyncReturn = | FakeUnit - type cont<'T> = ('T -> FakeUnitValue) - type econt = (ExceptionDispatchInfo -> FakeUnitValue) - type ccont = (OperationCanceledException -> FakeUnitValue) + type cont<'T> = ('T -> AsyncReturn) + type econt = (ExceptionDispatchInfo -> AsyncReturn) + type ccont = (OperationCanceledException -> AsyncReturn) @@ -119,8 +119,9 @@ namespace Microsoft.FSharp.Control static let unfake FakeUnit = () - // Install a trampolineStack if none exists - member this.ExecuteAsyncAction (firstAction : unit -> FakeUnitValue) = + /// Use this object with a trampoline on the synchronous stack if none exists, and execute + /// the given function. The function might write its continuation into the trampoline. + member __.Execute (firstAction : unit -> AsyncReturn) = let thisIsTopTrampoline = if Trampoline.thisThreadHasTrampoline then false @@ -143,17 +144,20 @@ namespace Microsoft.FSharp.Control Trampoline.thisThreadHasTrampoline <- false FakeUnit - // returns true if time to jump on trampoline - member this.IncrementBindCount() = + /// Increment the counter estimating the size of the synchronous stack and + /// return true if time to jump on trampoline. + member __.IncrementBindCount() = bindCount <- bindCount + 1 bindCount >= bindLimitBeforeHijack - member this.Set action = + /// Abandon the synchronous stack of the current execution and save the continuation in the trampoline. + member __.Set action = match cont with | None -> bindCount <- 0 cont <- Some action | _ -> failwith "Internal error: attempting to install continuation twice" + FakeUnit #if FSCORE_PORTABLE_NEW @@ -187,104 +191,127 @@ namespace Microsoft.FSharp.Control let mutable trampoline = null static let unfake FakeUnit = () - // preallocate context-switching callbacks - // Preallocate the delegate + + // Preallocate a ctxt-switching callback delegate. // This should be the only call to SynchronizationContext.Post in this library. We must always install a trampoline. let sendOrPostCallback = - SendOrPostCallback(fun o -> - let f = unbox o : unit -> FakeUnitValue - this.ExecuteAsyncAction f |> unfake - ) + SendOrPostCallback (fun o -> + let f = unbox<(unit -> AsyncReturn)> o + this.ExecuteWithTrampoline f |> unfake) - // Preallocate the delegate + // Preallocate a ctxt-switching callback delegate. // This should be the only call to QueueUserWorkItem in this library. We must always install a trampoline. let waitCallbackForQueueWorkItemWithTrampoline = - WaitCallback(fun o -> - let f = unbox o : unit -> FakeUnitValue - this.ExecuteAsyncAction f |> unfake - ) + WaitCallback (fun o -> + let f = unbox<(unit -> AsyncReturn)> o + this.ExecuteWithTrampoline f |> unfake) #if !FX_NO_PARAMETERIZED_THREAD_START // This should be the only call to Thread.Start in this library. We must always install a trampoline. let threadStartCallbackForStartThreadWithTrampoline = - ParameterizedThreadStart(fun o -> - let f = unbox o : unit -> FakeUnitValue - this.ExecuteAsyncAction f |> unfake - ) + ParameterizedThreadStart (fun o -> + let f = unbox<(unit -> AsyncReturn)> o + this.ExecuteWithTrampoline f |> unfake) #endif - member this.Post (ctxt: SynchronizationContext) (f : unit -> FakeUnitValue) = - ctxt.Post (sendOrPostCallback, state=(f |> box)) + member this.Post (syncCtxt: SynchronizationContext) (f : unit -> AsyncReturn) = + syncCtxt.Post (sendOrPostCallback, state=(f |> box)) FakeUnit - member this.QueueWorkItem (f: unit -> FakeUnitValue) = - if not (ThreadPool.QueueUserWorkItem(waitCallbackForQueueWorkItemWithTrampoline, f |> box)) then - failwith "failed to queue user work item" - FakeUnit + member this.QueueWorkItem (f: unit -> AsyncReturn) = + if not (ThreadPool.QueueUserWorkItem(waitCallbackForQueueWorkItemWithTrampoline, f |> box)) then + failwith "failed to queue user work item" + FakeUnit #if FX_NO_PARAMETERIZED_THREAD_START // This should be the only call to Thread.Start in this library. We must always install a trampoline. - member this.StartThread (f : unit -> FakeUnitValue) = + member this.StartThread (f : unit -> AsyncReturn) = #if FX_NO_THREAD this.QueueWorkItem(f) #else - (new Thread((fun _ -> this.ExecuteAsyncAction f |> unfake), IsBackground=true)).Start() + (new Thread((fun _ -> this.ExecuteWithTrampoline f |> unfake), IsBackground=true)).Start() FakeUnit #endif #else // This should be the only call to Thread.Start in this library. We must always install a trampoline. - member this.StartThread (f : unit -> FakeUnitValue) = + member __.StartThread (f : unit -> AsyncReturn) = (new Thread(threadStartCallbackForStartThreadWithTrampoline,IsBackground=true)).Start(f|>box) FakeUnit #endif - member this.ExecuteAsyncAction firstAction = + /// Execute an async computation after installing a trampoline on its synchronous stack. + member __.ExecuteWithTrampoline firstAction = trampoline <- new Trampoline() - trampoline.ExecuteAsyncAction firstAction + trampoline.Execute firstAction - member this.Trampoline = trampoline + member __.Trampoline = trampoline - member inline this.HijackCheck (res, cont : 'T -> FakeUnitValue) : FakeUnitValue = + /// Call a continuation, but first check if an async computation should trampoline on its synchronous stack. + member inline __.HijackCheck (cont : 'T -> AsyncReturn) res = if trampoline.IncrementBindCount() then - trampoline.Set(fun () -> cont res) - FakeUnit + trampoline.Set (fun () -> cont res) else // NOTE: this must be a tailcall cont res [] [] - type AsyncParamsAux = + /// Represents rarely changing components of an in-flight async computation + type AsyncContextAux = { token : CancellationToken econt : econt ccont : ccont - trampolineHolder : TrampolineHolder - } + trampolineHolder : TrampolineHolder } [] [] - type AsyncParams<'T> = + /// Represents an in-flight async computation + type AsyncContext<'T> = { cont : cont<'T> - aux : AsyncParamsAux - } + aux : AsyncContextAux } - member args.IsCancellationRequested = args.aux.token.IsCancellationRequested + member ctxt.IsCancellationRequested = ctxt.aux.token.IsCancellationRequested - member args.CallSuccessContinuation res = - args.aux.trampolineHolder.HijackCheck (res, args.cont) - - // Call the cancellation continuation - member args.CallCancellationContinuation() = - args.aux.ccont (new OperationCanceledException(args.aux.token)) + /// Call the cancellation continuation of the active computation + member ctxt.CallCancellationContinuation () = + ctxt.aux.ccont (new OperationCanceledException (ctxt.aux.token)) + member ctxt.CallSuccessContinuation result = + if ctxt.IsCancellationRequested then + ctxt.CallCancellationContinuation () + else + ctxt.aux.trampolineHolder.HijackCheck ctxt.cont result + + /// Call the exception continuation of the active computation + member ctxt.CallExceptionContinuation edi = + ctxt.aux.econt edi [] [] type Async<'T> = - P of (AsyncParams<'T> -> FakeUnitValue) + { Invoke : (AsyncContext<'T> -> AsyncReturn) } + + type VolatileBarrier() = + [] + let mutable isStopped = false + member __.Proceed = not isStopped + member __.Stop() = isStopped <- true + + + [] + [] + type Latch() = + let mutable i = 0 + member this.Enter() = Interlocked.CompareExchange(&i, 1, 0) = 0 - module AsyncActions = + [] + type AsyncResult<'T> = + | Ok of 'T + | Error of ExceptionDispatchInfo + | Canceled of OperationCanceledException + + module AsyncPrimitives = // To consider: augment with more exception traceability information // To consider: add the ability to suspend running ps in debug mode // To consider: add the ability to trace running ps in debug mode @@ -295,18 +322,9 @@ namespace Microsoft.FSharp.Control let fake () = FakeUnit let unfake FakeUnit = () - let ignoreFake _ = FakeUnit - let mutable defaultCancellationTokenSource = new CancellationTokenSource() - [] - type AsyncImplResult<'T> = - | Ok of 'T - | Error of ExceptionDispatchInfo - | Canceled of OperationCanceledException - - /// Global mutable state used to associate Exception let associationTable = System.Runtime.CompilerServices.ConditionalWeakTable() @@ -329,33 +347,33 @@ namespace Microsoft.FSharp.Control edi.Throw() Unchecked.defaultof<'T> // Note, this line should not be reached, but gives a generic return type - // Apply f to x and call either the continuation or exception continuation depending what happens - let inline protect (trampolineHolder:TrampolineHolder) econt f x (cont : 'T -> FakeUnitValue) : FakeUnitValue = + /// Apply userCode to x and call either the continuation or exception continuation depending what happens + let inline protectUserCodeIncludingHijackCheck (trampolineHolder:TrampolineHolder) userCode x econt (cont : 'T -> AsyncReturn) : AsyncReturn = // This is deliberately written in a allocation-free style, except when the trampoline is taken let mutable res = Unchecked.defaultof<_> let mutable edi = null try - res <- f x + res <- userCode x with exn -> edi <- ExceptionDispatchInfo.RestoreOrCapture(exn) match edi with | null -> // NOTE: this must be a tailcall - trampolineHolder.HijackCheck (res, cont) + trampolineHolder.HijackCheck cont res | _ -> // NOTE: this must be a tailcall - trampolineHolder.HijackCheck (edi, econt) + trampolineHolder.HijackCheck econt edi // Apply f to x and call either the continuation or exception continuation depending what happens - let inline protectNoHijack econt f x (cont : 'T -> FakeUnitValue) : FakeUnitValue = + let inline protectUserCodeNoHijackCheck userCode x econt (cont : 'T -> AsyncReturn) : AsyncReturn = // This is deliberately written in a allocation-free style let mutable res = Unchecked.defaultof<_> let mutable edi = null try - res <- f x + res <- userCode x with exn -> edi <- ExceptionDispatchInfo.RestoreOrCapture(exn) @@ -367,14 +385,24 @@ namespace Microsoft.FSharp.Control // NOTE: this must be a tailcall econt exn + /// Perform a cancellation check and ensure that any exceptions raised by + /// the immediate execution of "f" are sent to the exception continuation. + let protectUserCodeInCtxt (ctxt: AsyncContext<_>) f = + if ctxt.IsCancellationRequested then + ctxt.CallCancellationContinuation () + else + try + f ctxt + with exn -> + let edi = ExceptionDispatchInfo.RestoreOrCapture(exn) + ctxt.CallExceptionContinuation edi - - // Reify exceptional results as exceptions + /// Reify exceptional results as exceptions let commit res = match res with - | Ok res -> res - | Error edi -> edi.ThrowAny() - | Canceled exn -> raise exn + | AsyncResult.Ok res -> res + | AsyncResult.Error edi -> edi.ThrowAny() + | AsyncResult.Canceled exn -> raise exn // Reify exceptional results as exceptionsJIT 64 doesn't always take tailcalls correctly @@ -383,42 +411,27 @@ namespace Microsoft.FSharp.Control | None -> raise (System.TimeoutException()) | Some res -> commit res - - //---------------------------------- - // PRIMITIVE ASYNC INVOCATION - - // Apply the underlying implementation of an async computation to its inputs - let inline invokeA (P pf) args = pf args - - - let startA cancellationToken trampolineHolder cont econt ccont p = - let args = - { cont = cont - aux = { token = cancellationToken; - econt = econt - ccont = ccont - trampolineHolder = trampolineHolder - } - } - invokeA p args - + /// Make an initial ctxt and execute the async computation. This should only + /// be called + let startA cancellationToken trampolineHolder cont econt ccont computation = + let ctxt = { cont = cont; aux = { token = cancellationToken; econt = econt; ccont = ccont; trampolineHolder = trampolineHolder } } + computation.Invoke ctxt #if FX_NO_PARAMETERIZED_THREAD_START // Preallocate the delegate // This should be the only call to QueueUserWorkItem in this library. We must always install a trampoline. let waitCallbackForQueueWorkItemWithTrampoline(trampolineHolder : TrampolineHolder) = - WaitCallback(fun o -> - let f = unbox o : unit -> FakeUnitValue - trampolineHolder.ExecuteAsyncAction f |> unfake - ) + WaitCallback(fun o -> + let f = unbox o : unit -> AsyncReturn + trampolineHolder.ExecuteWithTrampoline f |> unfake) - let startThreadWithTrampoline (trampolineHolder:TrampolineHolder) (f : unit -> FakeUnitValue) = + let startThreadWithTrampoline (trampolineHolder:TrampolineHolder) (f : unit -> AsyncReturn) = #if FX_NO_THREAD - if not (ThreadPool.QueueUserWorkItem((waitCallbackForQueueWorkItemWithTrampoline trampolineHolder), f |> box)) then - failwith "failed to queue user work item" - FakeUnit + if not (ThreadPool.QueueUserWorkItem((waitCallbackForQueueWorkItemWithTrampoline trampolineHolder), f |> box)) then + failwith "failed to queue user work item" + FakeUnit #else - (new Thread((fun _ -> trampolineHolder.ExecuteAsyncAction f |> unfake), IsBackground=true)).Start() + (new Thread((fun _ -> trampolineHolder.ExecuteWithTrampoline f |> unfake), IsBackground=true)).Start() FakeUnit #endif @@ -426,303 +439,250 @@ namespace Microsoft.FSharp.Control // Statically preallocate the delegate let threadStartCallbackForStartThreadWithTrampoline = - ParameterizedThreadStart(fun o -> - let (trampolineHolder,f) = unbox o : TrampolineHolder * (unit -> FakeUnitValue) - trampolineHolder.ExecuteAsyncAction f |> unfake - ) + ParameterizedThreadStart (fun o -> + let (trampolineHolder,f) = unbox o : TrampolineHolder * (unit -> AsyncReturn) + trampolineHolder.ExecuteWithTrampoline f |> unfake) // This should be the only call to Thread.Start in this library. We must always install a trampoline. - let startThreadWithTrampoline (trampolineHolder:TrampolineHolder) (f : unit -> FakeUnitValue) = + let startThreadWithTrampoline (trampolineHolder:TrampolineHolder) (f : unit -> AsyncReturn) = (new Thread(threadStartCallbackForStartThreadWithTrampoline,IsBackground=true)).Start((trampolineHolder,f)|>box) FakeUnit #endif - let startAsync cancellationToken cont econt ccont p = let trampolineHolder = new TrampolineHolder() - trampolineHolder.ExecuteAsyncAction (fun () -> startA cancellationToken trampolineHolder cont econt ccont p) + trampolineHolder.ExecuteWithTrampoline (fun () -> startA cancellationToken trampolineHolder cont econt ccont p) let queueAsync cancellationToken cont econt ccont p = let trampolineHolder = new TrampolineHolder() - trampolineHolder.QueueWorkItem(fun () -> startA cancellationToken trampolineHolder cont econt ccont p) + trampolineHolder.QueueWorkItem (fun () -> startA cancellationToken trampolineHolder cont econt ccont p) + /// Use this to recover ExceptionDispatchInfo when outside the "with" part of a try/with block. + /// This indicates all the places where we lose a stack trace. + /// + /// Stack trace losses come when interoperating with other code that only provide us with an exception value, + /// notably .NET 4.x tasks and user exceptions passed to the exception continuation in Async.FromContinuations. + let MayLoseStackTrace exn = ExceptionDispatchInfo.RestoreOrCapture exn + + /// Build a primitive without any exception or resync protection + let MakeAsync body = { Invoke = body } - //---------------------------------- - // PRIMITIVE ASYNC CONSTRUCTORS + /// Build a context suitable for running part1 of a computation and passing the result to part2f + let bindPart2 ctxt part2f = + let cont a = protectUserCodeNoHijackCheck part2f a ctxt.aux.econt (fun part2 -> part2.Invoke ctxt) + { cont=cont; aux = ctxt.aux } - // Use this to recover ExceptionDispatchInfo when outside the "with" part of a try/with block. - // This indicates all the places where we lose a stack trace. - // - // Stack trace losses come when interoperating with other code that only provide us with an exception value, - // notably .NET 4.x tasks and user exceptions passed to the exception continuation in Async.FromContinuations. - let MayLoseStackTrace exn = ExceptionDispatchInfo.RestoreOrCapture(exn) - - // Call the exception continuation - let errorT args edi = - args.aux.econt edi + [] + // Note: direct calls to this function end up in user assemblies via inlining + let rec Bind keepStack (ctxt: AsyncContext<_>) part1 part2f = + // Cancellation check + if ctxt.IsCancellationRequested then + ctxt.CallCancellationContinuation () + else + // Hijack check + let trampoline = ctxt.aux.trampolineHolder.Trampoline - - // Build a primitive without any exception of resync protection - // - // Use carefully!! - let MakeAsync f = P f + if trampoline.IncrementBindCount() then + trampoline.Set(fun () -> Bind keepStack ctxt part1 part2f) - let protectedPrimitiveCore (args: AsyncParams<_>) f = - if args.IsCancellationRequested then - args.CallCancellationContinuation () - else - try - f args - with exn -> - let edi = ExceptionDispatchInfo.RestoreOrCapture(exn) - errorT args edi + // In debug code, keep a stack frame for the synchronous invocation of part1, but drop it for part2 + elif keepStack then - // When run, ensures that any exceptions raised by the immediate execution of "f" are - // sent to the exception continuation. - // - let protectedPrimitive f = - MakeAsync (fun args -> protectedPrimitiveCore args f) + let latch = Latch() - let reify res = - MakeAsync (fun args -> - match res with - | AsyncImplResult.Ok r -> args.cont r - | AsyncImplResult.Error e -> args.aux.econt e - | AsyncImplResult.Canceled oce -> args.aux.ccont oce) + let mutable savedResult1 = Unchecked.defaultof<_> - //---------------------------------- - // BUILDER OPERATIONS + let ctxtPart1ThenPart2 = + let cont result1 = + savedResult1 <- result1 + if latch.Enter() then + FakeUnit + else + protectUserCodeNoHijackCheck part2f result1 ctxt.aux.econt (fun part2 -> part2.Invoke ctxt) + { cont=cont; aux = ctxt.aux } + + let result2 = part1.Invoke ctxtPart1ThenPart2 + + if latch.Enter() then + // We acquired the latch before the continuation was called. + // This indicates the body is being run async, or an exception or + // cancellation happened. + result2 + else + // The body continuation acquired the latch. + // This indicates the body should be run sync using the saved result. + // + // NOTE: this must be a tailcall to drop the part1 frame off the stack. + protectUserCodeNoHijackCheck part2f savedResult1 ctxt.aux.econt (fun part2 -> part2.Invoke ctxt) + + else + let ctxtPart1ThenPart2 = bindPart2 ctxt part2f + part1.Invoke ctxtPart1ThenPart2 - // Generate async computation which calls its continuation with the given result - let inline resultA res = - MakeAsync (fun args -> - if args.IsCancellationRequested then - args.CallCancellationContinuation () - else - args.CallSuccessContinuation res) - [] - let BindUserCode keepStack args p1 f = - System.Console.WriteLine "BindUserCode" - let args = - let cont a = protectNoHijack args.aux.econt f a (fun p2 -> invokeA p2 args) - { cont=cont; aux = args.aux } - // Trampoline the continuation onto a new work item every so often - let trampoline = args.aux.trampolineHolder.Trampoline - if trampoline.IncrementBindCount() then - System.Console.WriteLine "trampoiline" - trampoline.Set(fun () -> invokeA p1 args) - FakeUnit + /// Execute user code but first check for trampoline and cancellation. + // + // Note: direct calls to this function end up in user assemblies via inlining + let Call (ctxt: AsyncContext<'T>) result1 (part2f: 'U -> Async<'T>) = + if ctxt.IsCancellationRequested then + ctxt.CallCancellationContinuation () + else + protectUserCodeIncludingHijackCheck ctxt.aux.trampolineHolder part2f result1 ctxt.aux.econt (fun part2 -> part2.Invoke ctxt) + + let TryFinally (ctxt: AsyncContext<'T>) finallyFunction computation = + if ctxt.IsCancellationRequested then + ctxt.CallCancellationContinuation () else - if keepStack then - // NOTE: this must be a tailcall - System.Console.WriteLine "keeping stack" - let res = invokeA p1 args - trampoline.IncrementBindCount() |> ignore - System.Console.WriteLine "returning stack" - res - else - invokeA p1 args + let trampolineHolder = ctxt.aux.trampolineHolder + // The new continuation runs the finallyFunction and resumes the old continuation + // If an exception is thrown we continue with the previous exception continuation. + let cont b = protectUserCodeIncludingHijackCheck trampolineHolder finallyFunction () ctxt.aux.econt (fun () -> ctxt.cont b) + // The new exception continuation runs the finallyFunction and then runs the previous exception continuation. + // If an exception is thrown we continue with the previous exception continuation. + let econt exn = protectUserCodeIncludingHijackCheck trampolineHolder finallyFunction () ctxt.aux.econt (fun () -> ctxt.aux.econt exn) + // The cancellation continuation runs the finallyFunction and then runs the previous cancellation continuation. + // If an exception is thrown we continue with the previous cancellation continuation (the exception is lost) + let ccont cexn = protectUserCodeIncludingHijackCheck trampolineHolder finallyFunction () (fun _ -> ctxt.aux.ccont cexn) (fun () -> ctxt.aux.ccont cexn) + computation.Invoke { ctxt with cont = cont; aux = { ctxt.aux with econt = econt; ccont = ccont } } + + /// When run, ensures that any exceptions raised by the immediate execution of "f" are + /// sent to the exception continuation. + let protectUserCodeAsAsync f = + MakeAsync (fun ctxt -> protectUserCodeInCtxt ctxt f) + + let asyncResultToAsync res = + MakeAsync (fun ctxt -> + match res with + | AsyncResult.Ok r -> ctxt.cont r + | AsyncResult.Error edi -> ctxt.CallExceptionContinuation edi + | AsyncResult.Canceled oce -> ctxt.aux.ccont oce) + // Generate async computation which calls its continuation with the given result + let inline resultA res = + // Note: this code ends up in user assemblies via inlining + MakeAsync (fun ctxt -> ctxt.CallSuccessContinuation res) + // The primitive bind operation. Generate a process that runs the first process, takes // its result, applies f and then runs the new process produced. Hijack if necessary and // run 'f' with exception protection - let inline bindA keepStack p f = - MakeAsync (fun args -> - if args.IsCancellationRequested then - args.CallCancellationContinuation () - else - BindUserCode keepStack args p f) + let inline bindA keepStack part1 part2f = + // Note: this code ends up in user assemblies via inlining + MakeAsync (fun ctxt -> Bind keepStack ctxt part1 part2f) - [] - let ExecuteUserCode (args: AsyncParams<'T>) (f: 'U -> Async<'T>) x = - protect args.aux.trampolineHolder args.aux.econt f x (fun p2 -> invokeA p2 args) - - // callA = "bindA (return x) f" - let inline callA f x = - MakeAsync (fun args -> - if args.IsCancellationRequested then - args.CallCancellationContinuation () - else - ExecuteUserCode args f x - ) + // Call the given function with exception protection, but first + // check for cancellation. + let inline callA part2f result1 = + // Note: this code ends up in user assemblies via inlining + MakeAsync (fun ctxt -> Call ctxt result1 part2f) // delayPrim = "bindA (return ()) f" let inline delayA f = callA f () + /// Implements the sequencing construct of async computation expressions + let inline sequentialA part1 part2 = + bindA false part1 (fun () -> part2) + // Call p but augment the normal, exception and cancel continuations with a call to finallyFunction. // If the finallyFunction raises an exception then call the original exception continuation // with the new exception. If exception is raised after a cancellation, exception is ignored // and cancel continuation is called. - let tryFinallyA finallyFunction p = - MakeAsync (fun args -> - if args.IsCancellationRequested then - args.CallCancellationContinuation () - else - let trampolineHolder = args.aux.trampolineHolder - // The new continuation runs the finallyFunction and resumes the old continuation - // If an exception is thrown we continue with the previous exception continuation. - let cont b = protect trampolineHolder args.aux.econt finallyFunction () (fun () -> args.cont b) - // The new exception continuation runs the finallyFunction and then runs the previous exception continuation. - // If an exception is thrown we continue with the previous exception continuation. - let econt exn = protect trampolineHolder args.aux.econt finallyFunction () (fun () -> args.aux.econt exn) - // The cancellation continuation runs the finallyFunction and then runs the previous cancellation continuation. - // If an exception is thrown we continue with the previous cancellation continuation (the exception is lost) - let ccont cexn = protect trampolineHolder (fun _ -> args.aux.ccont cexn) finallyFunction () (fun () -> args.aux.ccont cexn) - invokeA p { args with cont = cont; aux = { args.aux with econt = econt; ccont = ccont } }) + let inline tryFinallyA finallyFunction computation = + MakeAsync (fun ctxt -> TryFinally ctxt finallyFunction computation) // Re-route the exception continuation to call to catchFunction. If catchFunction or the new process fail // then call the original exception continuation with the failure. - let tryWithDispatchInfoA catchFunction p = - MakeAsync (fun args -> - if args.IsCancellationRequested then - args.CallCancellationContinuation () + let tryWithDispatchInfoA catchFunction computation = + MakeAsync (fun ctxt -> + if ctxt.IsCancellationRequested then + ctxt.CallCancellationContinuation () else - let econt (edi: ExceptionDispatchInfo) = invokeA (callA catchFunction edi) args - invokeA p { args with aux = { args.aux with econt = econt } }) + let econt (edi: ExceptionDispatchInfo) = + let ecomputation = callA catchFunction edi + ecomputation.Invoke ctxt + let ctxt = { ctxt with aux = { ctxt.aux with econt = econt } } + computation.Invoke ctxt) let tryWithExnA catchFunction computation = computation |> tryWithDispatchInfoA (fun edi -> catchFunction (edi.GetAssociatedSourceException())) /// Call the finallyFunction if the computation results in a cancellation - let whenCancelledA (finallyFunction : OperationCanceledException -> unit) p = - MakeAsync (fun ({ aux = aux } as args)-> - let ccont exn = protect aux.trampolineHolder (fun _ -> aux.ccont exn) finallyFunction exn (fun _ -> aux.ccont exn) - invokeA p { args with aux = { aux with ccont = ccont } }) - - let CancellationTokenAsync = - MakeAsync (fun ({ aux = aux } as args) -> args.cont aux.token) + let whenCancelledA (finallyFunction : OperationCanceledException -> unit) computation = + MakeAsync (fun ctxt -> + let aux = ctxt.aux + let ccont exn = protectUserCodeIncludingHijackCheck aux.trampolineHolder finallyFunction exn (fun _ -> aux.ccont exn) (fun _ -> aux.ccont exn) + let ctxt = { ctxt with aux = { aux with ccont = ccont } } + computation.Invoke ctxt) + + /// A single pre-allocated computation that fetched the current cancellation token + let GetCancellationTokenAsync = + MakeAsync (fun ctxt -> ctxt.cont ctxt.aux.token) - /// Return a unit result - let UnitAsync = + /// A single pre-allocated computation that returns a unit result + let unitAsync = resultA() /// Implement use/Dispose - let usingA (r:'T :> IDisposable) (f:'T -> Async<'a>) : Async<'a> = + let usingA (resource:'T :> IDisposable) (computation:'T -> Async<'a>) : Async<'a> = let mutable x = 0 let disposeFunction _ = if Interlocked.CompareExchange(&x, 1, 0) = 0 then - Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicFunctions.Dispose r - tryFinallyA disposeFunction (callA f r) |> whenCancelledA disposeFunction + Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicFunctions.Dispose resource + tryFinallyA disposeFunction (callA computation resource) |> whenCancelledA disposeFunction - let inline ignoreA p = - bindA false p (fun _ -> UnitAsync) + let inline ignoreA computation = + bindA false computation (fun _ -> unitAsync) - /// Implement the while loop - let rec whileA gd prog = - if gd() then - bindA false prog (fun () -> whileA gd prog) + /// Implement the while loop construct of async commputation expressions + let rec whileA guardFunc computation = + if guardFunc() then + bindA false computation (fun () -> whileA guardFunc computation) else - UnitAsync + unitAsync - /// Implement the for loop - let rec forA (e: seq<_>) prog = - usingA (e.GetEnumerator()) (fun ie -> + /// Implement the for loop construct of async commputation expressions + let rec forA (source: seq<_>) computation = + usingA (source.GetEnumerator()) (fun ie -> whileA (fun () -> ie.MoveNext()) - (delayA(fun () -> prog ie.Current))) + (delayA (fun () -> computation ie.Current))) - - let inline sequentialA p1 p2 = - bindA false p1 (fun () -> p2) - - - open AsyncActions - - [] - [] - type AsyncBuilder() = - member inline b.Zero() = UnitAsync - - member inline __.Delay(generator) = delayA generator - - member inline b.Return(value) = resultA value - - member inline b.ReturnFrom(computation:Async<_>) = computation - - member inline b.Bind(computation, binder) = bindA true computation binder - - member b.Using(resource, binder) = usingA resource binder - - member b.While(guard, computation) = whileA guard computation - - member b.For(sequence, body) = forA sequence body - - member inline b.Combine(computation1, computation2) = sequentialA computation1 computation2 - - member b.TryFinally(computation, compensation) = tryFinallyA compensation computation - - member b.TryWith(computation, catchHandler) = tryWithExnA catchHandler computation - - module AsyncImpl = - let async = AsyncBuilder() - - //---------------------------------- - // DERIVED SWITCH TO HELPERS - - let switchTo (ctxt: SynchronizationContext) = - protectedPrimitive(fun ({ aux = aux } as args) -> - aux.trampolineHolder.Post ctxt (fun () -> args.cont () )) + let switchTo (syncCtxt: SynchronizationContext) = + protectUserCodeAsAsync (fun ctxt -> + ctxt.aux.trampolineHolder.Post syncCtxt (fun () -> ctxt.cont ())) let switchToNewThread() = - protectedPrimitive(fun ({ aux = aux } as args) -> - aux.trampolineHolder.StartThread (fun () -> args.cont () ) ) + protectUserCodeAsAsync (fun ctxt -> + ctxt.aux.trampolineHolder.StartThread (fun () -> ctxt.cont ())) let switchToThreadPool() = - protectedPrimitive(fun ({ aux = aux } as args) -> - aux.trampolineHolder.QueueWorkItem (fun () -> args.cont ()) ) - - //---------------------------------- - // DERIVED ASYNC RESYNC HELPERS - - let delimitContinuationsWith (delimiter : TrampolineHolder -> (unit -> FakeUnitValue) -> FakeUnitValue) ({ aux = aux } as args) = - let trampolineHolder = aux.trampolineHolder - { args with - cont = (fun x -> delimiter trampolineHolder (fun () -> args.cont x)) - aux = { aux with - econt = (fun x -> delimiter trampolineHolder (fun () -> aux.econt x )); - ccont = (fun x -> delimiter trampolineHolder (fun () -> aux.ccont x)) - } - } + protectUserCodeAsAsync (fun ctxt -> + ctxt.aux.trampolineHolder.QueueWorkItem (fun () -> ctxt.cont ())) - let getSyncContext () = System.Threading.SynchronizationContext.Current + let getSyncContext () = SynchronizationContext.Current - let postOrQueue (ctxt : SynchronizationContext) (trampolineHolder:TrampolineHolder) f = - match ctxt with + let postOrQueue (syncCtxt : SynchronizationContext) (trampolineHolder:TrampolineHolder) f = + match syncCtxt with | null -> trampolineHolder.QueueWorkItem f - | _ -> trampolineHolder.Post ctxt f + | _ -> trampolineHolder.Post syncCtxt f - - let delimitSyncContext args = + let delimitSyncContext ctxt = match getSyncContext () with - | null -> args - | ctxt -> - let aux = args.aux + | null -> ctxt + | syncCtxt -> + let aux = ctxt.aux let trampolineHolder = aux.trampolineHolder - { args with - cont = (fun x -> trampolineHolder.Post ctxt (fun () -> args.cont x)) + { ctxt with + cont = (fun x -> trampolineHolder.Post syncCtxt (fun () -> ctxt.cont x)) aux = { aux with - econt = (fun x -> trampolineHolder.Post ctxt (fun () -> aux.econt x )); - ccont = (fun x -> trampolineHolder.Post ctxt (fun () -> aux.ccont x)) - } + econt = (fun x -> trampolineHolder.Post syncCtxt (fun () -> aux.econt x )) + ccont = (fun x -> trampolineHolder.Post syncCtxt (fun () -> aux.ccont x)) } } - // When run, ensures that each of the continuations of the process are run in the same synchronization context. - let protectedPrimitiveWithResync f = - protectedPrimitive(fun args -> - let args = delimitSyncContext args - f args) - - let unprotectedPrimitiveWithResync f = - MakeAsync(fun args -> - let args = delimitSyncContext args - f args) - - [] - [] - type Latch() = - let mutable i = 0 - member this.Enter() = Interlocked.CompareExchange(&i, 1, 0) = 0 + // When run, ensures that each of the continuations of the process are run in the same synchronization ctxt. + let protectUserCodeAsAsyncWithResync f = + protectUserCodeAsAsync (fun ctxt -> + let ctxtWithSync = delimitSyncContext ctxt + f ctxtWithSync) [] [] @@ -734,45 +694,51 @@ namespace Microsoft.FSharp.Control [] [] - type SuspendedAsync<'T>(args : AsyncParams<'T>) = - let ctxt = getSyncContext () + type SuspendedAsync<'T>(ctxt : AsyncContext<'T>) = + + let syncCtxt = getSyncContext () + let thread = - match ctxt with - | null -> null // saving a thread-local access - | _ -> Thread.CurrentThread - let trampolineHolder = args.aux.trampolineHolder - member this.ContinueImmediate res = - let action () = args.cont res - let inline executeImmediately () = trampolineHolder.ExecuteAsyncAction action - let currentCtxt = System.Threading.SynchronizationContext.Current - match ctxt, currentCtxt with + match syncCtxt with + | null -> null // saving a thread-local access + | _ -> Thread.CurrentThread + + let trampolineHolder = ctxt.aux.trampolineHolder + + member __.ContinueImmediate res = + let action () = ctxt.cont res + let inline executeImmediately () = trampolineHolder.ExecuteWithTrampoline action + let currentSyncCtxt = SynchronizationContext.Current + match syncCtxt, currentSyncCtxt with | null, null -> executeImmediately () // See bug 370350; this logic is incorrect from the perspective of how SynchronizationContext is meant to work, // but the logic works for mainline scenarios (WinForms/WPF/ASP.NET) and we won't change it again. - | _ when Object.Equals(ctxt, currentCtxt) && thread.Equals(Thread.CurrentThread) -> - executeImmediately () + | _ when Object.Equals(syncCtxt, currentSyncCtxt) && thread.Equals(Thread.CurrentThread) -> + executeImmediately () | _ -> - postOrQueue ctxt trampolineHolder action - - member this.ContinueWithPostOrQueue res = - postOrQueue ctxt trampolineHolder (fun () -> args.cont res) + postOrQueue syncCtxt trampolineHolder action - + member __.ContinueWithPostOrQueue res = + postOrQueue syncCtxt trampolineHolder (fun () -> ctxt.cont res) - // A utility type to provide a synchronization point between an asynchronous computation - // and callers waiting on the result of that computation. - // - // Use with care! + /// A utility type to provide a synchronization point between an asynchronous computation + /// and callers waiting on the result of that computation. + /// + /// Use with care! [] [] type ResultCell<'T>() = + let mutable result = None + // The continuations for the result let mutable savedConts : list> = [] + // The WaitHandle event for the result. Only created if needed, and set to null when disposed. let mutable resEvent = null let mutable disposed = false + // All writers of result are protected by lock on syncRoot. let syncRoot = new Object() @@ -837,6 +803,7 @@ namespace Microsoft.FSharp.Control // Setting the event need to happen under lock so as not to race with Close() ev.Set () |> ignore List.rev savedConts) + // Run the action outside the lock match grabbedConts with | [] -> FakeUnit @@ -851,7 +818,7 @@ namespace Microsoft.FSharp.Control member x.ResultAvailable = result.IsSome member x.AwaitResult = - MakeAsync(fun args -> + MakeAsync (fun ctxt -> // Check if a result is available synchronously let resOpt = match result with @@ -863,11 +830,11 @@ namespace Microsoft.FSharp.Control result | None -> // Otherwise save the continuation and call it in RegisterResult - savedConts <- (SuspendedAsync<_>(args))::savedConts + savedConts <- (SuspendedAsync<_>(ctxt))::savedConts None ) match resOpt with - | Some res -> args.cont res + | Some res -> ctxt.cont res | None -> FakeUnit ) @@ -903,12 +870,17 @@ namespace Microsoft.FSharp.Control // timed out None - open AsyncImpl - - type private Closure<'T>(f) = - member x.Invoke(sender:obj, a:'T) : unit = ignore(sender); f(a) + type FuncDelegate<'T>(f) = + member __.Invoke(sender:obj, a:'T) : unit = ignore(sender); f(a) + static member Create<'Delegate when 'Delegate :> Delegate>(f) = + let obj = FuncDelegate<'T>(f) +#if FX_PORTABLE_OR_NETSTANDARD + let invokeMeth = (typeof>).GetMethod("Invoke", BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.Instance) + System.Delegate.CreateDelegate(typeof<'Delegate>, obj, invokeMeth) :?> 'Delegate +#else + System.Delegate.CreateDelegate(typeof<'Delegate>, obj, "Invoke") :?> 'Delegate +#endif - module CancellationTokenOps = /// Run the asynchronous workflow and wait for its result. let private RunSynchronouslyInAnotherThread (token:CancellationToken,computation,timeout) = let token,innerCTS = @@ -920,12 +892,12 @@ namespace Microsoft.FSharp.Control let subSource = new LinkedSubSource(token) subSource.Token, Some subSource - use resultCell = new ResultCell>() + use resultCell = new ResultCell>() queueAsync token - (fun res -> resultCell.RegisterResult(Ok(res),reuseThread=true)) - (fun edi -> resultCell.RegisterResult(Error(edi),reuseThread=true)) - (fun exn -> resultCell.RegisterResult(Canceled(exn),reuseThread=true)) + (fun res -> resultCell.RegisterResult(AsyncResult.Ok(res),reuseThread=true)) + (fun edi -> resultCell.RegisterResult(AsyncResult.Error(edi),reuseThread=true)) + (fun exn -> resultCell.RegisterResult(AsyncResult.Canceled(exn),reuseThread=true)) computation |> unfake @@ -946,17 +918,17 @@ namespace Microsoft.FSharp.Control commit res let private RunSynchronouslyInCurrentThread (token:CancellationToken,computation) = - use resultCell = new ResultCell>() + use resultCell = new ResultCell>() let trampolineHolder = TrampolineHolder() - trampolineHolder.ExecuteAsyncAction + trampolineHolder.ExecuteWithTrampoline (fun () -> startA token trampolineHolder - (fun res -> resultCell.RegisterResult(Ok(res),reuseThread=true)) - (fun edi -> resultCell.RegisterResult(Error(edi),reuseThread=true)) - (fun exn -> resultCell.RegisterResult(Canceled(exn),reuseThread=true)) + (fun res -> resultCell.RegisterResult(AsyncResult.Ok(res),reuseThread=true)) + (fun edi -> resultCell.RegisterResult(AsyncResult.Error(edi),reuseThread=true)) + (fun exn -> resultCell.RegisterResult(AsyncResult.Canceled(exn),reuseThread=true)) computation) |> unfake @@ -965,7 +937,7 @@ namespace Microsoft.FSharp.Control let RunSynchronously (token:CancellationToken,computation,timeout) = // Reuse the current ThreadPool thread if possible. Unfortunately // Thread.IsThreadPoolThread isn't available on all profiles so - // we approximate it by testing synchronization context for null. + // we approximate it by testing synchronization ctxt for null. match SynchronizationContext.Current, timeout with | null, None -> RunSynchronouslyInCurrentThread (token, computation) // When the timeout is given we need a dedicated thread @@ -979,25 +951,19 @@ namespace Microsoft.FSharp.Control // for the cancellation and run the computation in another thread. | _ -> RunSynchronouslyInAnotherThread (token, computation, timeout) - let Start (token:CancellationToken,computation) = + let Start token computation = queueAsync - token - (fun () -> FakeUnit) // nothing to do on success - (fun edi -> edi.ThrowAny()) // raise exception in child - (fun _ -> FakeUnit) // ignore cancellation in child - computation - |> unfake + token + (fun () -> FakeUnit) // nothing to do on success + (fun edi -> edi.ThrowAny()) // raise exception in child + (fun _ -> FakeUnit) // ignore cancellation in child + computation + |> unfake let StartWithContinuations(token:CancellationToken, a:Async<'T>, cont, econt, ccont) : unit = startAsync token (cont >> fake) (econt >> fake) (ccont >> fake) a |> ignore - type VolatileBarrier() = - [] - let mutable isStopped = false - member __.Proceed = not isStopped - member __.Stop() = isStopped <- true - - let StartAsTask (token:CancellationToken, computation : Async<_>,taskCreationOptions) : Task<_> = + let StartAsTask token computation taskCreationOptions = let taskCreationOptions = defaultArg taskCreationOptions TaskCreationOptions.None let tcs = new TaskCompletionSource<_>(taskCreationOptions) @@ -1014,42 +980,190 @@ namespace Microsoft.FSharp.Control |> unfake task + // Helper to attach continuation to the given task. + // Should be invoked as a part of protectUserCodeAsAsync(withResync) call + let taskContinueWith (task: Task<'T>) ctxt useCcontForTaskCancellation = + + let continuation (completedTask : Task<_>) : unit = + ctxt.aux.trampolineHolder.ExecuteWithTrampoline ((fun () -> + if completedTask.IsCanceled then + if useCcontForTaskCancellation + then ctxt.CallCancellationContinuation () + else ctxt.CallExceptionContinuation (ExceptionDispatchInfo.Capture(new TaskCanceledException(completedTask))) + elif completedTask.IsFaulted then + ctxt.CallExceptionContinuation (MayLoseStackTrace(completedTask.Exception)) + else + ctxt.cont completedTask.Result)) |> unfake + + task.ContinueWith(Action>(continuation)) |> ignore |> fake + + let taskContinueWithUnit (task : Task) ctxt useCcontForTaskCancellation = + + let continuation (completedTask : Task) : unit = + ctxt.aux.trampolineHolder.ExecuteWithTrampoline ((fun () -> + if completedTask.IsCanceled then + if useCcontForTaskCancellation + then ctxt.CallCancellationContinuation () + else ctxt.CallExceptionContinuation (ExceptionDispatchInfo.Capture(new TaskCanceledException(completedTask))) + elif completedTask.IsFaulted then + ctxt.CallExceptionContinuation (MayLoseStackTrace(completedTask.Exception)) + else + ctxt.cont ())) |> unfake + + task.ContinueWith(Action(continuation)) |> ignore |> fake + + [] + [] + type AsyncIAsyncResult<'T>(callback: System.AsyncCallback,state:obj) = + + // This gets set to false if the result is not available by the + // time the IAsyncResult is returned to the caller of Begin + let mutable completedSynchronously = true + + let mutable disposed = false + + let cts = new CancellationTokenSource() + + let result = new ResultCell>() + + member s.SetResult(v: AsyncResult<'T>) = + result.RegisterResult(v,reuseThread=true) |> unfake + match callback with + | null -> () + | d -> + // The IASyncResult becomes observable here + d.Invoke (s :> System.IAsyncResult) + + member s.GetResult() = + match result.TryWaitForResultSynchronously (-1) with + | Some (AsyncResult.Ok v) -> v + | Some (AsyncResult.Error edi) -> edi.ThrowAny() + | Some (AsyncResult.Canceled err) -> raise err + | None -> failwith "unreachable" + + member x.IsClosed = disposed + member x.Close() = + if not disposed then + disposed <- true + cts.Dispose() + result.Close() + + member x.Token = cts.Token + + member x.CancelAsync() = cts.Cancel() + + member x.CheckForNotSynchronous() = + if not result.ResultAvailable then + completedSynchronously <- false + + interface System.IAsyncResult with + member x.IsCompleted = result.ResultAvailable + member x.CompletedSynchronously = completedSynchronously + member x.AsyncWaitHandle = result.GetWaitHandle() + member x.AsyncState = state + + interface System.IDisposable with + member x.Dispose() = x.Close() + + module AsBeginEndHelpers = + let beginAction (computation, callback, state) = + let aiar = new AsyncIAsyncResult<'T>(callback, state) + let cont v = aiar.SetResult (AsyncResult.Ok v) + let econt v = aiar.SetResult (AsyncResult.Error v) + let ccont v = aiar.SetResult (AsyncResult.Canceled v) + StartWithContinuations(aiar.Token, computation, cont, econt, ccont) + aiar.CheckForNotSynchronous() + (aiar :> IAsyncResult) + + let endAction<'T> (iar:IAsyncResult) = + match iar with + | :? AsyncIAsyncResult<'T> as aiar -> + if aiar.IsClosed then + raise (System.ObjectDisposedException("AsyncResult")) + else + let res = aiar.GetResult() + aiar.Close () + res + | _ -> + invalidArg "iar" (SR.GetString(SR.mismatchIAREnd)) + + let cancelAction<'T>(iar:IAsyncResult) = + match iar with + | :? AsyncIAsyncResult<'T> as aiar -> + aiar.CancelAsync() + | _ -> + invalidArg "iar" (SR.GetString(SR.mismatchIARCancel)) + + open AsyncPrimitives + + [] + [] + type AsyncBuilder() = + member b.Zero () = unitAsync + + member inline __.Delay generator = delayA generator + + member inline __.Return value = resultA value + + member inline __.ReturnFrom (computation:Async<_>) = computation + + member inline __.Bind (computation, binder) = bindA true computation binder + + member __.Using (resource, binder) = usingA resource binder + + member __.While (guard, computation) = whileA guard computation + + member __.For (sequence, body) = forA sequence body + + member inline __.Combine (computation1, computation2) = sequentialA computation1 computation2 + + member inline __.TryFinally (computation, compensation) = tryFinallyA compensation computation + + member __.TryWith (computation, catchHandler) = tryWithExnA catchHandler computation + + module AsyncImpl = + let async = AsyncBuilder() + + + open AsyncImpl + [] [] type Async = - static member CancellationToken = CancellationTokenAsync + static member CancellationToken = GetCancellationTokenAsync - static member CancelCheck () = UnitAsync + static member CancelCheck () = unitAsync static member FromContinuations (callback : ('T -> unit) * (exn -> unit) * (OperationCanceledException -> unit) -> unit) : Async<'T> = - MakeAsync (fun ({ aux = aux } as args) -> - if args.IsCancellationRequested then - args.CallCancellationContinuation () + MakeAsync (fun ctxt -> + if ctxt.IsCancellationRequested then + ctxt.CallCancellationContinuation () else - let underCurrentThreadStack = ref true - let contToTailCall = ref None + let mutable underCurrentThreadStack = true + let mutable contToTailCall = None let thread = Thread.CurrentThread let latch = Latch() + let aux = ctxt.aux let once cont x = if not(latch.Enter()) then invalidOp(SR.GetString(SR.controlContinuationInvokedMultipleTimes)) - if Thread.CurrentThread.Equals(thread) && !underCurrentThreadStack then - contToTailCall := Some(fun () -> cont x) + if Thread.CurrentThread.Equals(thread) && underCurrentThreadStack then + contToTailCall <- Some(fun () -> cont x) else if Trampoline.ThisThreadHasTrampoline then - let ctxt = getSyncContext() - postOrQueue ctxt aux.trampolineHolder (fun () -> cont x) |> unfake + let syncCtxt = getSyncContext() + postOrQueue syncCtxt aux.trampolineHolder (fun () -> cont x) |> unfake else - aux.trampolineHolder.ExecuteAsyncAction (fun () -> cont x ) |> unfake + aux.trampolineHolder.ExecuteWithTrampoline (fun () -> cont x ) |> unfake try - callback (once args.cont, (fun exn -> once aux.econt (MayLoseStackTrace(exn))), once aux.ccont) + callback (once ctxt.cont, (fun exn -> once aux.econt (MayLoseStackTrace(exn))), once aux.ccont) with exn -> if not(latch.Enter()) then invalidOp(SR.GetString(SR.controlContinuationInvokedMultipleTimes)) let edi = ExceptionDispatchInfo.RestoreOrCapture(exn) aux.econt edi |> unfake - underCurrentThreadStack := false + underCurrentThreadStack <- false - match !contToTailCall with + match contToTailCall with | Some k -> k() | _ -> FakeUnit ) @@ -1057,53 +1171,59 @@ namespace Microsoft.FSharp.Control static member DefaultCancellationToken = defaultCancellationTokenSource.Token static member CancelDefaultToken() = + let cts = defaultCancellationTokenSource + // set new CancellationTokenSource before calling Cancel - otherwise if Cancel throws token will stay unchanged defaultCancellationTokenSource <- new CancellationTokenSource() - // we do not dispose the old default CTS - let GC collect it + cts.Cancel() + // we do not dispose the old default CTS - let GC collect it static member Catch (computation: Async<'T>) = - MakeAsync (fun ({ aux = aux } as args) -> - startA aux.token aux.trampolineHolder (Choice1Of2 >> args.cont) (fun edi -> args.cont (Choice2Of2 (edi.GetAssociatedSourceException()))) aux.ccont computation) + MakeAsync (fun ctxt -> + let cont = (Choice1Of2 >> ctxt.cont) + let econt (edi: ExceptionDispatchInfo) = ctxt.cont (Choice2Of2 (edi.GetAssociatedSourceException())) + let ctxt = { cont = cont; aux = { ctxt.aux with econt = econt } } + computation.Invoke ctxt) static member RunSynchronously (computation: Async<'T>,?timeout,?cancellationToken:CancellationToken) = let timeout,token = match cancellationToken with - | None -> timeout,defaultCancellationTokenSource.Token - | Some token when not token.CanBeCanceled -> timeout, token - | Some token -> None, token - CancellationTokenOps.RunSynchronously(token, computation, timeout) + | None -> timeout,defaultCancellationTokenSource.Token + | Some token when not token.CanBeCanceled -> timeout, token + | Some token -> None, token + AsyncPrimitives.RunSynchronously(token, computation, timeout) static member Start (computation, ?cancellationToken) = - let token = defaultArg cancellationToken defaultCancellationTokenSource.Token - CancellationTokenOps.Start (token, computation) + let ct = defaultArg cancellationToken defaultCancellationTokenSource.Token + AsyncPrimitives.Start ct computation static member StartAsTask (computation,?taskCreationOptions,?cancellationToken)= - let token = defaultArg cancellationToken defaultCancellationTokenSource.Token - CancellationTokenOps.StartAsTask(token,computation,taskCreationOptions) + let ct = defaultArg cancellationToken defaultCancellationTokenSource.Token + AsyncPrimitives.StartAsTask ct computation taskCreationOptions static member StartChildAsTask (computation,?taskCreationOptions) = - async { let! ct = CancellationTokenAsync - return CancellationTokenOps.StartAsTask(ct,computation, taskCreationOptions) } + async { let! ct = GetCancellationTokenAsync + return AsyncPrimitives.StartAsTask ct computation taskCreationOptions } - type Async with static member Parallel (computations: seq>) = - MakeAsync (fun args -> + MakeAsync (fun ctxt -> let tasks,result = try Seq.toArray computations, None // manually protect eval of seq with exn -> let edi = ExceptionDispatchInfo.RestoreOrCapture(exn) - null, Some(errorT args edi) + null, Some (ctxt.CallExceptionContinuation edi) match result with | Some r -> r | None -> - if tasks.Length = 0 then args.cont [| |] else // must not be in a 'protect' if we call cont explicitly; if cont throws, it should unwind the stack, preserving Dev10 behavior - protectedPrimitiveCore args (fun args -> - let ({ aux = aux } as args) = delimitSyncContext args // manually resync + if tasks.Length = 0 then ctxt.cont [| |] else // must not be in a 'protect' if we call cont explicitly; if cont throws, it should unwind the stack, preserving Dev10 behavior + protectUserCodeInCtxt ctxt (fun ctxt -> + let ctxtWithSync = delimitSyncContext ctxt // manually resync + let aux = ctxtWithSync.aux let count = ref tasks.Length let firstExn = ref None let results = Array.zeroCreate tasks.Length @@ -1115,9 +1235,9 @@ namespace Microsoft.FSharp.Control if (remaining = 0) then innerCTS.Dispose() match (!firstExn) with - | None -> trampolineHolder.ExecuteAsyncAction(fun () -> args.cont results) - | Some (Choice1Of2 exn) -> trampolineHolder.ExecuteAsyncAction(fun () -> aux.econt exn) - | Some (Choice2Of2 cexn) -> trampolineHolder.ExecuteAsyncAction(fun () -> aux.ccont cexn) + | None -> trampolineHolder.ExecuteWithTrampoline (fun () -> ctxtWithSync.cont results) + | Some (Choice1Of2 exn) -> trampolineHolder.ExecuteWithTrampoline (fun () -> aux.econt exn) + | Some (Choice2Of2 cexn) -> trampolineHolder.ExecuteWithTrampoline (fun () -> aux.ccont cexn) else FakeUnit @@ -1156,17 +1276,18 @@ namespace Microsoft.FSharp.Control FakeUnit)) static member Choice(computations : Async<'T option> seq) : Async<'T option> = - MakeAsync(fun args -> + MakeAsync (fun ctxt -> let result = try Seq.toArray computations |> Choice1Of2 with exn -> ExceptionDispatchInfo.RestoreOrCapture exn |> Choice2Of2 match result with - | Choice2Of2 edi -> args.aux.econt edi - | Choice1Of2 [||] -> args.cont None + | Choice2Of2 edi -> ctxt.CallExceptionContinuation edi + | Choice1Of2 [||] -> ctxt.cont None | Choice1Of2 computations -> - protectedPrimitiveCore args (fun args -> - let ({ aux = aux } as args) = delimitSyncContext args + protectUserCodeInCtxt ctxt (fun ctxt -> + let ctxt = delimitSyncContext ctxt + let aux = ctxt.aux let noneCount = ref 0 let exnCount = ref 0 let innerCts = new LinkedSubSource(aux.token) @@ -1176,25 +1297,25 @@ namespace Microsoft.FSharp.Control match result with | Some _ -> if Interlocked.Increment exnCount = 1 then - innerCts.Cancel(); trampolineHolder.ExecuteAsyncAction(fun () -> args.cont result) + innerCts.Cancel(); trampolineHolder.ExecuteWithTrampoline (fun () -> ctxt.cont result) else FakeUnit | None -> if Interlocked.Increment noneCount = computations.Length then - innerCts.Cancel(); trampolineHolder.ExecuteAsyncAction(fun () -> args.cont None) + innerCts.Cancel(); trampolineHolder.ExecuteWithTrampoline (fun () -> ctxt.cont None) else FakeUnit let econt (exn : ExceptionDispatchInfo) = if Interlocked.Increment exnCount = 1 then - innerCts.Cancel(); trampolineHolder.ExecuteAsyncAction(fun () -> args.aux.econt exn) + innerCts.Cancel(); trampolineHolder.ExecuteWithTrampoline (fun () -> ctxt.aux.econt exn) else FakeUnit let ccont (exn : OperationCanceledException) = if Interlocked.Increment exnCount = 1 then - innerCts.Cancel(); trampolineHolder.ExecuteAsyncAction(fun () -> args.aux.ccont exn) + innerCts.Cancel(); trampolineHolder.ExecuteWithTrampoline (fun () -> ctxt.aux.ccont exn) else FakeUnit @@ -1203,75 +1324,41 @@ namespace Microsoft.FSharp.Control FakeUnit)) - // Contains helpers that will attach continuation to the given task. - // Should be invoked as a part of protectedPrimitive(withResync) call - module TaskHelpers = - let continueWith (task : Task<'T>, args, useCcontForTaskCancellation) = - - let continuation (completedTask : Task<_>) : unit = - args.aux.trampolineHolder.ExecuteAsyncAction((fun () -> - if completedTask.IsCanceled then - if useCcontForTaskCancellation - then args.aux.ccont (new OperationCanceledException(args.aux.token)) - else args.aux.econt (ExceptionDispatchInfo.Capture(new TaskCanceledException(completedTask))) - elif completedTask.IsFaulted then - args.aux.econt (MayLoseStackTrace(completedTask.Exception)) - else - args.cont completedTask.Result)) |> unfake - - task.ContinueWith(Action>(continuation)) |> ignore |> fake - - let continueWithUnit (task : Task, args, useCcontForTaskCancellation) = - - let continuation (completedTask : Task) : unit = - args.aux.trampolineHolder.ExecuteAsyncAction((fun () -> - if completedTask.IsCanceled then - if useCcontForTaskCancellation - then args.aux.ccont (new OperationCanceledException(args.aux.token)) - else args.aux.econt (ExceptionDispatchInfo.Capture(new TaskCanceledException(completedTask))) - elif completedTask.IsFaulted then - args.aux.econt (MayLoseStackTrace(completedTask.Exception)) - else - args.cont ())) |> unfake - - task.ContinueWith(Action(continuation)) |> ignore |> fake - - type Async with - /// StartWithContinuations, except the exception continuation is given an ExceptionDispatchInfo static member StartWithContinuationsUsingDispatchInfo(computation:Async<'T>, continuation, exceptionContinuation, cancellationContinuation, ?cancellationToken) : unit = let token = defaultArg cancellationToken defaultCancellationTokenSource.Token - CancellationTokenOps.StartWithContinuations(token, computation, continuation, exceptionContinuation, cancellationContinuation) + AsyncPrimitives.StartWithContinuations(token, computation, continuation, exceptionContinuation, cancellationContinuation) static member StartWithContinuations(computation:Async<'T>, continuation, exceptionContinuation, cancellationContinuation, ?cancellationToken) : unit = Async.StartWithContinuationsUsingDispatchInfo(computation, continuation, (fun edi -> exceptionContinuation (edi.GetAssociatedSourceException())), cancellationContinuation, ?cancellationToken=cancellationToken) static member StartImmediate(computation:Async, ?cancellationToken) : unit = let token = defaultArg cancellationToken defaultCancellationTokenSource.Token - CancellationTokenOps.StartWithContinuations(token, computation, id, (fun edi -> edi.ThrowAny()), ignore) + AsyncPrimitives.StartWithContinuations(token, computation, id, (fun edi -> edi.ThrowAny()), ignore) #if FSCORE_PORTABLE_NEW static member Sleep(dueTime : int) : Async = - // use combo protectedPrimitiveWithResync + continueWith instead of AwaitTask so we can pass cancellation token to the Delay task - unprotectedPrimitiveWithResync ( fun ({ aux = aux} as args) -> + // use combo protectUserCodeAsAsyncWithResync + taskContinueWith instead of AwaitTask so we can pass cancellation token to the Delay task + protectUserCodeAsAsyncWithResync ( fun ctxt -> let mutable edi = null let task = try - Task.Delay(dueTime, aux.token) + Task.Delay(dueTime, ctxt.aux.token) with exn -> edi <- ExceptionDispatchInfo.RestoreOrCapture(exn) null match edi with - | null -> TaskHelpers.continueWithUnit (task, args, true) - | _ -> aux.econt edi + | null -> TaskHelpers.taskContinueWithUnit task ctxt true + | _ -> ctxt.CallExceptionContinutiation edi ) #else static member Sleep(millisecondsDueTime) : Async = - unprotectedPrimitiveWithResync (fun ({ aux = aux } as args) -> + protectUserCodeAsAsyncWithResync (fun ctxt -> + let aux = ctxt.aux let timer = ref (None : Timer option) - let savedCont = args.cont + let savedCont = ctxt.cont let savedCCont = aux.ccont let latch = new Latch() let registration = @@ -1281,7 +1368,7 @@ namespace Microsoft.FSharp.Control match !timer with | None -> () | Some t -> t.Dispose() - aux.trampolineHolder.ExecuteAsyncAction(fun () -> savedCCont(new OperationCanceledException(aux.token))) |> unfake + aux.trampolineHolder.ExecuteWithTrampoline (fun () -> savedCCont(new OperationCanceledException(aux.token))) |> unfake ), null) let mutable edi = null @@ -1301,7 +1388,7 @@ namespace Microsoft.FSharp.Control | None -> () | Some t -> t.Dispose() // Now we're done, so call the continuation - aux.trampolineHolder.ExecuteAsyncAction (fun () -> savedCont()) |> unfake), + aux.trampolineHolder.ExecuteWithTrampoline (fun () -> savedCont()) |> unfake), null, dueTime=millisecondsDueTime, period = -1) |> Some with exn -> if latch.Enter() then @@ -1330,7 +1417,8 @@ namespace Microsoft.FSharp.Control #endif async.Return ok) else - protectedPrimitiveWithResync(fun ({ aux = aux } as args) -> + protectUserCodeAsAsyncWithResync(fun ctxt -> + let aux = ctxt.aux let rwh = ref (None : RegisteredWaitHandle option) let latch = Latch() let rec cancelHandler = @@ -1346,7 +1434,7 @@ namespace Microsoft.FSharp.Control and registration : CancellationTokenRegistration = aux.token.Register(cancelHandler, null) - let savedCont = args.cont + let savedCont = ctxt.cont try lock rwh (fun () -> rwh := Some(ThreadPool.RegisterWaitForSingleObject @@ -1356,7 +1444,7 @@ namespace Microsoft.FSharp.Control lock rwh (fun () -> rwh.Value.Value.Unregister(null) |> ignore) rwh := None registration.Dispose() - aux.trampolineHolder.ExecuteAsyncAction (fun () -> savedCont (not timeOut)) |> unfake), + aux.trampolineHolder.ExecuteWithTrampoline (fun () -> savedCont (not timeOut)) |> unfake), state=null, millisecondsTimeOutInterval=millisecondsTimeout, executeOnlyOnce=true)); @@ -1374,32 +1462,29 @@ namespace Microsoft.FSharp.Control else return! Async.AwaitWaitHandle(iar.AsyncWaitHandle, ?millisecondsTimeout=millisecondsTimeout) } - /// Await the result of a result cell without a timeout - static member ReifyResult(result:AsyncImplResult<'T>) : Async<'T> = - MakeAsync(fun ({ aux = aux } as args) -> + static member ReifyResult (result:AsyncResult<'T>) : Async<'T> = + MakeAsync (fun ctxt -> (match result with - | Ok v -> args.cont v - | Error exn -> aux.econt exn - | Canceled exn -> aux.ccont exn) ) + | Ok v -> ctxt.cont v + | Error exn -> ctxt.CallExceptionContinuation exn + | Canceled exn -> ctxt.aux.ccont exn) ) /// Await the result of a result cell without a timeout - static member AwaitAndReifyResult(resultCell:ResultCell>) : Async<'T> = + static member AwaitResultCell (resultCell:ResultCell>) : Async<'T> = async { let! result = resultCell.AwaitResult - return! Async.ReifyResult(result) + return! Async.ReifyResult result } - - /// Await the result of a result cell without a timeout /// - /// Always resyncs to the synchronization context if needed, by virtue of it being built + /// Always resyncs to the synchronization ctxt if needed, by virtue of it being built /// from primitives which resync. - static member AsyncWaitAsyncWithTimeout(innerCTS : CancellationTokenSource, resultCell:ResultCell>,millisecondsTimeout) : Async<'T> = + static member AsyncWaitAsyncWithTimeout(innerCTS : CancellationTokenSource, resultCell:ResultCell>,millisecondsTimeout) : Async<'T> = match millisecondsTimeout with | None | Some -1 -> - resultCell |> Async.AwaitAndReifyResult + resultCell |> Async.AwaitResultCell | Some 0 -> async { if resultCell.ResultAvailable then @@ -1423,12 +1508,12 @@ namespace Microsoft.FSharp.Control finally resultCell.Close() } - static member FromBeginEnd(beginAction,endAction,?cancelAction): Async<'T> = - async { let! ct = CancellationTokenAsync + async { let! ct = GetCancellationTokenAsync let resultCell = new ResultCell<_>() let once = Once() + let registration : CancellationTokenRegistration = let onCancel (_:obj) = // Call the cancellation routine @@ -1445,6 +1530,7 @@ namespace Microsoft.FSharp.Control // we assume the operation has already completed. try cancel() with _ -> () ct.Register(Action(onCancel), null) + let callback = new System.AsyncCallback(fun iar -> if not iar.CompletedSynchronously then @@ -1476,107 +1562,18 @@ namespace Microsoft.FSharp.Control registration.Dispose() return endAction iar else - return! Async.AwaitAndReifyResult(resultCell) } + return! Async.AwaitResultCell (resultCell) } static member FromBeginEnd(arg,beginAction,endAction,?cancelAction): Async<'T> = Async.FromBeginEnd((fun (iar,state) -> beginAction(arg,iar,state)), endAction, ?cancelAction=cancelAction) - static member FromBeginEnd(arg1,arg2,beginAction,endAction,?cancelAction): Async<'T> = Async.FromBeginEnd((fun (iar,state) -> beginAction(arg1,arg2,iar,state)), endAction, ?cancelAction=cancelAction) static member FromBeginEnd(arg1,arg2,arg3,beginAction,endAction,?cancelAction): Async<'T> = Async.FromBeginEnd((fun (iar,state) -> beginAction(arg1,arg2,arg3,iar,state)), endAction, ?cancelAction=cancelAction) - - - [] - [] - type AsyncIAsyncResult<'T>(callback: System.AsyncCallback,state:obj) = - // This gets set to false if the result is not available by the - // time the IAsyncResult is returned to the caller of Begin - let mutable completedSynchronously = true - - let mutable disposed = false - - let cts = new CancellationTokenSource() - - let result = new ResultCell>() - - member s.SetResult(v: AsyncImplResult<'T>) = - result.RegisterResult(v,reuseThread=true) |> unfake - match callback with - | null -> () - | d -> - // The IASyncResult becomes observable here - d.Invoke (s :> System.IAsyncResult) - - member s.GetResult() = - match result.TryWaitForResultSynchronously (-1) with - | Some (Ok v) -> v - | Some (Error edi) -> edi.ThrowAny() - | Some (Canceled err) -> raise err - | None -> failwith "unreachable" - - member x.IsClosed = disposed - member x.Close() = - if not disposed then - disposed <- true - cts.Dispose() - result.Close() - - member x.Token = cts.Token - - member x.CancelAsync() = cts.Cancel() - - member x.CheckForNotSynchronous() = - if not result.ResultAvailable then - completedSynchronously <- false - - interface System.IAsyncResult with - member x.IsCompleted = result.ResultAvailable - member x.CompletedSynchronously = completedSynchronously - member x.AsyncWaitHandle = result.GetWaitHandle() - member x.AsyncState = state - - interface System.IDisposable with - member x.Dispose() = x.Close() - - module AsBeginEndHelpers = - let beginAction(computation,callback,state) = - let aiar = new AsyncIAsyncResult<'T>(callback,state) - let cont v = aiar.SetResult (Ok v) - let econt v = aiar.SetResult (Error v) - let ccont v = aiar.SetResult (Canceled v) - CancellationTokenOps.StartWithContinuations(aiar.Token,computation,cont,econt,ccont) - aiar.CheckForNotSynchronous() - (aiar :> IAsyncResult) - - let endAction<'T> (iar:IAsyncResult) = - match iar with - | :? AsyncIAsyncResult<'T> as aiar -> - if aiar.IsClosed then - raise (System.ObjectDisposedException("AsyncResult")) - else - let res = aiar.GetResult() - aiar.Close () - res - | _ -> - invalidArg "iar" (SR.GetString(SR.mismatchIAREnd)) - - let cancelAction<'T>(iar:IAsyncResult) = - match iar with - | :? AsyncIAsyncResult<'T> as aiar -> - aiar.CancelAsync() - | _ -> - invalidArg "iar" (SR.GetString(SR.mismatchIARCancel)) - - - type Async with - - - static member AsBeginEnd<'Arg,'T> (computation:('Arg -> Async<'T>)) : // The 'Begin' member ('Arg * System.AsyncCallback * obj -> System.IAsyncResult) * @@ -1588,7 +1585,7 @@ namespace Microsoft.FSharp.Control beginAction, AsBeginEndHelpers.endAction<'T>, AsBeginEndHelpers.cancelAction<'T> static member AwaitEvent(event:IEvent<'Delegate,'T>, ?cancelAction) : Async<'T> = - async { let! ct = CancellationTokenAsync + async { let! ct = GetCancellationTokenAsync let resultCell = new ResultCell<_>() // Set up the handlers to listen to events and cancellation let once = new Once() @@ -1608,8 +1605,8 @@ namespace Microsoft.FSharp.Control try cancel() with _ -> () ct.Register(Action(onCancel), null) - and obj = - new Closure<'T>(fun eventArgs -> + and del = + FuncDelegate<'T>.Create<'Delegate>(fun eventArgs -> // Stop listening to events event.RemoveHandler(del) // The callback has been activated, so ensure cancellation is not possible beyond this point @@ -1618,31 +1615,23 @@ namespace Microsoft.FSharp.Control // Register the result. This may race with a cancellation result, but // ResultCell allows a race and throws away whichever comes last. resultCell.RegisterResult(res,reuseThread=true) |> unfake) - and del = -#if FX_PORTABLE_OR_NETSTANDARD - let invokeMeth = (typeof>).GetMethod("Invoke", BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.Instance) - System.Delegate.CreateDelegate(typeof<'Delegate>, obj, invokeMeth) :?> 'Delegate -#else - System.Delegate.CreateDelegate(typeof<'Delegate>, obj, "Invoke") :?> 'Delegate -#endif // Start listening to events event.AddHandler(del) // Return the async computation that allows us to await the result - return! Async.AwaitAndReifyResult(resultCell) } + return! Async.AwaitResultCell resultCell } - type Async with static member Ignore (computation: Async<'T>) = ignoreA computation + static member SwitchToNewThread() = switchToNewThread() - static member SwitchToThreadPool() = switchToThreadPool() - type Async with + static member SwitchToThreadPool() = switchToThreadPool() static member StartChild (computation:Async<'T>,?millisecondsTimeout) = async { let resultCell = new ResultCell<_>() - let! ct = CancellationTokenAsync + let! ct = GetCancellationTokenAsync let innerCTS = new CancellationTokenSource() // innerCTS does not require disposal let ctsRef = ref innerCTS let reg = ct.Register( @@ -1665,14 +1654,14 @@ namespace Microsoft.FSharp.Control static member SwitchToContext syncContext = async { match syncContext with | null -> - // no synchronization context, just switch to the thread pool + // no synchronization ctxt, just switch to the thread pool do! Async.SwitchToThreadPool() - | ctxt -> - // post the continuation to the synchronization context - return! switchTo ctxt } + | syncCtxt -> + // post the continuation to the synchronization ctxt + return! switchTo syncCtxt } static member OnCancel interruption = - async { let! ct = CancellationTokenAsync + async { let! ct = GetCancellationTokenAsync // latch protects CancellationTokenRegistration.Dispose from being called twice let latch = Latch() let rec handler (_ : obj) = @@ -1692,18 +1681,14 @@ namespace Microsoft.FSharp.Control whenCancelledA compensation computation static member AwaitTask (task:Task<'T>) : Async<'T> = - protectedPrimitiveWithResync (fun args -> - TaskHelpers.continueWith(task, args, false) - ) + protectUserCodeAsAsyncWithResync (fun ctxt -> taskContinueWith task ctxt false) static member AwaitTask (task:Task) : Async = - protectedPrimitiveWithResync (fun args -> - TaskHelpers.continueWithUnit (task, args, false) - ) + protectUserCodeAsAsyncWithResync (fun ctxt -> taskContinueWithUnit task ctxt false) module CommonExtensions = - open AsyncActions + open AsyncPrimitives type System.IO.Stream with @@ -1712,10 +1697,9 @@ namespace Microsoft.FSharp.Control let offset = defaultArg offset 0 let count = defaultArg count buffer.Length #if FX_NO_BEGINEND_READWRITE - // use combo protectedPrimitiveWithResync + continueWith instead of AwaitTask so we can pass cancellation token to the ReadAsync task - protectedPrimitiveWithResync (fun ({ aux = aux } as args) -> - TaskHelpers.continueWith(stream.ReadAsync(buffer, offset, count, aux.token), args, false) - ) + // use combo protectUserCodeAsAsyncWithResync + taskContinueWith instead of AwaitTask so we can pass cancellation token to the ReadAsync task + protectUserCodeAsAsyncWithResync (fun ctxt -> + TaskHelpers.taskContinueWith(stream.ReadAsync(buffer, offset, count, ctxt.aux.token), ctxt, false)) #else Async.FromBeginEnd (buffer,offset,count,stream.BeginRead,stream.EndRead) #endif @@ -1736,10 +1720,8 @@ namespace Microsoft.FSharp.Control let offset = defaultArg offset 0 let count = defaultArg count buffer.Length #if FX_NO_BEGINEND_READWRITE - // use combo protectedPrimitiveWithResync + continueWith instead of AwaitTask so we can pass cancellation token to the WriteAsync task - protectedPrimitiveWithResync ( fun ({ aux = aux} as args) -> - TaskHelpers.continueWithUnit(stream.WriteAsync(buffer, offset, count, aux.token), args, false) - ) + // use combo protectUserCodeAsAsyncWithResync + taskContinueWith instead of AwaitTask so we can pass cancellation token to the WriteAsync task + protectUserCodeAsAsyncWithResync (fun ctxt -> TaskHelpers.taskContinueWithUnit (stream.WriteAsync(buffer, offset, count, ctxt.aux.token)) ctxt false) #else Async.FromBeginEnd (buffer,offset,count,stream.BeginWrite,stream.EndWrite) #endif @@ -1756,12 +1738,12 @@ namespace Microsoft.FSharp.Control [] // give the extension member a 'nice', unmangled compiled name, unique within this module member x.Subscribe(callback) = x.Subscribe { new IObserver<'Args> with - member x.OnNext(args) = callback args + member x.OnNext(ctxt) = callback ctxt member x.OnError(e) = () member x.OnCompleted() = () } module WebExtensions = - open AsyncActions + open AsyncPrimitives type System.Net.WebRequest with [] // give the extension member a 'nice', unmangled compiled name, unique within this module @@ -1778,7 +1760,7 @@ namespace Microsoft.FSharp.Control | :? System.Net.WebException as webExn when webExn.Status = System.Net.WebExceptionStatus.RequestCanceled && !canceled -> - Async.ReifyResult(AsyncImplResult.Canceled (OperationCanceledException webExn.Message)) + Async.ReifyResult (AsyncResult.Canceled (OperationCanceledException webExn.Message)) | _ -> edi.ThrowAny()) @@ -1789,16 +1771,16 @@ namespace Microsoft.FSharp.Control let downloadAsync = Async.FromContinuations (fun (cont, econt, ccont) -> let userToken = new obj() - let rec delegate' (_: obj) (args : #ComponentModel.AsyncCompletedEventArgs) = + let rec delegate' (_: obj) (ctxt : #ComponentModel.AsyncCompletedEventArgs) = // ensure we handle the completed event from correct download call - if userToken = args.UserState then + if userToken = ctxt.UserState then event.RemoveHandler handle - if args.Cancelled then + if ctxt.Cancelled then ccont (new OperationCanceledException()) - elif isNotNull args.Error then - econt args.Error + elif isNotNull ctxt.Error then + econt ctxt.Error else - cont (result args) + cont (result ctxt) and handle = handler delegate' event.AddHandler handle start userToken @@ -1815,7 +1797,7 @@ namespace Microsoft.FSharp.Control event = this.DownloadStringCompleted, handler = (fun action -> Net.DownloadStringCompletedEventHandler(action)), start = (fun userToken -> this.DownloadStringAsync(address, userToken)), - result = (fun args -> args.Result) + result = (fun ctxt -> ctxt.Result) ) [] // give the extension member a 'nice', unmangled compiled name, unique within this module @@ -1824,7 +1806,7 @@ namespace Microsoft.FSharp.Control event = this.DownloadDataCompleted, handler = (fun action -> Net.DownloadDataCompletedEventHandler(action)), start = (fun userToken -> this.DownloadDataAsync(address, userToken)), - result = (fun args -> args.Result) + result = (fun ctxt -> ctxt.Result) ) [] // give the extension member a 'nice', unmangled compiled name, unique within this module @@ -1843,32 +1825,32 @@ namespace Microsoft.FSharp.Control module AsyncHelpers = let awaitEither a1 a2 = async { - let c = new ResultCell<_>() + let resultCell = new ResultCell<_>() let! ct = Async.CancellationToken let start a f = Async.StartWithContinuationsUsingDispatchInfo(a, - (fun res -> c.RegisterResult(f res |> AsyncImplResult.Ok, reuseThread=false) |> unfake), - (fun edi -> c.RegisterResult(edi |> AsyncImplResult.Error, reuseThread=false) |> unfake), - (fun oce -> c.RegisterResult(oce |> AsyncImplResult.Canceled, reuseThread=false) |> unfake), + (fun res -> resultCell.RegisterResult(f res |> AsyncResult.Ok, reuseThread=false) |> unfake), + (fun edi -> resultCell.RegisterResult(edi |> AsyncResult.Error, reuseThread=false) |> unfake), + (fun oce -> resultCell.RegisterResult(oce |> AsyncResult.Canceled, reuseThread=false) |> unfake), cancellationToken = ct ) start a1 Choice1Of2 start a2 Choice2Of2 - let! result = c.AwaitResult - return! reify result + let! result = resultCell.AwaitResult + return! asyncResultToAsync result } let timeout msec cancellationToken = if msec < 0 then - MakeAsync(fun _ -> FakeUnit) // "block" forever + MakeAsync (fun _ -> FakeUnit) // "block" forever else - let c = new ResultCell<_>() + let resultCell = new ResultCell<_>() Async.StartWithContinuations( computation=Async.Sleep(msec), - continuation=(fun () -> c.RegisterResult((), reuseThread = false) |> unfake), + continuation=(fun () -> resultCell.RegisterResult((), reuseThread = false) |> unfake), exceptionContinuation=ignore, cancellationContinuation=ignore, cancellationToken = cancellationToken) - c.AwaitResult + resultCell.AwaitResult [] [] @@ -1881,7 +1863,7 @@ namespace Microsoft.FSharp.Control // asynchronous receive, either // -- "cont" is non-null and the reader is "activated" by re-scheduling cont in the thread pool; or // -- "pulse" is non-null and the reader is "activated" by setting this event - let mutable savedCont : ((bool -> FakeUnitValue) * TrampolineHolder) option = None + let mutable savedCont : ((bool -> AsyncReturn) * TrampolineHolder) option = None // Readers who have a timeout use this event let mutable pulse : AutoResetEvent = null @@ -1896,7 +1878,7 @@ namespace Microsoft.FSharp.Control pulse let waitOneNoTimeoutOrCancellation = - MakeAsync (fun ({ aux = aux } as args) -> + MakeAsync (fun ctxt -> match savedCont with | None -> let descheduled = @@ -1904,7 +1886,7 @@ namespace Microsoft.FSharp.Control lock syncRoot (fun () -> if arrivals.Count = 0 then // OK, no arrival so deschedule - savedCont <- Some(args.cont, aux.trampolineHolder); + savedCont <- Some(ctxt.cont, ctxt.aux.trampolineHolder); true else false) @@ -1912,41 +1894,41 @@ namespace Microsoft.FSharp.Control FakeUnit else // If we didn't deschedule then run the continuation immediately - args.cont true + ctxt.cont true | Some _ -> failwith "multiple waiting reader continuations for mailbox") - let waitOneWithCancellation(timeout) = + let waitOneWithCancellation timeout = ensurePulse().AsyncWaitOne(millisecondsTimeout=timeout) - let waitOne(timeout) = + let waitOne timeout = if timeout < 0 && not cancellationSupported then waitOneNoTimeoutOrCancellation else waitOneWithCancellation(timeout) - member x.inbox = + member __.inbox = match inboxStore with - | null -> inboxStore <- new System.Collections.Generic.List<'Msg>(1) // ResizeArray + | null -> inboxStore <- new System.Collections.Generic.List<'Msg>(1) | _ -> () inboxStore member x.CurrentQueueLength = lock syncRoot (fun () -> x.inbox.Count + arrivals.Count) - member x.scanArrivalsUnsafe(f) = + member x.ScanArrivalsUnsafe(f) = if arrivals.Count = 0 then None else let msg = arrivals.Dequeue() match f msg with | None -> x.inbox.Add(msg); - x.scanArrivalsUnsafe(f) + x.ScanArrivalsUnsafe(f) | res -> res // Lock the arrivals queue while we scan that - member x.scanArrivals(f) = lock syncRoot (fun () -> x.scanArrivalsUnsafe(f)) + member x.ScanArrivals(f) = lock syncRoot (fun () -> x.ScanArrivalsUnsafe(f)) - member x.scanInbox(f,n) = + member x.ScanInbox(f,n) = match inboxStore with | null -> None | inbox -> @@ -1955,17 +1937,17 @@ namespace Microsoft.FSharp.Control else let msg = inbox.[n] match f msg with - | None -> x.scanInbox (f,n+1) + | None -> x.ScanInbox (f,n+1) | res -> inbox.RemoveAt(n); res - member x.receiveFromArrivalsUnsafe() = + member x.ReceiveFromArrivalsUnsafe() = if arrivals.Count = 0 then None else Some(arrivals.Dequeue()) - member x.receiveFromArrivals() = - lock syncRoot (fun () -> x.receiveFromArrivalsUnsafe()) + member x.ReceiveFromArrivals() = + lock syncRoot (fun () -> x.ReceiveFromArrivalsUnsafe()) - member x.receiveFromInbox() = + member x.ReceiveFromInbox() = match inboxStore with | null -> None | inbox -> @@ -1993,13 +1975,13 @@ namespace Microsoft.FSharp.Control // someone is waiting on the wait handle ev.Set() |> ignore - | Some(action,trampolineHolder) -> + | Some (action, trampolineHolder) -> savedCont <- None trampolineHolder.QueueWorkItem(fun () -> action true) |> unfake) member x.TryScan ((f: 'Msg -> (Async<'T>) option), timeout) : Async<'T option> = let rec scan timeoutAsync (timeoutCts:CancellationTokenSource) = - async { match x.scanArrivals(f) with + async { match x.ScanArrivals(f) with | None -> // Deschedule and wait for a message. When it comes, rescan the arrivals let! ok = AsyncHelpers.awaitEither waitOneNoTimeoutOrCancellation timeoutAsync @@ -2031,7 +2013,7 @@ namespace Microsoft.FSharp.Control return Some res } let rec scanNoTimeout () = - async { match x.scanArrivals(f) with + async { match x.ScanArrivals(f) with | None -> let! ok = waitOne(Timeout.Infinite) if ok then return! scanNoTimeout() @@ -2043,7 +2025,7 @@ namespace Microsoft.FSharp.Control } // Look in the inbox first - async { match x.scanInbox(f,0) with + async { match x.ScanInbox(f,0) with | None when timeout < 0 -> return! scanNoTimeout() | None -> let! ct = Async.CancellationToken @@ -2064,7 +2046,7 @@ namespace Microsoft.FSharp.Control member x.TryReceive(timeout) = let rec processFirstArrival() = - async { match x.receiveFromArrivals() with + async { match x.ReceiveFromArrivals() with | None -> // Make sure the pulse is created if it is going to be needed. // If it isn't, then create it, and go back to the start to @@ -2082,14 +2064,14 @@ namespace Microsoft.FSharp.Control | res -> return res } // look in the inbox first - async { match x.receiveFromInbox() with + async { match x.ReceiveFromInbox() with | None -> return! processFirstArrival() | res -> return res } member x.Receive(timeout) = let rec processFirstArrival() = - async { match x.receiveFromArrivals() with + async { match x.ReceiveFromArrivals() with | None -> // Make sure the pulse is created if it is going to be needed. // If it isn't, then create it, and go back to the start to @@ -2106,7 +2088,7 @@ namespace Microsoft.FSharp.Control | Some res -> return res } // look in the inbox first - async { match x.receiveFromInbox() with + async { match x.ReceiveFromInbox() with | None -> return! processFirstArrival() | Some res -> return res } @@ -2129,12 +2111,13 @@ namespace Microsoft.FSharp.Control [] [] type MailboxProcessor<'Msg>(body, ?cancellationToken) = + let cancellationSupported = cancellationToken.IsSome let cancellationToken = defaultArg cancellationToken Async.DefaultCancellationToken let mailbox = new Mailbox<'Msg>(cancellationSupported) let mutable defaultTimeout = Threading.Timeout.Infinite let mutable started = false - let errorEvent = new Event() + let errorEvent = new Event() member x.CurrentQueueLength = mailbox.CurrentQueueLength // nb. unprotected access gives an approximation of the queue length @@ -2191,47 +2174,51 @@ namespace Microsoft.FSharp.Control resultCell.RegisterResult(reply,reuseThread=false) |> unfake)) mailbox.Post(msg) match timeout with - | Threading.Timeout.Infinite -> - async { let! result = resultCell.AwaitResult - return Some(result) - } + | Threading.Timeout.Infinite -> + async { let! result = resultCell.AwaitResult + return Some(result) } | _ -> - async { use _disposeCell = resultCell - let! ok = resultCell.GetWaitHandle().AsyncWaitOne(millisecondsTimeout=timeout) - let res = (if ok then Some(resultCell.GrabResult()) else None) - return res } + async { use _disposeCell = resultCell + let! ok = resultCell.GetWaitHandle().AsyncWaitOne(millisecondsTimeout=timeout) + let res = (if ok then Some(resultCell.GrabResult()) else None) + return res } member x.PostAndAsyncReply(buildMessage, ?timeout:int) = let timeout = defaultArg timeout defaultTimeout match timeout with - | Threading.Timeout.Infinite -> - // Nothing to dispose, no wait handles used - let resultCell = new ResultCell<_>() - let msg = buildMessage (new AsyncReplyChannel<_>(fun reply -> resultCell.RegisterResult(reply,reuseThread=false) |> unfake)) - mailbox.Post(msg) - resultCell.AwaitResult + | Threading.Timeout.Infinite -> + // Nothing to dispose, no wait handles used + let resultCell = new ResultCell<_>() + let msg = buildMessage (new AsyncReplyChannel<_>(fun reply -> resultCell.RegisterResult(reply,reuseThread=false) |> unfake)) + mailbox.Post(msg) + resultCell.AwaitResult | _ -> - let asyncReply = x.PostAndTryAsyncReply(buildMessage,timeout=timeout) - async { let! res = asyncReply - match res with - | None -> return! raise (TimeoutException(SR.GetString(SR.mailboxProcessorPostAndAsyncReplyTimedOut))) - | Some res -> return res - } + let asyncReply = x.PostAndTryAsyncReply(buildMessage,timeout=timeout) + async { let! res = asyncReply + match res with + | None -> return! raise (TimeoutException(SR.GetString(SR.mailboxProcessorPostAndAsyncReplyTimedOut))) + | Some res -> return res } - member x.Receive(?timeout) = mailbox.Receive(timeout=defaultArg timeout defaultTimeout) - member x.TryReceive(?timeout) = mailbox.TryReceive(timeout=defaultArg timeout defaultTimeout) - member x.Scan(scanner: 'Msg -> (Async<'T>) option,?timeout) = mailbox.Scan(scanner,timeout=defaultArg timeout defaultTimeout) - member x.TryScan(scanner: 'Msg -> (Async<'T>) option,?timeout) = mailbox.TryScan(scanner,timeout=defaultArg timeout defaultTimeout) + member __.Receive(?timeout) = + mailbox.Receive(timeout=defaultArg timeout defaultTimeout) + + member __.TryReceive(?timeout) = + mailbox.TryReceive(timeout=defaultArg timeout defaultTimeout) + + member __.Scan(scanner: 'Msg -> (Async<'T>) option,?timeout) = + mailbox.Scan(scanner,timeout=defaultArg timeout defaultTimeout) + + member __.TryScan(scanner: 'Msg -> (Async<'T>) option,?timeout) = + mailbox.TryScan(scanner,timeout=defaultArg timeout defaultTimeout) interface System.IDisposable with - member x.Dispose() = (mailbox :> IDisposable).Dispose() + member __.Dispose() = (mailbox :> IDisposable).Dispose() static member Start(body,?cancellationToken) = - let mb = new MailboxProcessor<'Msg>(body,?cancellationToken=cancellationToken) - mb.Start(); - mb - + let mailboxProcessor = new MailboxProcessor<'Msg>(body,?cancellationToken=cancellationToken) + mailboxProcessor.Start() + mailboxProcessor [] [] @@ -2284,11 +2271,11 @@ namespace Microsoft.FSharp.Control let pairwise (sourceEvent : IEvent<'Delegate,'T>) : IEvent<'T * 'T> = let ev = new Event<'T * 'T>() let lastArgs = ref None - sourceEvent.Add(fun args2 -> + sourceEvent.Add(fun context2 -> (match !lastArgs with | None -> () - | Some args1 -> ev.Trigger(args1,args2)); - lastArgs := Some args2); + | Some context1 -> ev.Trigger(context1,context2)); + lastArgs := Some context2); ev.Publish @@ -2407,11 +2394,11 @@ namespace Microsoft.FSharp.Control member x.Subscribe(observer) = let lastArgs = ref None source.Subscribe { new BasicObserver<'T>() with - member x.Next(args2) = + member x.Next(context2) = match !lastArgs with | None -> () - | Some args1 -> observer.OnNext (args1,args2) - lastArgs := Some args2 + | Some context1 -> observer.OnNext (context1,context2) + lastArgs := Some context2 member x.Error(e) = observer.OnError(e) member x.Completed() = observer.OnCompleted() } } diff --git a/src/fsharp/FSharp.Core/control.fsi b/src/fsharp/FSharp.Core/control.fsi index 6bcbf64e991..f4a53b0e5ca 100644 --- a/src/fsharp/FSharp.Core/control.fsi +++ b/src/fsharp/FSharp.Core/control.fsi @@ -415,23 +415,23 @@ namespace Microsoft.FSharp.Control computation:Async * ?cancellationToken:CancellationToken-> unit /// Opaque type for generated code - type FakeUnitValue + type AsyncReturn /// Opaque type for generated code [] - type AsyncParams<'T> = + type AsyncContext<'T> = member IsCancellationRequested: bool - member CallSuccessContinuation: 'T -> FakeUnitValue - member CallCancellationContinuation: unit -> FakeUnitValue + member CallSuccessContinuation: 'T -> AsyncReturn + member CallCancellationContinuation: unit -> AsyncReturn + //member CallExceptionContinuation: System.Runtime.ExceptionServices.ExceptionDispatchInfo -> AsyncReturn [] /// Entry points for generated code - module AsyncActions = - val MakeAsync: f:(AsyncParams<'T> -> FakeUnitValue) -> Async<'T> - val UnitAsync: Async - val ExecuteUserCode: args:AsyncParams<'T> -> f:('U -> Async<'T>) -> 'U -> FakeUnitValue - val BindUserCode: keepStack: bool -> args:AsyncParams<'T> -> Async<'U> -> f:('U -> Async<'T>) -> FakeUnitValue - + module AsyncPrimitives = + val MakeAsync: body:(AsyncContext<'T> -> AsyncReturn) -> Async<'T> + val Call: ctxt:AsyncContext<'T> -> result1:'U -> part2f:('U -> Async<'T>) -> AsyncReturn + val Bind: keepStack: bool -> ctxt:AsyncContext<'T> -> part1:Async<'U> -> part2f:('U -> Async<'T>) -> AsyncReturn + val TryFinally: ctxt:AsyncContext<'T> -> finallyFunction: (unit -> unit) -> computation: Async<'T> -> AsyncReturn [] [] @@ -458,7 +458,7 @@ namespace Microsoft.FSharp.Control /// The existence of this method permits the use of empty else branches in the /// async { ... } computation expression syntax. /// An asynchronous computation that returns (). - member inline Zero : unit -> Async + member Zero : unit -> Async /// Creates an asynchronous computation that first runs computation1 /// and then runs computation2, returning the result of computation2. @@ -550,7 +550,7 @@ namespace Microsoft.FSharp.Control /// exception (including cancellation). /// An asynchronous computation that executes computation and compensation afterwards or /// when an exception is raised. - member TryFinally : computation:Async<'T> * compensation:(unit -> unit) -> Async<'T> + member inline TryFinally : computation:Async<'T> * compensation:(unit -> unit) -> Async<'T> /// Creates an asynchronous computation that runs computation and returns its result. /// If an exception happens then catchHandler(exn) is called and the resulting computation executed instead. From efd785cc0f7d1e74f0f08bcec03fddc1af6b8351 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 9 May 2018 12:56:34 +0100 Subject: [PATCH 03/39] async cleanup --- src/fsharp/FSharp.Core/control.fs | 856 +++++++++++++++--------------- 1 file changed, 435 insertions(+), 421 deletions(-) diff --git a/src/fsharp/FSharp.Core/control.fs b/src/fsharp/FSharp.Core/control.fs index 6be535a316e..e22fc10fab7 100644 --- a/src/fsharp/FSharp.Core/control.fs +++ b/src/fsharp/FSharp.Core/control.fs @@ -69,10 +69,10 @@ namespace Microsoft.FSharp.Control member x.Count = size - type LinkedSubSource(ct : CancellationToken) = + type LinkedSubSource(cancellationToken : CancellationToken) = let failureCTS = new CancellationTokenSource() - let linkedCTS = CancellationTokenSource.CreateLinkedTokenSource(ct, failureCTS.Token) + let linkedCTS = CancellationTokenSource.CreateLinkedTokenSource(cancellationToken, failureCTS.Token) member this.Token = linkedCTS.Token member this.Cancel() = failureCTS.Cancel() @@ -88,13 +88,13 @@ namespace Microsoft.FSharp.Control // is represented as type 'void' in the underlying IL. // Hence we don't use the 'unit' return type here, and instead invent our own type. [] - type FakeUnitValue = + type AsyncReturn = | FakeUnit - type cont<'T> = ('T -> FakeUnitValue) - type econt = (ExceptionDispatchInfo -> FakeUnitValue) - type ccont = (OperationCanceledException -> FakeUnitValue) + type cont<'T> = ('T -> AsyncReturn) + type econt = (ExceptionDispatchInfo -> AsyncReturn) + type ccont = (OperationCanceledException -> AsyncReturn) @@ -119,8 +119,9 @@ namespace Microsoft.FSharp.Control static let unfake FakeUnit = () - // Install a trampolineStack if none exists - member this.ExecuteAction (firstAction : unit -> FakeUnitValue) = + /// Use this object with a trampoline on the synchronous stack if none exists, and execute + /// the given function. The function might write its continuation into the trampoline. + member this.Execute (firstAction : unit -> AsyncReturn) = let rec loop action = action() |> unfake match cont with @@ -141,101 +142,142 @@ namespace Microsoft.FSharp.Control Trampoline.thisThreadHasTrampoline <- false FakeUnit - // returns true if time to jump on trampoline - member this.IncrementBindCount() = + /// Increment the counter estimating the size of the synchronous stack and + /// return true if time to jump on trampoline. + member __.IncrementBindCount() = bindCount <- bindCount + 1 bindCount >= bindLimitBeforeHijack + /// Abandon the synchronous stack of the current execution and save the continuation in the trampoline. member this.Set action = match cont with - | None -> - bindCount <- 0 - cont <- Some action - | _ -> failwith "Internal error: attempting to install continuation twice" + | None -> + bindCount <- 0 + cont <- Some action + | _ -> failwith "Internal error: attempting to install continuation twice" + FakeUnit type TrampolineHolder() as this = let mutable trampoline = null static let unfake FakeUnit = () - // preallocate context-switching callbacks - // Preallocate the delegate + + // Preallocate a ctxt-switching callback delegate // This should be the only call to SynchronizationContext.Post in this library. We must always install a trampoline. let sendOrPostCallback = - SendOrPostCallback(fun o -> - let f = unbox o : unit -> FakeUnitValue - this.Protect f |> unfake - ) + SendOrPostCallback(fun o -> + let f = unbox o : unit -> AsyncReturn + this.ExecuteWithTrampoline f |> unfake) - // Preallocate the delegate + // Preallocate a ctxt-switching callback delegate // This should be the only call to QueueUserWorkItem in this library. We must always install a trampoline. let waitCallbackForQueueWorkItemWithTrampoline = - WaitCallback(fun o -> - let f = unbox o : unit -> FakeUnitValue - this.Protect f |> unfake - ) + WaitCallback(fun o -> + let f = unbox o : unit -> AsyncReturn + this.ExecuteWithTrampoline f |> unfake) #if !FX_NO_PARAMETERIZED_THREAD_START // This should be the only call to Thread.Start in this library. We must always install a trampoline. let threadStartCallbackForStartThreadWithTrampoline = ParameterizedThreadStart(fun o -> - let f = unbox o : unit -> FakeUnitValue - this.Protect f |> unfake + let f = unbox o : unit -> AsyncReturn + this.ExecuteWithTrampoline f |> unfake ) #endif - member this.Post (ctxt: SynchronizationContext) (f : unit -> FakeUnitValue) = - ctxt.Post (sendOrPostCallback, state=(f |> box)) + member this.Post (syncCtxt: SynchronizationContext) (f : unit -> AsyncReturn) = + syncCtxt.Post (sendOrPostCallback, state=(f |> box)) FakeUnit - member this.QueueWorkItem (f: unit -> FakeUnitValue) = - if not (ThreadPool.QueueUserWorkItem(waitCallbackForQueueWorkItemWithTrampoline, f |> box)) then - failwith "failed to queue user work item" - FakeUnit + member this.QueueWorkItem (f: unit -> AsyncReturn) = + if not (ThreadPool.QueueUserWorkItem(waitCallbackForQueueWorkItemWithTrampoline, f |> box)) then + failwith "failed to queue user work item" + FakeUnit #if FX_NO_PARAMETERIZED_THREAD_START // This should be the only call to Thread.Start in this library. We must always install a trampoline. - member this.StartThread (f : unit -> FakeUnitValue) = + member this.StartThread (f : unit -> AsyncReturn) = #if FX_NO_THREAD this.QueueWorkItem(f) #else - (new Thread((fun _ -> this.Protect f |> unfake), IsBackground=true)).Start() + (new Thread((fun _ -> this.ExecuteWithTrampoline f |> unfake), IsBackground=true)).Start() FakeUnit #endif #else // This should be the only call to Thread.Start in this library. We must always install a trampoline. - member this.StartThread (f : unit -> FakeUnitValue) = + member __.StartThread (f : unit -> AsyncReturn) = (new Thread(threadStartCallbackForStartThreadWithTrampoline,IsBackground=true)).Start(f|>box) FakeUnit #endif - member this.Protect firstAction = + member __.ExecuteWithTrampoline firstAction = trampoline <- new Trampoline() - trampoline.ExecuteAction(firstAction) + trampoline.Execute firstAction member this.Trampoline = trampoline + + /// Call a continuation, but first check if an async computation should trampoline on its synchronous stack. + member inline __.HijackCheck (cont : 'T -> AsyncReturn) res = + if trampoline.IncrementBindCount() then + trampoline.Set (fun () -> cont res) + else + // NOTE: this must be a tailcall + cont res [] [] - type AsyncParamsAux = - { token : CancellationToken; - econt : econt; - ccont : ccont; - trampolineHolder : TrampolineHolder - } + type AsyncActivationAux = + { token : CancellationToken + econt : econt + ccont : ccont + trampolineHolder : TrampolineHolder } [] [] - type AsyncParams<'T> = + type AsyncActivation<'T> = { cont : cont<'T> - aux : AsyncParamsAux - } - + aux : AsyncActivationAux } + + member ctxt.IsCancellationRequested = ctxt.aux.token.IsCancellationRequested + + /// Call the cancellation continuation of the active computation + member ctxt.OnCancellation () = + ctxt.aux.ccont (new OperationCanceledException (ctxt.aux.token)) + + member ctxt.OnSuccess result = + if ctxt.IsCancellationRequested then + ctxt.OnCancellation () + else + ctxt.aux.trampolineHolder.HijackCheck ctxt.cont result + + /// Call the exception continuation of the active computation + member ctxt.CallExceptionContinuation edi = + ctxt.aux.econt edi + [] [] type Async<'T> = - P of (AsyncParams<'T> -> FakeUnitValue) + { Invoke : (AsyncActivation<'T> -> AsyncReturn) } + + type VolatileBarrier() = + [] + let mutable isStopped = false + member __.Proceed = not isStopped + member __.Stop() = isStopped <- true + + [] + [] + type Latch() = + let mutable i = 0 + member this.Enter() = Interlocked.CompareExchange(&i, 1, 0) = 0 + + [] + type AsyncResult<'T> = + | Ok of 'T + | Error of ExceptionDispatchInfo + | Canceled of OperationCanceledException module AsyncBuilderImpl = // To consider: augment with more exception traceability information @@ -248,21 +290,12 @@ namespace Microsoft.FSharp.Control let fake () = FakeUnit let unfake FakeUnit = () - let ignoreFake _ = FakeUnit - let mutable defaultCancellationTokenSource = new CancellationTokenSource() - [] - type AsyncImplResult<'T> = - | Ok of 'T - | Error of ExceptionDispatchInfo - | Canceled of OperationCanceledException - - let inline hijack (trampolineHolder:TrampolineHolder) res (cont : 'T -> FakeUnitValue) : FakeUnitValue = + let inline hijack (trampolineHolder:TrampolineHolder) res (cont : 'T -> AsyncReturn) : AsyncReturn = if trampolineHolder.Trampoline.IncrementBindCount() then trampolineHolder.Trampoline.Set(fun () -> cont res) - FakeUnit else // NOTE: this must be a tailcall cont res @@ -289,33 +322,33 @@ namespace Microsoft.FSharp.Control edi.Throw() Unchecked.defaultof<'T> // Note, this line should not be reached, but gives a generic return type - // Apply f to x and call either the continuation or exception continuation depending what happens - let inline protect (trampolineHolder:TrampolineHolder) econt f x (cont : 'T -> FakeUnitValue) : FakeUnitValue = + /// Apply userCode to x and call either the continuation or exception continuation depending what happens + let inline protectUserCodeIncludingHijackCheck (trampolineHolder:TrampolineHolder) userCode x econt (cont : 'T -> AsyncReturn) : AsyncReturn = // This is deliberately written in a allocation-free style, except when the trampoline is taken let mutable res = Unchecked.defaultof<_> let mutable edi = null try - res <- f x + res <- userCode x with exn -> edi <- ExceptionDispatchInfo.RestoreOrCapture(exn) match edi with | null -> // NOTE: this must be a tailcall - hijack trampolineHolder res cont + trampolineHolder.HijackCheck cont res | _ -> // NOTE: this must be a tailcall - hijack trampolineHolder edi econt + trampolineHolder.HijackCheck econt edi - // Apply f to x and call either the continuation or exception continuation depending what happens - let inline protectNoHijack econt f x (cont : 'T -> FakeUnitValue) : FakeUnitValue = + // Apply userCode to x and call either the continuation or exception continuation depending what happens + let inline protectUserCodeNoHijackCheck userCode x econt (cont : 'T -> AsyncReturn) : AsyncReturn = // This is deliberately written in a allocation-free style let mutable res = Unchecked.defaultof<_> let mutable edi = null try - res <- f x + res <- userCode x with exn -> edi <- ExceptionDispatchInfo.RestoreOrCapture(exn) @@ -327,50 +360,54 @@ namespace Microsoft.FSharp.Control // NOTE: this must be a tailcall econt exn + /// Perform a cancellation check and ensure that any exceptions raised by + /// the immediate execution of "userCode" are sent to the exception continuation. + let protectUserCodeInCtxt (ctxt: AsyncActivation<_>) userCode = + if ctxt.IsCancellationRequested then + ctxt.OnCancellation () + else + try + userCode ctxt + with exn -> + let edi = ExceptionDispatchInfo.RestoreOrCapture(exn) + ctxt.CallExceptionContinuation edi + /// Reify exceptional results as exceptions let commit res = match res with - | Ok res -> res - | Error edi -> edi.ThrowAny() - | Canceled exn -> raise exn + | AsyncResult.Ok res -> res + | AsyncResult.Error edi -> edi.ThrowAny() + | AsyncResult.Canceled exn -> raise exn - //---------------------------------- - // PRIMITIVE ASYNC INVOCATION + // Reify exceptional results as exceptionsJIT 64 doesn't always take tailcalls correctly - // Apply the underlying implementation of an async computation to its inputs - let inline invokeA (P pf) args = pf args - - - let startA cancellationToken trampolineHolder cont econt ccont p = - let args = - { cont = cont - aux = { token = cancellationToken; - econt = econt - ccont = ccont - trampolineHolder = trampolineHolder - } - } - invokeA p args + let commitWithPossibleTimeout res = + match res with + | None -> raise (System.TimeoutException()) + | Some res -> commit res + /// Make an initial ctxt and execute the async computation. + let startA cancellationToken trampolineHolder cont econt ccont computation = + let ctxt = { cont = cont; aux = { token = cancellationToken; econt = econt; ccont = ccont; trampolineHolder = trampolineHolder } } + computation.Invoke ctxt #if FX_NO_PARAMETERIZED_THREAD_START // Preallocate the delegate // This should be the only call to QueueUserWorkItem in this library. We must always install a trampoline. let waitCallbackForQueueWorkItemWithTrampoline(trampolineHolder : TrampolineHolder) = - WaitCallback(fun o -> - let f = unbox o : unit -> FakeUnitValue - trampolineHolder.Protect f |> unfake - ) + WaitCallback(fun o -> + let f = unbox o : unit -> AsyncReturn + trampolineHolder.ExecuteWithTrampoline f |> unfake) - let startThreadWithTrampoline (trampolineHolder:TrampolineHolder) (f : unit -> FakeUnitValue) = + let startThreadWithTrampoline (trampolineHolder:TrampolineHolder) (f : unit -> AsyncReturn) = #if FX_NO_THREAD - if not (ThreadPool.QueueUserWorkItem((waitCallbackForQueueWorkItemWithTrampoline trampolineHolder), f |> box)) then - failwith "failed to queue user work item" - FakeUnit + if not (ThreadPool.QueueUserWorkItem((waitCallbackForQueueWorkItemWithTrampoline trampolineHolder), f |> box)) then + failwith "failed to queue user work item" + FakeUnit #else - (new Thread((fun _ -> trampolineHolder.Protect f |> unfake), IsBackground=true)).Start() + (new Thread((fun _ -> trampolineHolder.ExecuteWithTrampoline f |> unfake), IsBackground=true)).Start() FakeUnit #endif @@ -378,13 +415,12 @@ namespace Microsoft.FSharp.Control // Statically preallocate the delegate let threadStartCallbackForStartThreadWithTrampoline = - ParameterizedThreadStart(fun o -> - let (trampolineHolder,f) = unbox o : TrampolineHolder * (unit -> FakeUnitValue) - trampolineHolder.Protect f |> unfake - ) + ParameterizedThreadStart(fun o -> + let (trampolineHolder,f) = unbox o : TrampolineHolder * (unit -> AsyncReturn) + trampolineHolder.ExecuteWithTrampoline f |> unfake) // This should be the only call to Thread.Start in this library. We must always install a trampoline. - let startThreadWithTrampoline (trampolineHolder:TrampolineHolder) (f : unit -> FakeUnitValue) = + let startThreadWithTrampoline (trampolineHolder:TrampolineHolder) (f : unit -> AsyncReturn) = (new Thread(threadStartCallbackForStartThreadWithTrampoline,IsBackground=true)).Start((trampolineHolder,f)|>box) FakeUnit #endif @@ -392,15 +428,14 @@ namespace Microsoft.FSharp.Control let startAsync cancellationToken cont econt ccont p = let trampolineHolder = new TrampolineHolder() - trampolineHolder.Protect (fun () -> startA cancellationToken trampolineHolder cont econt ccont p) + trampolineHolder.ExecuteWithTrampoline (fun () -> startA cancellationToken trampolineHolder cont econt ccont p) let queueAsync cancellationToken cont econt ccont p = let trampolineHolder = new TrampolineHolder() trampolineHolder.QueueWorkItem(fun () -> startA cancellationToken trampolineHolder cont econt ccont p) - - //---------------------------------- - // PRIMITIVE ASYNC CONSTRUCTORS + /// Build a primitive without any exception or resync protection + let MakeAsync body = { Invoke = body } // Use this to recover ExceptionDispatchInfo when outside the "with" part of a try/with block. // This indicates all the places where we lose a stack trace. @@ -413,82 +448,70 @@ namespace Microsoft.FSharp.Control let errorT args edi = args.aux.econt edi - // Call the cancellation continuation - let cancelT (args:AsyncParams<_>) = - args.aux.ccont (new OperationCanceledException(args.aux.token)) - - // Build a primitive without any exception of resync protection - // - // Use carefully!! - let unprotectedPrimitive f = P f - - let protectedPrimitiveCore args f = - if args.aux.token.IsCancellationRequested then - cancelT args + let protectedPrimitiveCore ctxt f = + if ctxt.aux.token.IsCancellationRequested then + ctxt.OnCancellation () else try - f args + f ctxt with exn -> let edi = ExceptionDispatchInfo.RestoreOrCapture(exn) - errorT args edi + errorT ctxt edi // When run, ensures that any exceptions raised by the immediate execution of "f" are // sent to the exception continuation. // - let protectedPrimitive f = - unprotectedPrimitive (fun args -> protectedPrimitiveCore args f) + let protectUserCodeAsAsync f = + MakeAsync (fun ctxt -> protectedPrimitiveCore ctxt f) let reify res = - unprotectedPrimitive (fun args -> + MakeAsync (fun ctxt -> match res with - | AsyncImplResult.Ok r -> args.cont r - | AsyncImplResult.Error e -> args.aux.econt e - | AsyncImplResult.Canceled oce -> args.aux.ccont oce) + | AsyncResult.Ok r -> ctxt.cont r + | AsyncResult.Error e -> ctxt.aux.econt e + | AsyncResult.Canceled oce -> ctxt.aux.ccont oce) //---------------------------------- // BUILDER OPERATIONS // Generate async computation which calls its continuation with the given result let resultA x = - unprotectedPrimitive (fun ({ aux = aux } as args) -> - if aux.token.IsCancellationRequested then - cancelT args + MakeAsync (fun ctxt -> + if ctxt.aux.token.IsCancellationRequested then + ctxt.OnCancellation () else - hijack aux.trampolineHolder x args.cont) - - + ctxt.aux.trampolineHolder.HijackCheck ctxt.cont x) // The primitive bind operation. Generate a process that runs the first process, takes // its result, applies f and then runs the new process produced. Hijack if necessary and // run 'f' with exception protection let bindA p1 f = - unprotectedPrimitive (fun args -> - if args.aux.token.IsCancellationRequested then - cancelT args + MakeAsync (fun ctxt -> + if ctxt.aux.token.IsCancellationRequested then + ctxt.OnCancellation () else - let args = - let cont a = protectNoHijack args.aux.econt f a (fun p2 -> invokeA p2 args) + let ctxt = + let cont a = protectUserCodeNoHijackCheck f a ctxt.aux.econt (fun p2 -> p2.Invoke ctxt) { cont=cont; - aux = args.aux + aux = ctxt.aux } // Trampoline the continuation onto a new work item every so often - let trampoline = args.aux.trampolineHolder.Trampoline + let trampoline = ctxt.aux.trampolineHolder.Trampoline if trampoline.IncrementBindCount() then - trampoline.Set(fun () -> invokeA p1 args) - FakeUnit + trampoline.Set(fun () -> p1.Invoke ctxt) else // NOTE: this must be a tailcall - invokeA p1 args) + p1.Invoke ctxt) // callA = "bindA (return x) f" let callA f x = - unprotectedPrimitive (fun args -> - if args.aux.token.IsCancellationRequested then - cancelT args + MakeAsync (fun ctxt -> + if ctxt.aux.token.IsCancellationRequested then + ctxt.OnCancellation () else - protect args.aux.trampolineHolder args.aux.econt f x (fun p2 -> invokeA p2 args) + protectUserCodeIncludingHijackCheck ctxt.aux.trampolineHolder f x ctxt.aux.econt (fun p2 -> p2.Invoke ctxt) ) // delayPrim = "bindA (return ()) f" @@ -499,75 +522,79 @@ namespace Microsoft.FSharp.Control // with the new exception. If exception is raised after a cancellation, exception is ignored // and cancel continuation is called. let tryFinallyA finallyFunction p = - unprotectedPrimitive (fun args -> - if args.aux.token.IsCancellationRequested then - cancelT args + MakeAsync (fun ctxt -> + if ctxt.aux.token.IsCancellationRequested then + ctxt.OnCancellation () else - let trampolineHolder = args.aux.trampolineHolder + let trampolineHolder = ctxt.aux.trampolineHolder // The new continuation runs the finallyFunction and resumes the old continuation // If an exception is thrown we continue with the previous exception continuation. - let cont b = protect trampolineHolder args.aux.econt finallyFunction () (fun () -> args.cont b) + let cont b = protectUserCodeIncludingHijackCheck trampolineHolder finallyFunction () ctxt.aux.econt (fun () -> ctxt.cont b) // The new exception continuation runs the finallyFunction and then runs the previous exception continuation. // If an exception is thrown we continue with the previous exception continuation. - let econt exn = protect trampolineHolder args.aux.econt finallyFunction () (fun () -> args.aux.econt exn) + let econt exn = protectUserCodeIncludingHijackCheck trampolineHolder finallyFunction () ctxt.aux.econt (fun () -> ctxt.aux.econt exn) // The cancellation continuation runs the finallyFunction and then runs the previous cancellation continuation. // If an exception is thrown we continue with the previous cancellation continuation (the exception is lost) - let ccont cexn = protect trampolineHolder (fun _ -> args.aux.ccont cexn) finallyFunction () (fun () -> args.aux.ccont cexn) - invokeA p { args with cont = cont; aux = { args.aux with econt = econt; ccont = ccont } }) + let ccont cexn = protectUserCodeIncludingHijackCheck trampolineHolder finallyFunction () (fun _ -> ctxt.aux.ccont cexn) (fun () -> ctxt.aux.ccont cexn) + p.Invoke { ctxt with cont = cont; aux = { ctxt.aux with econt = econt; ccont = ccont } }) // Re-route the exception continuation to call to catchFunction. If catchFunction or the new process fail // then call the original exception continuation with the failure. let tryWithDispatchInfoA catchFunction p = - unprotectedPrimitive (fun args -> - if args.aux.token.IsCancellationRequested then - cancelT args + MakeAsync (fun ctxt -> + if ctxt.aux.token.IsCancellationRequested then + ctxt.OnCancellation () else - let econt (edi: ExceptionDispatchInfo) = invokeA (callA catchFunction edi) args - invokeA p { args with aux = { args.aux with econt = econt } }) + let econt (edi: ExceptionDispatchInfo) = + let ecomputation = callA catchFunction edi + ecomputation.Invoke ctxt + p.Invoke { ctxt with aux = { ctxt.aux with econt = econt } }) let tryWithExnA catchFunction computation = computation |> tryWithDispatchInfoA (fun edi -> catchFunction (edi.GetAssociatedSourceException())) /// Call the finallyFunction if the computation results in a cancellation - let whenCancelledA (finallyFunction : OperationCanceledException -> unit) p = - unprotectedPrimitive (fun ({ aux = aux } as args)-> - let ccont exn = protect aux.trampolineHolder (fun _ -> aux.ccont exn) finallyFunction exn (fun _ -> aux.ccont exn) - invokeA p { args with aux = { aux with ccont = ccont } }) - - let getCancellationToken() = - unprotectedPrimitive (fun ({ aux = aux } as args) -> args.cont aux.token) + let whenCancelledA (finallyFunction : OperationCanceledException -> unit) computation = + MakeAsync (fun ctxt -> + let aux = ctxt.aux + let ccont exn = protectUserCodeIncludingHijackCheck aux.trampolineHolder finallyFunction exn (fun _ -> aux.ccont exn) (fun _ -> aux.ccont exn) + let newCtxt = { ctxt with aux = { aux with ccont = ccont } } + computation.Invoke newCtxt) + + let GetCancellationTokenAsync = + MakeAsync (fun ctxt -> ctxt.cont ctxt.aux.token) let getTrampolineHolder() = - unprotectedPrimitive (fun ({ aux = aux } as args) -> args.cont aux.trampolineHolder) + MakeAsync (fun ctxt -> ctxt.cont ctxt.aux.trampolineHolder) /// Return a unit result - let doneA = + let unitAsync = resultA() /// Implement use/Dispose - let usingA (r:'T :> IDisposable) (f:'T -> Async<'a>) : Async<'a> = + let usingA (resource:'T :> IDisposable) (computation:'T -> Async<'a>) : Async<'a> = let mutable x = 0 let disposeFunction _ = if Interlocked.CompareExchange(&x, 1, 0) = 0 then - Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicFunctions.Dispose r - tryFinallyA disposeFunction (callA f r) |> whenCancelledA disposeFunction + Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicFunctions.Dispose resource + tryFinallyA disposeFunction (callA computation resource) |> whenCancelledA disposeFunction - let ignoreA p = - bindA p (fun _ -> doneA) + let ignoreA computation = + bindA computation (fun _ -> unitAsync) /// Implement the while loop - let rec whileA gd prog = - if gd() then - bindA prog (fun () -> whileA gd prog) + let rec whileA guardFunc computation = + if guardFunc() then + bindA computation (fun () -> whileA guardFunc computation) else - doneA + unitAsync /// Implement the for loop - let rec forA (e: seq<_>) prog = - usingA (e.GetEnumerator()) (fun ie -> + let rec forA (source: seq<_>) computation = + usingA (source.GetEnumerator()) (fun ie -> whileA (fun () -> ie.MoveNext()) - (delayA(fun () -> prog ie.Current))) + (delayA(fun () -> computation ie.Current))) let sequentialA p1 p2 = @@ -579,7 +606,7 @@ namespace Microsoft.FSharp.Control [] [] type AsyncBuilder() = - member b.Zero() = doneA + member b.Zero() = unitAsync member b.Delay(generator) = delayA(generator) member b.Return(value) = resultA(value) member b.ReturnFrom(computation:Async<_>) = computation @@ -597,32 +624,22 @@ namespace Microsoft.FSharp.Control //---------------------------------- // DERIVED SWITCH TO HELPERS - let switchTo (ctxt: SynchronizationContext) = - protectedPrimitive(fun ({ aux = aux } as args) -> - aux.trampolineHolder.Post ctxt (fun () -> args.cont () )) + let switchTo (syncCtxt: SynchronizationContext) = + protectUserCodeAsAsync (fun ctxt -> + ctxt.aux.trampolineHolder.Post syncCtxt (fun () -> ctxt.cont () )) let switchToNewThread() = - protectedPrimitive(fun ({ aux = aux } as args) -> - aux.trampolineHolder.StartThread (fun () -> args.cont () ) ) + protectUserCodeAsAsync (fun ctxt -> + ctxt.aux.trampolineHolder.StartThread (fun () -> ctxt.cont () ) ) let switchToThreadPool() = - protectedPrimitive(fun ({ aux = aux } as args) -> - aux.trampolineHolder.QueueWorkItem (fun () -> args.cont ()) ) + protectUserCodeAsAsync (fun ctxt -> + ctxt.aux.trampolineHolder.QueueWorkItem (fun () -> ctxt.cont ()) ) //---------------------------------- // DERIVED ASYNC RESYNC HELPERS - let delimitContinuationsWith (delimiter : TrampolineHolder -> (unit -> FakeUnitValue) -> FakeUnitValue) ({ aux = aux } as args) = - let trampolineHolder = aux.trampolineHolder - { args with - cont = (fun x -> delimiter trampolineHolder (fun () -> args.cont x)) - aux = { aux with - econt = (fun x -> delimiter trampolineHolder (fun () -> aux.econt x )); - ccont = (fun x -> delimiter trampolineHolder (fun () -> aux.ccont x)) - } - } - - let getSyncContext () = System.Threading.SynchronizationContext.Current + let getSyncContext () = SynchronizationContext.Current let postOrQueue (ctxt : SynchronizationContext) (trampolineHolder:TrampolineHolder) f = match ctxt with @@ -630,36 +647,25 @@ namespace Microsoft.FSharp.Control | _ -> trampolineHolder.Post ctxt f - let delimitSyncContext args = + let delimitSyncContext ctxt = match getSyncContext () with - | null -> args - | ctxt -> - let aux = args.aux + | null -> ctxt + | syncCtxt -> + let aux = ctxt.aux let trampolineHolder = aux.trampolineHolder - { args with - cont = (fun x -> trampolineHolder.Post ctxt (fun () -> args.cont x)) + { ctxt with + cont = (fun x -> trampolineHolder.Post syncCtxt (fun () -> ctxt.cont x)) aux = { aux with - econt = (fun x -> trampolineHolder.Post ctxt (fun () -> aux.econt x )); - ccont = (fun x -> trampolineHolder.Post ctxt (fun () -> aux.ccont x)) + econt = (fun x -> trampolineHolder.Post syncCtxt (fun () -> aux.econt x )); + ccont = (fun x -> trampolineHolder.Post syncCtxt (fun () -> aux.ccont x)) } } // When run, ensures that each of the continuations of the process are run in the same synchronization context. - let protectedPrimitiveWithResync f = - protectedPrimitive(fun args -> - let args = delimitSyncContext args - f args) - - let unprotectedPrimitiveWithResync f = - unprotectedPrimitive(fun args -> - let args = delimitSyncContext args - f args) - - [] - [] - type Latch() = - let mutable i = 0 - member this.Enter() = Interlocked.CompareExchange(&i, 1, 0) = 0 + let protectUserCodeAsAsyncWithResync f = + protectUserCodeAsAsync (fun ctxt -> + let ctxtWithSync = delimitSyncContext ctxt + f ctxtWithSync) [] [] @@ -671,29 +677,33 @@ namespace Microsoft.FSharp.Control [] [] - type SuspendedAsync<'T>(args : AsyncParams<'T>) = - let ctxt = getSyncContext () + type SuspendedAsync<'T>(ctxt : AsyncActivation<'T>) = + + let syncCtxt = getSyncContext () + let thread = - match ctxt with + match syncCtxt with | null -> null // saving a thread-local access | _ -> Thread.CurrentThread - let trampolineHolder = args.aux.trampolineHolder + + let trampolineHolder = ctxt.aux.trampolineHolder + member this.ContinueImmediate res = - let action () = args.cont res - let inline executeImmediately () = trampolineHolder.Protect action - let currentCtxt = System.Threading.SynchronizationContext.Current - match ctxt, currentCtxt with + let action () = ctxt.cont res + let inline executeImmediately () = trampolineHolder.ExecuteWithTrampoline action + let currentSyncCtxt = SynchronizationContext.Current + match syncCtxt, currentSyncCtxt with | null, null -> executeImmediately () // See bug 370350; this logic is incorrect from the perspective of how SynchronizationContext is meant to work, // but the logic works for mainline scenarios (WinForms/WPF/ASP.NET) and we won't change it again. - | _ when Object.Equals(ctxt, currentCtxt) && thread.Equals(Thread.CurrentThread) -> + | _ when Object.Equals(ctxt, currentSyncCtxt) && thread.Equals(Thread.CurrentThread) -> executeImmediately () | _ -> - postOrQueue ctxt trampolineHolder action + postOrQueue syncCtxt trampolineHolder action member this.ContinueWithPostOrQueue res = - postOrQueue ctxt trampolineHolder (fun () -> args.cont res) + postOrQueue syncCtxt trampolineHolder (fun () -> ctxt.cont res) @@ -793,7 +803,7 @@ namespace Microsoft.FSharp.Control /// cancellation. That is, the underlying computation must fill the result /// if cancellation or timeout occurs. member x.AwaitResult_NoDirectCancelOrTimeout = - unprotectedPrimitive(fun args -> + MakeAsync(fun ctxt -> // Check if a result is available synchronously let resOpt = match result with @@ -805,11 +815,11 @@ namespace Microsoft.FSharp.Control result | None -> // Otherwise save the continuation and call it in RegisterResult - savedConts <- (SuspendedAsync<_>(args))::savedConts + savedConts <- (SuspendedAsync<_>(ctxt))::savedConts None ) match resOpt with - | Some res -> args.cont res + | Some res -> ctxt.cont res | None -> FakeUnit ) @@ -850,7 +860,7 @@ namespace Microsoft.FSharp.Control type private Closure<'T>(f) = member x.Invoke(sender:obj, a:'T) : unit = ignore(sender); f(a) - module CancellationTokenOps = + module AsyncPrimitives = /// Run the asynchronous workflow and wait for its result. let private RunSynchronouslyInAnotherThread (token:CancellationToken,computation,timeout) = let token,innerCTS = @@ -862,7 +872,7 @@ namespace Microsoft.FSharp.Control let subSource = new LinkedSubSource(token) subSource.Token, Some subSource - use resultCell = new ResultCell>() + use resultCell = new ResultCell>() queueAsync token (fun res -> resultCell.RegisterResult(Ok(res),reuseThread=true)) @@ -888,10 +898,10 @@ namespace Microsoft.FSharp.Control commit res let private RunSynchronouslyInCurrentThread (token:CancellationToken,computation) = - use resultCell = new ResultCell>() + use resultCell = new ResultCell>() let trampolineHolder = TrampolineHolder() - trampolineHolder.Protect + trampolineHolder.ExecuteWithTrampoline (fun () -> startA token @@ -933,13 +943,7 @@ namespace Microsoft.FSharp.Control let StartWithContinuations(token:CancellationToken, a:Async<'T>, cont, econt, ccont) : unit = startAsync token (cont >> fake) (econt >> fake) (ccont >> fake) a |> ignore - type VolatileBarrier() = - [] - let mutable isStopped = false - member __.Proceed = not isStopped - member __.Stop() = isStopped <- true - - let StartAsTask (token:CancellationToken, computation : Async<_>,taskCreationOptions) : Task<_> = + let StartAsTask token computation taskCreationOptions = let taskCreationOptions = defaultArg taskCreationOptions TaskCreationOptions.None let tcs = new TaskCompletionSource<_>(taskCreationOptions) @@ -956,96 +960,135 @@ namespace Microsoft.FSharp.Control |> unfake task + // Helper to attach continuation to the given task. + // Should be invoked as a part of protectUserCodeAsAsync(withResync) call + let taskContinueWith (task : Task<'T>, ctxt, useCcontForTaskCancellation) = + + let continuation (completedTask : Task<_>) : unit = + ctxt.aux.trampolineHolder.ExecuteWithTrampoline((fun () -> + if completedTask.IsCanceled then + if useCcontForTaskCancellation + then ctxt.aux.ccont (new OperationCanceledException(ctxt.aux.token)) + else ctxt.aux.econt (ExceptionDispatchInfo.Capture(new TaskCanceledException(completedTask))) + elif completedTask.IsFaulted then + ctxt.aux.econt (MayLoseStackTrace(completedTask.Exception)) + else + ctxt.cont completedTask.Result)) |> unfake + + task.ContinueWith(Action>(continuation)) |> ignore |> fake + + let taskContinueWithUnit (task : Task, ctxt, useCcontForTaskCancellation) = + + let continuation (completedTask : Task) : unit = + ctxt.aux.trampolineHolder.ExecuteWithTrampoline((fun () -> + if completedTask.IsCanceled then + if useCcontForTaskCancellation + then ctxt.aux.ccont (new OperationCanceledException(ctxt.aux.token)) + else ctxt.aux.econt (ExceptionDispatchInfo.Capture(new TaskCanceledException(completedTask))) + elif completedTask.IsFaulted then + ctxt.aux.econt (MayLoseStackTrace(completedTask.Exception)) + else + ctxt.cont ())) |> unfake + + task.ContinueWith(Action(continuation)) |> ignore |> fake + [] [] type Async = - static member CancellationToken = getCancellationToken() + static member CancellationToken = GetCancellationTokenAsync - static member CancelCheck () = doneA + static member CancelCheck () = unitAsync static member FromContinuations (callback : ('T -> unit) * (exn -> unit) * (OperationCanceledException -> unit) -> unit) : Async<'T> = - unprotectedPrimitive (fun ({ aux = aux } as args) -> - if args.aux.token.IsCancellationRequested then - cancelT args + MakeAsync (fun ctxt -> + if ctxt.IsCancellationRequested then + ctxt.OnCancellation () else - let underCurrentThreadStack = ref true - let contToTailCall = ref None + let mutable underCurrentThreadStack = true + let mutable contToTailCall = None let thread = Thread.CurrentThread let latch = Latch() + let aux = ctxt.aux let once cont x = if not(latch.Enter()) then invalidOp(SR.GetString(SR.controlContinuationInvokedMultipleTimes)) - if Thread.CurrentThread.Equals(thread) && !underCurrentThreadStack then - contToTailCall := Some(fun () -> cont x) + if Thread.CurrentThread.Equals(thread) && underCurrentThreadStack then + contToTailCall <- Some(fun () -> cont x) else if Trampoline.ThisThreadHasTrampoline then - let ctxt = getSyncContext() - postOrQueue ctxt aux.trampolineHolder (fun () -> cont x) |> unfake + let syncCtxt = getSyncContext() + postOrQueue syncCtxt aux.trampolineHolder (fun () -> cont x) |> unfake else - aux.trampolineHolder.Protect (fun () -> cont x ) |> unfake + aux.trampolineHolder.ExecuteWithTrampoline (fun () -> cont x ) |> unfake try - callback (once args.cont, (fun exn -> once aux.econt (MayLoseStackTrace(exn))), once aux.ccont) + callback (once ctxt.cont, (fun exn -> once aux.econt (MayLoseStackTrace(exn))), once aux.ccont) with exn -> if not(latch.Enter()) then invalidOp(SR.GetString(SR.controlContinuationInvokedMultipleTimes)) let edi = ExceptionDispatchInfo.RestoreOrCapture(exn) aux.econt edi |> unfake - underCurrentThreadStack := false + underCurrentThreadStack <- false - match !contToTailCall with + match contToTailCall with | Some k -> k() - | _ -> FakeUnit - ) + | _ -> FakeUnit) static member DefaultCancellationToken = defaultCancellationTokenSource.Token static member CancelDefaultToken() = + let cts = defaultCancellationTokenSource + // set new CancellationTokenSource before calling Cancel - otherwise if Cancel throws token will stay unchanged defaultCancellationTokenSource <- new CancellationTokenSource() - // we do not dispose the old default CTS - let GC collect it + cts.Cancel() + // we do not dispose the old default CTS - let GC collect it static member Catch (computation: Async<'T>) = - unprotectedPrimitive (fun ({ aux = aux } as args) -> - startA aux.token aux.trampolineHolder (Choice1Of2 >> args.cont) (fun edi -> args.cont (Choice2Of2 (edi.GetAssociatedSourceException()))) aux.ccont computation) + MakeAsync (fun ctxt -> + let cont = (Choice1Of2 >> ctxt.cont) + let econt (edi: ExceptionDispatchInfo) = ctxt.cont (Choice2Of2 (edi.GetAssociatedSourceException())) + let ctxt = { cont = cont; aux = { ctxt.aux with econt = econt } } + computation.Invoke ctxt) static member RunSynchronously (computation: Async<'T>,?timeout,?cancellationToken:CancellationToken) = let timeout,token = match cancellationToken with - | None -> timeout,defaultCancellationTokenSource.Token - | Some token when not token.CanBeCanceled -> timeout, token - | Some token -> None, token - CancellationTokenOps.RunSynchronously(token, computation, timeout) + | None -> timeout,defaultCancellationTokenSource.Token + | Some token when not token.CanBeCanceled -> timeout, token + | Some token -> None, token + AsyncPrimitives.RunSynchronously(token, computation, timeout) static member Start (computation, ?cancellationToken) = - let token = defaultArg cancellationToken defaultCancellationTokenSource.Token - CancellationTokenOps.Start (token, computation) + let cancellationToken = defaultArg cancellationToken defaultCancellationTokenSource.Token + AsyncPrimitives.Start (cancellationToken, computation) static member StartAsTask (computation,?taskCreationOptions,?cancellationToken)= - let token = defaultArg cancellationToken defaultCancellationTokenSource.Token - CancellationTokenOps.StartAsTask(token,computation,taskCreationOptions) + let cancellationToken = defaultArg cancellationToken defaultCancellationTokenSource.Token + AsyncPrimitives.StartAsTask cancellationToken computation taskCreationOptions static member StartChildAsTask (computation,?taskCreationOptions) = - async { let! token = getCancellationToken() - return CancellationTokenOps.StartAsTask(token,computation, taskCreationOptions) } + async { let! token = GetCancellationTokenAsync + return AsyncPrimitives.StartAsTask token computation taskCreationOptions } type Async with static member Parallel (computations: seq>) = - unprotectedPrimitive (fun args -> + MakeAsync (fun ctxt -> let tasks,result = try Seq.toArray computations, None // manually protect eval of seq with exn -> let edi = ExceptionDispatchInfo.RestoreOrCapture(exn) - null, Some(errorT args edi) + null, Some (ctxt.CallExceptionContinuation edi) match result with | Some r -> r | None -> - if tasks.Length = 0 then args.cont [| |] else // must not be in a 'protect' if we call cont explicitly; if cont throws, it should unwind the stack, preserving Dev10 behavior - protectedPrimitiveCore args (fun args -> - let ({ aux = aux } as args) = delimitSyncContext args // manually resync + if tasks.Length = 0 then ctxt.cont [| |] else // must not be in a 'protect' if we call cont explicitly; if cont throws, it should unwind the stack, preserving Dev10 behavior + protectedPrimitiveCore ctxt (fun ctxt -> + let ctxtWithSync = delimitSyncContext ctxt // manually resync + let aux = ctxtWithSync.aux let count = ref tasks.Length let firstExn = ref None let results = Array.zeroCreate tasks.Length @@ -1057,9 +1100,9 @@ namespace Microsoft.FSharp.Control if (remaining = 0) then innerCTS.Dispose() match (!firstExn) with - | None -> trampolineHolder.Protect(fun () -> args.cont results) - | Some (Choice1Of2 exn) -> trampolineHolder.Protect(fun () -> aux.econt exn) - | Some (Choice2Of2 cexn) -> trampolineHolder.Protect(fun () -> aux.ccont cexn) + | None -> trampolineHolder.ExecuteWithTrampoline(fun () -> ctxtWithSync.cont results) + | Some (Choice1Of2 exn) -> trampolineHolder.ExecuteWithTrampoline(fun () -> aux.econt exn) + | Some (Choice2Of2 cexn) -> trampolineHolder.ExecuteWithTrampoline(fun () -> aux.ccont cexn) else FakeUnit @@ -1098,17 +1141,17 @@ namespace Microsoft.FSharp.Control FakeUnit)) static member Choice(computations : Async<'T option> seq) : Async<'T option> = - unprotectedPrimitive(fun args -> + MakeAsync(fun ctxt -> let result = try Seq.toArray computations |> Choice1Of2 with exn -> ExceptionDispatchInfo.RestoreOrCapture exn |> Choice2Of2 match result with - | Choice2Of2 edi -> args.aux.econt edi - | Choice1Of2 [||] -> args.cont None + | Choice1Of2 [||] -> ctxt.cont None | Choice1Of2 computations -> - protectedPrimitiveCore args (fun args -> - let ({ aux = aux } as args) = delimitSyncContext args + protectedPrimitiveCore ctxt (fun ctxt -> + let ctxtWithSync = delimitSyncContext ctxt + let aux = ctxtWithSync.aux let noneCount = ref 0 let exnCount = ref 0 let innerCts = new LinkedSubSource(aux.token) @@ -1118,72 +1161,40 @@ namespace Microsoft.FSharp.Control match result with | Some _ -> if Interlocked.Increment exnCount = 1 then - innerCts.Cancel(); trampolineHolder.Protect(fun () -> args.cont result) + innerCts.Cancel(); trampolineHolder.ExecuteWithTrampoline(fun () -> ctxtWithSync.cont result) else FakeUnit | None -> if Interlocked.Increment noneCount = computations.Length then - innerCts.Cancel(); trampolineHolder.Protect(fun () -> args.cont None) + innerCts.Cancel(); trampolineHolder.ExecuteWithTrampoline(fun () -> ctxtWithSync.cont None) else FakeUnit let econt (exn : ExceptionDispatchInfo) = if Interlocked.Increment exnCount = 1 then - innerCts.Cancel(); trampolineHolder.Protect(fun () -> args.aux.econt exn) + innerCts.Cancel(); trampolineHolder.ExecuteWithTrampoline(fun () -> ctxtWithSync.aux.econt exn) else FakeUnit let ccont (exn : OperationCanceledException) = if Interlocked.Increment exnCount = 1 then - innerCts.Cancel(); trampolineHolder.Protect(fun () -> args.aux.ccont exn) + innerCts.Cancel(); trampolineHolder.ExecuteWithTrampoline(fun () -> ctxtWithSync.aux.ccont exn) else FakeUnit for c in computations do queueAsync innerCts.Token scont econt ccont c |> unfake - FakeUnit)) - - // Contains helpers that will attach continuation to the given task. - // Should be invoked as a part of protectedPrimitive(withResync) call - module TaskHelpers = - let continueWith (task : Task<'T>, args, useCcontForTaskCancellation) = - - let continuation (completedTask : Task<_>) : unit = - args.aux.trampolineHolder.Protect((fun () -> - if completedTask.IsCanceled then - if useCcontForTaskCancellation - then args.aux.ccont (new OperationCanceledException(args.aux.token)) - else args.aux.econt (ExceptionDispatchInfo.Capture(new TaskCanceledException(completedTask))) - elif completedTask.IsFaulted then - args.aux.econt (MayLoseStackTrace(completedTask.Exception)) - else - args.cont completedTask.Result)) |> unfake - - task.ContinueWith(Action>(continuation)) |> ignore |> fake - - let continueWithUnit (task : Task, args, useCcontForTaskCancellation) = - - let continuation (completedTask : Task) : unit = - args.aux.trampolineHolder.Protect((fun () -> - if completedTask.IsCanceled then - if useCcontForTaskCancellation - then args.aux.ccont (new OperationCanceledException(args.aux.token)) - else args.aux.econt (ExceptionDispatchInfo.Capture(new TaskCanceledException(completedTask))) - elif completedTask.IsFaulted then - args.aux.econt (MayLoseStackTrace(completedTask.Exception)) - else - args.cont ())) |> unfake - - task.ContinueWith(Action(continuation)) |> ignore |> fake + FakeUnit) + | Choice2Of2 edi -> ctxt.aux.econt edi) type Async with /// StartWithContinuations, except the exception continuation is given an ExceptionDispatchInfo static member StartWithContinuationsUsingDispatchInfo(computation:Async<'T>, continuation, exceptionContinuation, cancellationContinuation, ?cancellationToken) : unit = let token = defaultArg cancellationToken defaultCancellationTokenSource.Token - CancellationTokenOps.StartWithContinuations(token, computation, continuation, exceptionContinuation, cancellationContinuation) + AsyncPrimitives.StartWithContinuations(token, computation, continuation, exceptionContinuation, cancellationContinuation) static member StartWithContinuations(computation:Async<'T>, continuation, exceptionContinuation, cancellationContinuation, ?cancellationToken) : unit = Async.StartWithContinuationsUsingDispatchInfo(computation, continuation, (fun edi -> exceptionContinuation (edi.GetAssociatedSourceException())), cancellationContinuation, ?cancellationToken=cancellationToken) @@ -1201,12 +1212,13 @@ namespace Microsoft.FSharp.Control task static member StartImmediate(computation:Async, ?cancellationToken) : unit = let token = defaultArg cancellationToken defaultCancellationTokenSource.Token - CancellationTokenOps.StartWithContinuations(token, computation, id, (fun edi -> edi.ThrowAny()), ignore) + AsyncPrimitives.StartWithContinuations(token, computation, id, (fun edi -> edi.ThrowAny()), ignore) static member Sleep(millisecondsDueTime) : Async = - unprotectedPrimitiveWithResync (fun ({ aux = aux } as args) -> + protectUserCodeAsAsyncWithResync (fun ctxt -> + let aux = ctxt.aux let timer = ref (None : Timer option) - let savedCont = args.cont + let savedCont = ctxt.cont let savedCCont = aux.ccont let latch = new Latch() let registration = @@ -1216,7 +1228,7 @@ namespace Microsoft.FSharp.Control match !timer with | None -> () | Some t -> t.Dispose() - aux.trampolineHolder.Protect(fun () -> savedCCont(new OperationCanceledException(aux.token))) |> unfake + aux.trampolineHolder.ExecuteWithTrampoline(fun () -> savedCCont(new OperationCanceledException(aux.token))) |> unfake ), null) let mutable edi = null @@ -1229,14 +1241,14 @@ namespace Microsoft.FSharp.Control // user violates the contract. registration.Dispose() // Try to Dispose of the TImer. - // Note: there is a race here: the System.Threading.Timer time very occasionally + // Note: there is a race here: the Timer time very occasionally // calls the callback _before_ the timer object has been recorded anywhere. This makes it difficult to dispose the // timer in this situation. In this case we just let the timer be collected by finalization. match !timer with | None -> () | Some t -> t.Dispose() // Now we're done, so call the continuation - aux.trampolineHolder.Protect (fun () -> savedCont()) |> unfake), + aux.trampolineHolder.ExecuteWithTrampoline (fun () -> savedCont()) |> unfake), null, dueTime=millisecondsDueTime, period = -1) |> Some with exn -> if latch.Enter() then @@ -1265,7 +1277,8 @@ namespace Microsoft.FSharp.Control #endif async.Return ok) else - protectedPrimitiveWithResync(fun ({ aux = aux } as args) -> + protectUserCodeAsAsyncWithResync(fun ctxt -> + let aux = ctxt.aux let rwh = ref (None : RegisteredWaitHandle option) let latch = Latch() let rec cancelHandler = @@ -1281,7 +1294,7 @@ namespace Microsoft.FSharp.Control and registration : CancellationTokenRegistration = aux.token.Register(cancelHandler, null) - let savedCont = args.cont + let savedCont = ctxt.cont try lock rwh (fun () -> rwh := Some(ThreadPool.RegisterWaitForSingleObject @@ -1291,7 +1304,7 @@ namespace Microsoft.FSharp.Control lock rwh (fun () -> rwh.Value.Value.Unregister(null) |> ignore) rwh := None registration.Dispose() - aux.trampolineHolder.Protect (fun () -> savedCont (not timeOut)) |> unfake), + aux.trampolineHolder.ExecuteWithTrampoline (fun () -> savedCont (not timeOut)) |> unfake), state=null, millisecondsTimeOutInterval=millisecondsTimeout, executeOnlyOnce=true)); @@ -1311,17 +1324,17 @@ namespace Microsoft.FSharp.Control /// Bind the result of a result cell, calling the appropriate continuation. - static member BindResult(result: AsyncImplResult<'T>) : Async<'T> = - unprotectedPrimitive(fun ({ aux = aux } as args) -> + static member BindResult(result: AsyncResult<'T>) : Async<'T> = + MakeAsync(fun ctxt -> (match result with - | Ok v -> args.cont v - | Error exn -> aux.econt exn - | Canceled exn -> aux.ccont exn) ) + | Ok v -> ctxt.cont v + | Error exn -> ctxt.CallExceptionContinuation exn + | Canceled exn -> ctxt.aux.ccont exn) ) /// Await and use the result of a result cell. The resulting async doesn't support cancellation /// or timeout directly, rather the underlying computation must fill the result if cancellation /// or timeout occurs. - static member AwaitAndBindResult_NoDirectCancelOrTimeout(resultCell: ResultCell>) : Async<'T> = + static member AwaitAndBindResult_NoDirectCancelOrTimeout(resultCell: ResultCell>) : Async<'T> = async { let! result = resultCell.AwaitResult_NoDirectCancelOrTimeout return! Async.BindResult(result) @@ -1330,7 +1343,7 @@ namespace Microsoft.FSharp.Control /// Await the result of a result cell belonging to a child computation. The resulting async supports timeout and if /// it happens the child computation will be cancelled. The resulting async doesn't support cancellation /// directly, rather the underlying computation must fill the result if cancellation occurs. - static member AwaitAndBindChildResult(innerCTS: CancellationTokenSource, resultCell: ResultCell>, millisecondsTimeout) : Async<'T> = + static member AwaitAndBindChildResult(innerCTS: CancellationTokenSource, resultCell: ResultCell>, millisecondsTimeout) : Async<'T> = match millisecondsTimeout with | None | Some -1 -> resultCell |> Async.AwaitAndBindResult_NoDirectCancelOrTimeout @@ -1359,7 +1372,7 @@ namespace Microsoft.FSharp.Control static member FromBeginEnd(beginAction, endAction, ?cancelAction): Async<'T> = - async { let! cancellationToken = getCancellationToken() + async { let! cancellationToken = GetCancellationTokenAsync let resultCell = new ResultCell<_>() let once = Once() @@ -1419,7 +1432,6 @@ namespace Microsoft.FSharp.Control static member FromBeginEnd(arg,beginAction,endAction,?cancelAction): Async<'T> = Async.FromBeginEnd((fun (iar,state) -> beginAction(arg,iar,state)), endAction, ?cancelAction=cancelAction) - static member FromBeginEnd(arg1,arg2,beginAction,endAction,?cancelAction): Async<'T> = Async.FromBeginEnd((fun (iar,state) -> beginAction(arg1,arg2,iar,state)), endAction, ?cancelAction=cancelAction) @@ -1439,9 +1451,9 @@ namespace Microsoft.FSharp.Control let cts = new CancellationTokenSource() - let result = new ResultCell>() + let result = new ResultCell>() - member s.SetResult(v: AsyncImplResult<'T>) = + member s.SetResult(v: AsyncResult<'T>) = result.RegisterResult(v,reuseThread=true) |> unfake match callback with | null -> () @@ -1486,7 +1498,7 @@ namespace Microsoft.FSharp.Control let cont v = aiar.SetResult (Ok v) let econt v = aiar.SetResult (Error v) let ccont v = aiar.SetResult (Canceled v) - CancellationTokenOps.StartWithContinuations(aiar.Token,computation,cont,econt,ccont) + AsyncPrimitives.StartWithContinuations(aiar.Token,computation,cont,econt,ccont) aiar.CheckForNotSynchronous() (aiar :> IAsyncResult) @@ -1525,7 +1537,7 @@ namespace Microsoft.FSharp.Control beginAction, AsBeginEndHelpers.endAction<'T>, AsBeginEndHelpers.cancelAction<'T> static member AwaitEvent(event:IEvent<'Delegate,'T>, ?cancelAction) : Async<'T> = - async { let! token = getCancellationToken() + async { let! token = GetCancellationTokenAsync let resultCell = new ResultCell<_>() // Set up the handlers to listen to events and cancellation let once = new Once() @@ -1572,7 +1584,7 @@ namespace Microsoft.FSharp.Control return! Async.AwaitAndBindResult_NoDirectCancelOrTimeout(resultCell) } type Async with - static member Ignore (computation: Async<'T>) = bindA computation (fun _ -> doneA) + static member Ignore (computation: Async<'T>) = bindA computation (fun _ -> unitAsync) static member SwitchToNewThread() = switchToNewThread() static member SwitchToThreadPool() = switchToThreadPool() @@ -1581,10 +1593,10 @@ namespace Microsoft.FSharp.Control static member StartChild (computation:Async<'T>,?millisecondsTimeout) = async { let resultCell = new ResultCell<_>() - let! ct = getCancellationToken() + let! cancellationToken = GetCancellationTokenAsync let innerCTS = new CancellationTokenSource() // innerCTS does not require disposal let ctsRef = ref innerCTS - let reg = ct.Register( + let reg = cancellationToken.Register( (fun _ -> match !ctsRef with | null -> () @@ -1611,7 +1623,7 @@ namespace Microsoft.FSharp.Control return! switchTo ctxt } static member OnCancel interruption = - async { let! ct = getCancellationToken () + async { let! cancellationToken = GetCancellationTokenAsync // latch protects CancellationTokenRegistration.Dispose from being called twice let latch = Latch() let rec handler (_ : obj) = @@ -1619,31 +1631,25 @@ namespace Microsoft.FSharp.Control if latch.Enter() then registration.Dispose() interruption () with _ -> () - and registration : CancellationTokenRegistration = ct.Register(Action(handler), null) + and registration : CancellationTokenRegistration = cancellationToken.Register(Action(handler), null) return { new System.IDisposable with member this.Dispose() = // dispose CancellationTokenRegistration only if cancellation was not requested. // otherwise - do nothing, disposal will be performed by the handler itself - if not ct.IsCancellationRequested then + if not cancellationToken.IsCancellationRequested then if latch.Enter() then registration.Dispose() } } static member TryCancelled (computation: Async<'T>,compensation) = whenCancelledA compensation computation static member AwaitTask (task:Task<'T>) : Async<'T> = - protectedPrimitiveWithResync (fun args -> - TaskHelpers.continueWith(task, args, false) - ) + protectUserCodeAsAsyncWithResync (fun ctxt -> AsyncPrimitives.taskContinueWith(task, ctxt, false)) static member AwaitTask (task:Task) : Async = - protectedPrimitiveWithResync (fun args -> - TaskHelpers.continueWithUnit (task, args, false) - ) + protectUserCodeAsAsyncWithResync (fun ctxt -> AsyncPrimitives.taskContinueWithUnit (task, ctxt, false)) module CommonExtensions = - open AsyncBuilderImpl - type System.IO.Stream with [] // give the extension member a 'nice', unmangled compiled name, unique within this module @@ -1651,9 +1657,9 @@ namespace Microsoft.FSharp.Control let offset = defaultArg offset 0 let count = defaultArg count buffer.Length #if FX_NO_BEGINEND_READWRITE - // use combo protectedPrimitiveWithResync + continueWith instead of AwaitTask so we can pass cancellation token to the ReadAsync task - protectedPrimitiveWithResync (fun ({ aux = aux } as args) -> - TaskHelpers.continueWith(stream.ReadAsync(buffer, offset, count, aux.token), args, false) + // use combo protectUserCodeAsAsyncWithResync + continueWith instead of AwaitTask so we can pass cancellation token to the ReadAsync task + protectUserCodeAsAsyncWithResync (fun ctxt -> + TaskHelpers.continueWith(stream.ReadAsync(buffer, offset, count, aux.token), ctxt, false) ) #else Async.FromBeginEnd (buffer,offset,count,stream.BeginRead,stream.EndRead) @@ -1675,9 +1681,9 @@ namespace Microsoft.FSharp.Control let offset = defaultArg offset 0 let count = defaultArg count buffer.Length #if FX_NO_BEGINEND_READWRITE - // use combo protectedPrimitiveWithResync + continueWith instead of AwaitTask so we can pass cancellation token to the WriteAsync task - protectedPrimitiveWithResync ( fun ({ aux = aux} as args) -> - TaskHelpers.continueWithUnit(stream.WriteAsync(buffer, offset, count, aux.token), args, false) + // use combo protectUserCodeAsAsyncWithResync + continueWith instead of AwaitTask so we can pass cancellation token to the WriteAsync task + protectUserCodeAsAsyncWithResync ( fun ({ aux = aux} as ctxt) -> + TaskHelpers.continueWithUnit(stream.WriteAsync(buffer, offset, count, aux.token), ctxt, false) ) #else Async.FromBeginEnd (buffer,offset,count,stream.BeginWrite,stream.EndWrite) @@ -1713,7 +1719,7 @@ namespace Microsoft.FSharp.Control | :? System.Net.WebException as webExn when webExn.Status = System.Net.WebExceptionStatus.RequestCanceled && !canceled -> - Async.BindResult(AsyncImplResult.Canceled (OperationCanceledException webExn.Message)) + Async.BindResult(AsyncResult.Canceled (OperationCanceledException webExn.Message)) | _ -> edi.ThrowAny()) @@ -1779,13 +1785,13 @@ namespace Microsoft.FSharp.Control let awaitEither a1 a2 = async { let c = new ResultCell<_>() - let! ct = Async.CancellationToken + let! cancellationToken = Async.CancellationToken let start a f = Async.StartWithContinuationsUsingDispatchInfo(a, - (fun res -> c.RegisterResult(f res |> AsyncImplResult.Ok, reuseThread=false) |> unfake), - (fun edi -> c.RegisterResult(edi |> AsyncImplResult.Error, reuseThread=false) |> unfake), - (fun oce -> c.RegisterResult(oce |> AsyncImplResult.Canceled, reuseThread=false) |> unfake), - cancellationToken = ct + (fun res -> c.RegisterResult(f res |> AsyncResult.Ok, reuseThread=false) |> unfake), + (fun edi -> c.RegisterResult(edi |> AsyncResult.Error, reuseThread=false) |> unfake), + (fun oce -> c.RegisterResult(oce |> AsyncResult.Canceled, reuseThread=false) |> unfake), + cancellationToken = cancellationToken ) start a1 Choice1Of2 start a2 Choice2Of2 @@ -1797,7 +1803,7 @@ namespace Microsoft.FSharp.Control } let timeout msec cancellationToken = if msec < 0 then - unprotectedPrimitive(fun _ -> FakeUnit) // "block" forever + MakeAsync(fun _ -> FakeUnit) // "block" forever else let c = new ResultCell<_>() Async.StartWithContinuations( @@ -1822,7 +1828,7 @@ namespace Microsoft.FSharp.Control // asynchronous receive, either // -- "cont" is non-null and the reader is "activated" by re-scheduling cont in the thread pool; or // -- "pulse" is non-null and the reader is "activated" by setting this event - let mutable savedCont : ((bool -> FakeUnitValue) * TrampolineHolder) option = None + let mutable savedCont : ((bool -> AsyncReturn) * TrampolineHolder) option = None // Readers who have a timeout use this event let mutable pulse : AutoResetEvent = null @@ -1837,7 +1843,7 @@ namespace Microsoft.FSharp.Control pulse let waitOneNoTimeoutOrCancellation = - unprotectedPrimitive (fun ({ aux = aux } as args) -> + MakeAsync (fun ctxt -> match savedCont with | None -> let descheduled = @@ -1845,7 +1851,7 @@ namespace Microsoft.FSharp.Control lock syncRoot (fun () -> if arrivals.Count = 0 then // OK, no arrival so deschedule - savedCont <- Some(args.cont, aux.trampolineHolder); + savedCont <- Some(ctxt.cont, ctxt.aux.trampolineHolder); true else false) @@ -1853,20 +1859,20 @@ namespace Microsoft.FSharp.Control FakeUnit else // If we didn't deschedule then run the continuation immediately - args.cont true + ctxt.cont true | Some _ -> failwith "multiple waiting reader continuations for mailbox") - let waitOneWithCancellation(timeout) = + let waitOneWithCancellation timeout = Async.AwaitWaitHandle(ensurePulse(), millisecondsTimeout=timeout) - let waitOne(timeout) = + let waitOne timeout = if timeout < 0 && not cancellationSupported then waitOneNoTimeoutOrCancellation else waitOneWithCancellation(timeout) - member x.inbox = + member __.inbox = match inboxStore with | null -> inboxStore <- new System.Collections.Generic.List<'Msg>(1) // ResizeArray | _ -> () @@ -1875,19 +1881,19 @@ namespace Microsoft.FSharp.Control member x.CurrentQueueLength = lock syncRoot (fun () -> x.inbox.Count + arrivals.Count) - member x.scanArrivalsUnsafe(f) = + member x.ScanArrivalsUnsafe(f) = if arrivals.Count = 0 then None else let msg = arrivals.Dequeue() match f msg with | None -> x.inbox.Add(msg); - x.scanArrivalsUnsafe(f) + x.ScanArrivalsUnsafe(f) | res -> res // Lock the arrivals queue while we scan that - member x.scanArrivals(f) = lock syncRoot (fun () -> x.scanArrivalsUnsafe(f)) + member x.ScanArrivals(f) = lock syncRoot (fun () -> x.ScanArrivalsUnsafe(f)) - member x.scanInbox(f,n) = + member x.ScanInbox(f,n) = match inboxStore with | null -> None | inbox -> @@ -1896,17 +1902,17 @@ namespace Microsoft.FSharp.Control else let msg = inbox.[n] match f msg with - | None -> x.scanInbox (f,n+1) + | None -> x.ScanInbox (f,n+1) | res -> inbox.RemoveAt(n); res - member x.receiveFromArrivalsUnsafe() = + member x.ReceiveFromArrivalsUnsafe() = if arrivals.Count = 0 then None else Some(arrivals.Dequeue()) - member x.receiveFromArrivals() = - lock syncRoot (fun () -> x.receiveFromArrivalsUnsafe()) + member x.ReceiveFromArrivals() = + lock syncRoot (fun () -> x.ReceiveFromArrivalsUnsafe()) - member x.receiveFromInbox() = + member x.ReceiveFromInbox() = match inboxStore with | null -> None | inbox -> @@ -1940,7 +1946,7 @@ namespace Microsoft.FSharp.Control member x.TryScan ((f: 'Msg -> (Async<'T>) option), timeout) : Async<'T option> = let rec scan timeoutAsync (timeoutCts:CancellationTokenSource) = - async { match x.scanArrivals(f) with + async { match x.ScanArrivals(f) with | None -> // Deschedule and wait for a message. When it comes, rescan the arrivals let! ok = AsyncHelpers.awaitEither waitOneNoTimeoutOrCancellation timeoutAsync @@ -1972,7 +1978,7 @@ namespace Microsoft.FSharp.Control return Some res } let rec scanNoTimeout () = - async { match x.scanArrivals(f) with + async { match x.ScanArrivals(f) with | None -> let! ok = waitOne(Timeout.Infinite) if ok then return! scanNoTimeout() @@ -1984,11 +1990,11 @@ namespace Microsoft.FSharp.Control } // Look in the inbox first - async { match x.scanInbox(f,0) with + async { match x.ScanInbox(f,0) with | None when timeout < 0 -> return! scanNoTimeout() | None -> - let! ct = Async.CancellationToken - let timeoutCts = CancellationTokenSource.CreateLinkedTokenSource(ct, CancellationToken.None) + let! cancellationToken = Async.CancellationToken + let timeoutCts = CancellationTokenSource.CreateLinkedTokenSource(cancellationToken, CancellationToken.None) let timeoutAsync = AsyncHelpers.timeout timeout timeoutCts.Token return! scan timeoutAsync timeoutCts | Some resP -> @@ -2005,7 +2011,7 @@ namespace Microsoft.FSharp.Control member x.TryReceive(timeout) = let rec processFirstArrival() = - async { match x.receiveFromArrivals() with + async { match x.ReceiveFromArrivals() with | None -> // Make sure the pulse is created if it is going to be needed. // If it isn't, then create it, and go back to the start to @@ -2023,14 +2029,14 @@ namespace Microsoft.FSharp.Control | res -> return res } // look in the inbox first - async { match x.receiveFromInbox() with + async { match x.ReceiveFromInbox() with | None -> return! processFirstArrival() | res -> return res } member x.Receive(timeout) = let rec processFirstArrival() = - async { match x.receiveFromArrivals() with + async { match x.ReceiveFromArrivals() with | None -> // Make sure the pulse is created if it is going to be needed. // If it isn't, then create it, and go back to the start to @@ -2047,7 +2053,7 @@ namespace Microsoft.FSharp.Control | Some res -> return res } // look in the inbox first - async { match x.receiveFromInbox() with + async { match x.ReceiveFromInbox() with | None -> return! processFirstArrival() | Some res -> return res } @@ -2075,20 +2081,21 @@ namespace Microsoft.FSharp.Control let mailbox = new Mailbox<'Msg>(cancellationSupported) let mutable defaultTimeout = Threading.Timeout.Infinite let mutable started = false - let errorEvent = new Event() + let errorEvent = new Event() - member x.CurrentQueueLength = mailbox.CurrentQueueLength // nb. unprotected access gives an approximation of the queue length + member __.CurrentQueueLength = mailbox.CurrentQueueLength // nb. unprotected access gives an approximation of the queue length - member x.DefaultTimeout + member __.DefaultTimeout with get() = defaultTimeout and set(v) = defaultTimeout <- v [] - member x.Error = errorEvent.Publish + member __.Error = errorEvent.Publish #if DEBUG - member x.UnsafeMessageQueueContents = mailbox.UnsafeContents + member __.UnsafeMessageQueueContents = mailbox.UnsafeContents #endif + member x.Start() = if started then raise (new InvalidOperationException(SR.GetString(SR.mailboxProcessorAlreadyStarted))) @@ -2106,9 +2113,9 @@ namespace Microsoft.FSharp.Control Async.Start(computation=p, cancellationToken=cancellationToken) - member x.Post(message) = mailbox.Post(message) + member __.Post(message) = mailbox.Post(message) - member x.TryPostAndReply(buildMessage : (_ -> 'Msg), ?timeout) : 'Reply option = + member __.TryPostAndReply(buildMessage : (_ -> 'Msg), ?timeout) : 'Reply option = let timeout = defaultArg timeout defaultTimeout use resultCell = new ResultCell<_>() let msg = buildMessage (new AsyncReplyChannel<_>(fun reply -> @@ -2123,7 +2130,7 @@ namespace Microsoft.FSharp.Control | None -> raise (TimeoutException(SR.GetString(SR.mailboxProcessorPostAndReplyTimedOut))) | Some res -> res - member x.PostAndTryAsyncReply(buildMessage, ?timeout) : Async<'Reply option> = + member __.PostAndTryAsyncReply(buildMessage, ?timeout) : Async<'Reply option> = let timeout = defaultArg timeout defaultTimeout let resultCell = new ResultCell<_>() let msg = buildMessage (new AsyncReplyChannel<_>(fun reply -> @@ -2158,18 +2165,25 @@ namespace Microsoft.FSharp.Control | None -> return! raise (TimeoutException(SR.GetString(SR.mailboxProcessorPostAndAsyncReplyTimedOut))) | Some res -> return res } - member x.Receive(?timeout) = mailbox.Receive(timeout=defaultArg timeout defaultTimeout) - member x.TryReceive(?timeout) = mailbox.TryReceive(timeout=defaultArg timeout defaultTimeout) - member x.Scan(scanner: 'Msg -> (Async<'T>) option,?timeout) = mailbox.Scan(scanner,timeout=defaultArg timeout defaultTimeout) - member x.TryScan(scanner: 'Msg -> (Async<'T>) option,?timeout) = mailbox.TryScan(scanner,timeout=defaultArg timeout defaultTimeout) + member __.Receive(?timeout) = + mailbox.Receive(timeout=defaultArg timeout defaultTimeout) + + member __.TryReceive(?timeout) = + mailbox.TryReceive(timeout=defaultArg timeout defaultTimeout) + + member __.Scan(scanner: 'Msg -> (Async<'T>) option,?timeout) = + mailbox.Scan(scanner,timeout=defaultArg timeout defaultTimeout) + + member __.TryScan(scanner: 'Msg -> (Async<'T>) option,?timeout) = + mailbox.TryScan(scanner,timeout=defaultArg timeout defaultTimeout) interface System.IDisposable with - member x.Dispose() = (mailbox :> IDisposable).Dispose() + member __.Dispose() = (mailbox :> IDisposable).Dispose() static member Start(body,?cancellationToken) = - let mb = new MailboxProcessor<'Msg>(body,?cancellationToken=cancellationToken) - mb.Start(); - mb + let mailboxProcessor = new MailboxProcessor<'Msg>(body,?cancellationToken=cancellationToken) + mailboxProcessor.Start() + mailboxProcessor [] @@ -2226,16 +2240,16 @@ namespace Microsoft.FSharp.Control sourceEvent.Add(fun args2 -> (match !lastArgs with | None -> () - | Some args1 -> ev.Trigger(args1,args2)); - lastArgs := Some args2); + | Some args1 -> ev.Trigger(args1,args2)) + lastArgs := Some args2) ev.Publish [] let merge (event1: IEvent<'Del1,'T>) (event2: IEvent<'Del2,'T>) = let ev = new Event<_>() - event1.Add(fun x -> ev.Trigger(x)); - event2.Add(fun x -> ev.Trigger(x)); + event1.Add(fun x -> ev.Trigger(x)) + event2.Add(fun x -> ev.Trigger(x)) ev.Publish [] From d7268cab6487ec3ae0970bab67acc0e53ca0dc66 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 9 May 2018 12:59:11 +0100 Subject: [PATCH 04/39] minor fix --- src/fsharp/FSharp.Core/control.fs | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/fsharp/FSharp.Core/control.fs b/src/fsharp/FSharp.Core/control.fs index be00ac0add8..9fddc11281c 100644 --- a/src/fsharp/FSharp.Core/control.fs +++ b/src/fsharp/FSharp.Core/control.fs @@ -2250,19 +2250,19 @@ namespace Microsoft.FSharp.Control let pairwise (sourceEvent : IEvent<'Delegate,'T>) : IEvent<'T * 'T> = let ev = new Event<'T * 'T>() let lastArgs = ref None - sourceEvent.Add(fun context2 -> + sourceEvent.Add(fun args2 -> (match !lastArgs with | None -> () - | Some context1 -> ev.Trigger(context1,context2)); - lastArgs := Some context2); + | Some args1 -> ev.Trigger(args1,args2)) + lastArgs := Some args2) ev.Publish [] let merge (event1: IEvent<'Del1,'T>) (event2: IEvent<'Del2,'T>) = let ev = new Event<_>() - event1.Add(fun x -> ev.Trigger(x)); - event2.Add(fun x -> ev.Trigger(x)); + event1.Add(fun x -> ev.Trigger(x)) + event2.Add(fun x -> ev.Trigger(x)) ev.Publish [] @@ -2354,11 +2354,11 @@ namespace Microsoft.FSharp.Control member x.Subscribe(observer) = let lastArgs = ref None source.Subscribe { new BasicObserver<'T>() with - member x.Next(context2) = + member x.Next(args2) = match !lastArgs with | None -> () - | Some context1 -> observer.OnNext (context1,context2) - lastArgs := Some context2 + | Some args1 -> observer.OnNext (args1,args2) + lastArgs := Some args2 member x.Error(e) = observer.OnError(e) member x.Completed() = observer.OnCompleted() } } From 4e7de49f41ebd6833d03ed7d8bba43caadd87652 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 9 May 2018 13:20:31 +0100 Subject: [PATCH 05/39] async cleanup --- src/fsharp/FSharp.Core/control.fs | 307 +++++++++++++++--------------- 1 file changed, 152 insertions(+), 155 deletions(-) diff --git a/src/fsharp/FSharp.Core/control.fs b/src/fsharp/FSharp.Core/control.fs index a423d9191b2..10b1b1de04f 100644 --- a/src/fsharp/FSharp.Core/control.fs +++ b/src/fsharp/FSharp.Core/control.fs @@ -121,7 +121,7 @@ namespace Microsoft.FSharp.Control /// Use this object with a trampoline on the synchronous stack if none exists, and execute /// the given function. The function might write its continuation into the trampoline. - member this.Execute (firstAction : unit -> AsyncReturn) = + member __.Execute (firstAction : unit -> AsyncReturn) = let rec loop action = action() |> unfake match cont with @@ -149,7 +149,7 @@ namespace Microsoft.FSharp.Control bindCount >= bindLimitBeforeHijack /// Abandon the synchronous stack of the current execution and save the continuation in the trampoline. - member this.Set action = + member __.Set action = match cont with | None -> bindCount <- 0 @@ -163,27 +163,26 @@ namespace Microsoft.FSharp.Control static let unfake FakeUnit = () - // Preallocate a ctxt-switching callback delegate + // Preallocate a ctxt-switching callback delegate. // This should be the only call to SynchronizationContext.Post in this library. We must always install a trampoline. let sendOrPostCallback = - SendOrPostCallback(fun o -> - let f = unbox o : unit -> AsyncReturn + SendOrPostCallback (fun o -> + let f = unbox<(unit -> AsyncReturn)> o this.ExecuteWithTrampoline f |> unfake) // Preallocate a ctxt-switching callback delegate // This should be the only call to QueueUserWorkItem in this library. We must always install a trampoline. let waitCallbackForQueueWorkItemWithTrampoline = - WaitCallback(fun o -> - let f = unbox o : unit -> AsyncReturn + WaitCallback (fun o -> + let f = unbox<(unit -> AsyncReturn)> o this.ExecuteWithTrampoline f |> unfake) #if !FX_NO_PARAMETERIZED_THREAD_START // This should be the only call to Thread.Start in this library. We must always install a trampoline. let threadStartCallbackForStartThreadWithTrampoline = - ParameterizedThreadStart(fun o -> - let f = unbox o : unit -> AsyncReturn - this.ExecuteWithTrampoline f |> unfake - ) + ParameterizedThreadStart (fun o -> + let f = unbox<(unit -> AsyncReturn)> o + this.ExecuteWithTrampoline f |> unfake) #endif member this.Post (syncCtxt: SynchronizationContext) (f : unit -> AsyncReturn) = @@ -212,11 +211,12 @@ namespace Microsoft.FSharp.Control FakeUnit #endif + /// Execute an async computation after installing a trampoline on its synchronous stack. member __.ExecuteWithTrampoline firstAction = trampoline <- new Trampoline() trampoline.Execute firstAction - member this.Trampoline = trampoline + member __.Trampoline = trampoline /// Call a continuation, but first check if an async computation should trampoline on its synchronous stack. member inline __.HijackCheck (cont : 'T -> AsyncReturn) res = @@ -228,6 +228,7 @@ namespace Microsoft.FSharp.Control [] [] + /// Represents rarely changing components of an in-flight async computation type AsyncActivationAux = { token : CancellationToken econt : econt @@ -236,6 +237,7 @@ namespace Microsoft.FSharp.Control [] [] + /// Represents an in-flight async computation type AsyncActivation<'T> = { cont : cont<'T> aux : AsyncActivationAux } @@ -279,7 +281,7 @@ namespace Microsoft.FSharp.Control | Error of ExceptionDispatchInfo | Canceled of OperationCanceledException - module AsyncBuilderImpl = + module AsyncPrimitives = // To consider: augment with more exception traceability information // To consider: add the ability to suspend running ps in debug mode // To consider: add the ability to trace running ps in debug mode @@ -371,10 +373,8 @@ namespace Microsoft.FSharp.Control with exn -> let edi = ExceptionDispatchInfo.RestoreOrCapture(exn) ctxt.CallExceptionContinuation edi - - - /// Reify exceptional results as exceptions + /// Reify exceptional results as exceptions let commit res = match res with | AsyncResult.Ok res -> res @@ -415,7 +415,7 @@ namespace Microsoft.FSharp.Control // Statically preallocate the delegate let threadStartCallbackForStartThreadWithTrampoline = - ParameterizedThreadStart(fun o -> + ParameterizedThreadStart (fun o -> let (trampolineHolder,f) = unbox o : TrampolineHolder * (unit -> AsyncReturn) trampolineHolder.ExecuteWithTrampoline f |> unfake) @@ -425,14 +425,13 @@ namespace Microsoft.FSharp.Control FakeUnit #endif - let startAsync cancellationToken cont econt ccont p = let trampolineHolder = new TrampolineHolder() trampolineHolder.ExecuteWithTrampoline (fun () -> startA cancellationToken trampolineHolder cont econt ccont p) let queueAsync cancellationToken cont econt ccont p = let trampolineHolder = new TrampolineHolder() - trampolineHolder.QueueWorkItem(fun () -> startA cancellationToken trampolineHolder cont econt ccont p) + trampolineHolder.QueueWorkItem (fun () -> startA cancellationToken trampolineHolder cont econt ccont p) /// Build a primitive without any exception or resync protection let MakeAsync body = { Invoke = body } @@ -462,14 +461,14 @@ namespace Microsoft.FSharp.Control // sent to the exception continuation. // let protectUserCodeAsAsync f = - MakeAsync (fun ctxt -> protectedPrimitiveCore ctxt f) + MakeAsync (fun ctxt -> protectUserCodeInCtxt ctxt f) - let reify res = + let asyncResultToAsync res = MakeAsync (fun ctxt -> match res with - | AsyncResult.Ok r -> ctxt.cont r - | AsyncResult.Error e -> ctxt.aux.econt e - | AsyncResult.Canceled oce -> ctxt.aux.ccont oce) + | AsyncResult.Ok r -> ctxt.cont r + | AsyncResult.Error e -> ctxt.CallExceptionContinuation e + | AsyncResult.Canceled oce -> ctxt.aux.ccont oce) //---------------------------------- // BUILDER OPERATIONS @@ -540,7 +539,7 @@ namespace Microsoft.FSharp.Control // Re-route the exception continuation to call to catchFunction. If catchFunction or the new process fail // then call the original exception continuation with the failure. - let tryWithDispatchInfoA catchFunction p = + let tryWithDispatchInfoA catchFunction computation = MakeAsync (fun ctxt -> if ctxt.aux.token.IsCancellationRequested then ctxt.OnCancellation () @@ -548,7 +547,7 @@ namespace Microsoft.FSharp.Control let econt (edi: ExceptionDispatchInfo) = let ecomputation = callA catchFunction edi ecomputation.Invoke ctxt - p.Invoke { ctxt with aux = { ctxt.aux with econt = econt } }) + computation.Invoke { ctxt with aux = { ctxt.aux with econt = econt } }) let tryWithExnA catchFunction computation = computation |> tryWithDispatchInfoA (fun edi -> catchFunction (edi.GetAssociatedSourceException())) @@ -557,7 +556,7 @@ namespace Microsoft.FSharp.Control let whenCancelledA (finallyFunction : OperationCanceledException -> unit) computation = MakeAsync (fun ctxt -> let aux = ctxt.aux - let ccont exn = protectUserCodeIncludingHijackCheck aux.trampolineHolder finallyFunction exn (fun _ -> aux.ccont exn) (fun _ -> aux.ccont exn) + let ccont exn = protectUserCodeIncludingHijackCheck aux.trampolineHolder finallyFunction exn (fun _ -> aux.ccont exn) (fun _ -> aux.ccont exn) let newCtxt = { ctxt with aux = { aux with ccont = ccont } } computation.Invoke newCtxt) @@ -582,14 +581,14 @@ namespace Microsoft.FSharp.Control let ignoreA computation = bindA computation (fun _ -> unitAsync) - /// Implement the while loop + /// Implement the while loop construct of async commputation expressions let rec whileA guardFunc computation = if guardFunc() then bindA computation (fun () -> whileA guardFunc computation) else unitAsync - /// Implement the for loop + /// Implement the for loop construct of async commputation expressions let rec forA (source: seq<_>) computation = usingA (source.GetEnumerator()) (fun ie -> whileA @@ -600,30 +599,6 @@ namespace Microsoft.FSharp.Control let sequentialA p1 p2 = bindA p1 (fun () -> p2) - - open AsyncBuilderImpl - - [] - [] - type AsyncBuilder() = - member b.Zero() = unitAsync - member b.Delay(generator) = delayA(generator) - member b.Return(value) = resultA(value) - member b.ReturnFrom(computation:Async<_>) = computation - member b.Bind(computation, binder) = bindA computation binder - member b.Using(resource, binder) = usingA resource binder - member b.While(guard, computation) = whileA guard computation - member b.For(sequence, body) = forA sequence body - member b.Combine(computation1, computation2) = sequentialA computation1 computation2 - member b.TryFinally(computation, compensation) = tryFinallyA compensation computation - member b.TryWith(computation, catchHandler) = tryWithExnA catchHandler computation - - module AsyncImpl = - let async = AsyncBuilder() - - //---------------------------------- - // DERIVED SWITCH TO HELPERS - let switchTo (syncCtxt: SynchronizationContext) = protectUserCodeAsAsync (fun ctxt -> ctxt.aux.trampolineHolder.Post syncCtxt (fun () -> ctxt.cont () )) @@ -855,12 +830,18 @@ namespace Microsoft.FSharp.Control // timed out None - open AsyncImpl - - type private Closure<'T>(f) = - member x.Invoke(sender:obj, a:'T) : unit = ignore(sender); f(a) - module AsyncPrimitives = + type FuncDelegate<'T>(f) = + member __.Invoke(sender:obj, a:'T) : unit = ignore(sender); f(a) + static member Create<'Delegate when 'Delegate :> Delegate>(f) = + let obj = FuncDelegate<'T>(f) +#if FX_PORTABLE_OR_NETSTANDARD + let invokeMeth = (typeof>).GetMethod("Invoke", BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.Instance) + System.Delegate.CreateDelegate(typeof<'Delegate>, obj, invokeMeth) :?> 'Delegate +#else + System.Delegate.CreateDelegate(typeof<'Delegate>, obj, "Invoke") :?> 'Delegate +#endif + /// Run the asynchronous workflow and wait for its result. let private RunSynchronouslyInAnotherThread (token:CancellationToken,computation,timeout) = let token,innerCTS = @@ -875,9 +856,9 @@ namespace Microsoft.FSharp.Control use resultCell = new ResultCell>() queueAsync token - (fun res -> resultCell.RegisterResult(Ok(res),reuseThread=true)) - (fun edi -> resultCell.RegisterResult(Error(edi),reuseThread=true)) - (fun exn -> resultCell.RegisterResult(Canceled(exn),reuseThread=true)) + (fun res -> resultCell.RegisterResult(AsyncResult.Ok(res),reuseThread=true)) + (fun edi -> resultCell.RegisterResult(AsyncResult.Error(edi),reuseThread=true)) + (fun exn -> resultCell.RegisterResult(AsyncResult.Canceled(exn),reuseThread=true)) computation |> unfake @@ -906,9 +887,9 @@ namespace Microsoft.FSharp.Control startA token trampolineHolder - (fun res -> resultCell.RegisterResult(Ok(res),reuseThread=true)) - (fun edi -> resultCell.RegisterResult(Error(edi),reuseThread=true)) - (fun exn -> resultCell.RegisterResult(Canceled(exn),reuseThread=true)) + (fun res -> resultCell.RegisterResult(AsyncResult.Ok(res),reuseThread=true)) + (fun edi -> resultCell.RegisterResult(AsyncResult.Error(edi),reuseThread=true)) + (fun exn -> resultCell.RegisterResult(AsyncResult.Canceled(exn),reuseThread=true)) computation) |> unfake @@ -992,6 +973,109 @@ namespace Microsoft.FSharp.Control task.ContinueWith(Action(continuation)) |> ignore |> fake + [] + [] + type AsyncIAsyncResult<'T>(callback: System.AsyncCallback,state:obj) = + // This gets set to false if the result is not available by the + // time the IAsyncResult is returned to the caller of Begin + let mutable completedSynchronously = true + + let mutable disposed = false + + let cts = new CancellationTokenSource() + + let result = new ResultCell>() + + member s.SetResult(v: AsyncResult<'T>) = + result.RegisterResult(v,reuseThread=true) |> unfake + match callback with + | null -> () + | d -> + // The IASyncResult becomes observable here + d.Invoke (s :> System.IAsyncResult) + + member s.GetResult() = + match result.TryWaitForResultSynchronously (-1) with + | Some (AsyncResult.Ok v) -> v + | Some (AsyncResult.Error edi) -> edi.ThrowAny() + | Some (AsyncResult.Canceled err) -> raise err + | None -> failwith "unreachable" + + member x.IsClosed = disposed + member x.Close() = + if not disposed then + disposed <- true + cts.Dispose() + result.Close() + + member x.Token = cts.Token + + member x.CancelAsync() = cts.Cancel() + + member x.CheckForNotSynchronous() = + if not result.ResultAvailable then + completedSynchronously <- false + + interface System.IAsyncResult with + member x.IsCompleted = result.ResultAvailable + member x.CompletedSynchronously = completedSynchronously + member x.AsyncWaitHandle = result.GetWaitHandle() + member x.AsyncState = state + + interface System.IDisposable with + member x.Dispose() = x.Close() + + module AsBeginEndHelpers = + let beginAction(computation,callback,state) = + let aiar = new AsyncIAsyncResult<'T>(callback,state) + let cont v = aiar.SetResult (AsyncResult.Ok v) + let econt v = aiar.SetResult (AsyncResult.Error v) + let ccont v = aiar.SetResult (AsyncResult.Canceled v) + StartWithContinuations(aiar.Token, computation, cont, econt, ccont) + aiar.CheckForNotSynchronous() + (aiar :> IAsyncResult) + + let endAction<'T> (iar:IAsyncResult) = + match iar with + | :? AsyncIAsyncResult<'T> as aiar -> + if aiar.IsClosed then + raise (System.ObjectDisposedException("AsyncResult")) + else + let res = aiar.GetResult() + aiar.Close () + res + | _ -> + invalidArg "iar" (SR.GetString(SR.mismatchIAREnd)) + + let cancelAction<'T>(iar:IAsyncResult) = + match iar with + | :? AsyncIAsyncResult<'T> as aiar -> + aiar.CancelAsync() + | _ -> + invalidArg "iar" (SR.GetString(SR.mismatchIARCancel)) + + open AsyncPrimitives + + [] + [] + type AsyncBuilder() = + member b.Zero() = unitAsync + member b.Delay(generator) = delayA(generator) + member b.Return(value) = resultA(value) + member b.ReturnFrom(computation:Async<_>) = computation + member b.Bind(computation, binder) = bindA computation binder + member b.Using(resource, binder) = usingA resource binder + member b.While(guard, computation) = whileA guard computation + member b.For(sequence, body) = forA sequence body + member b.Combine(computation1, computation2) = sequentialA computation1 computation2 + member b.TryFinally(computation, compensation) = tryFinallyA compensation computation + member b.TryWith(computation, catchHandler) = tryWithExnA catchHandler computation + + module AsyncImpl = + let async = AsyncBuilder() + + open AsyncImpl + [] [] type Async = @@ -1440,86 +1524,6 @@ namespace Microsoft.FSharp.Control - [] - [] - type AsyncIAsyncResult<'T>(callback: System.AsyncCallback,state:obj) = - // This gets set to false if the result is not available by the - // time the IAsyncResult is returned to the caller of Begin - let mutable completedSynchronously = true - - let mutable disposed = false - - let cts = new CancellationTokenSource() - - let result = new ResultCell>() - - member s.SetResult(v: AsyncResult<'T>) = - result.RegisterResult(v,reuseThread=true) |> unfake - match callback with - | null -> () - | d -> - // The IASyncResult becomes observable here - d.Invoke (s :> System.IAsyncResult) - - member s.GetResult() = - match result.TryWaitForResultSynchronously (-1) with - | Some (Ok v) -> v - | Some (Error edi) -> edi.ThrowAny() - | Some (Canceled err) -> raise err - | None -> failwith "unreachable" - - member x.IsClosed = disposed - member x.Close() = - if not disposed then - disposed <- true - cts.Dispose() - result.Close() - - member x.Token = cts.Token - - member x.CancelAsync() = cts.Cancel() - - member x.CheckForNotSynchronous() = - if not result.ResultAvailable then - completedSynchronously <- false - - interface System.IAsyncResult with - member x.IsCompleted = result.ResultAvailable - member x.CompletedSynchronously = completedSynchronously - member x.AsyncWaitHandle = result.GetWaitHandle() - member x.AsyncState = state - - interface System.IDisposable with - member x.Dispose() = x.Close() - - module AsBeginEndHelpers = - let beginAction(computation,callback,state) = - let aiar = new AsyncIAsyncResult<'T>(callback,state) - let cont v = aiar.SetResult (Ok v) - let econt v = aiar.SetResult (Error v) - let ccont v = aiar.SetResult (Canceled v) - AsyncPrimitives.StartWithContinuations(aiar.Token,computation,cont,econt,ccont) - aiar.CheckForNotSynchronous() - (aiar :> IAsyncResult) - - let endAction<'T> (iar:IAsyncResult) = - match iar with - | :? AsyncIAsyncResult<'T> as aiar -> - if aiar.IsClosed then - raise (System.ObjectDisposedException("AsyncResult")) - else - let res = aiar.GetResult() - aiar.Close () - res - | _ -> - invalidArg "iar" (SR.GetString(SR.mismatchIAREnd)) - - let cancelAction<'T>(iar:IAsyncResult) = - match iar with - | :? AsyncIAsyncResult<'T> as aiar -> - aiar.CancelAsync() - | _ -> - invalidArg "iar" (SR.GetString(SR.mismatchIARCancel)) type Async with @@ -1557,8 +1561,8 @@ namespace Microsoft.FSharp.Control try cancel() with _ -> () token.Register(Action(onCancel), null) - and obj = - new Closure<'T>(fun eventArgs -> + and del = + FuncDelegate<'T>.Create<'Delegate>(fun eventArgs -> // Stop listening to events event.RemoveHandler(del) // The callback has been activated, so ensure cancellation is not possible beyond this point @@ -1567,13 +1571,6 @@ namespace Microsoft.FSharp.Control // Register the result. This may race with a cancellation result, but // ResultCell allows a race and throws away whichever comes last. resultCell.RegisterResult(res,reuseThread=true) |> unfake) - and del = -#if FX_RESHAPED_REFLECTION - let invokeMeth = (typeof>).GetMethod("Invoke", BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.Instance) - System.Delegate.CreateDelegate(typeof<'Delegate>, obj, invokeMeth) :?> 'Delegate -#else - System.Delegate.CreateDelegate(typeof<'Delegate>, obj, "Invoke") :?> 'Delegate -#endif // Start listening to events event.AddHandler(del) @@ -1702,7 +1699,7 @@ namespace Microsoft.FSharp.Control member x.OnCompleted() = () } module WebExtensions = - open AsyncBuilderImpl + open AsyncPrimitives type System.Net.WebRequest with [] // give the extension member a 'nice', unmangled compiled name, unique within this module @@ -1799,7 +1796,7 @@ namespace Microsoft.FSharp.Control // cancellation token and will register a cancelled result if cancellation occurs. // Note: It is ok to use "NoDirectTimeout" here because there is no specific timeout log to this routine. let! result = c.AwaitResult_NoDirectCancelOrTimeout - return! reify result + return! asyncResultToAsync result } let timeout msec cancellationToken = if msec < 0 then From a31caa7cd21a59ad58c3225c3339f9b706a1ea41 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 9 May 2018 13:42:47 +0100 Subject: [PATCH 06/39] more async cleanup --- src/fsharp/FSharp.Core/control.fs | 333 ++++++++++++++---------------- 1 file changed, 153 insertions(+), 180 deletions(-) diff --git a/src/fsharp/FSharp.Core/control.fs b/src/fsharp/FSharp.Core/control.fs index 10b1b1de04f..70842d1d74f 100644 --- a/src/fsharp/FSharp.Core/control.fs +++ b/src/fsharp/FSharp.Core/control.fs @@ -170,7 +170,7 @@ namespace Microsoft.FSharp.Control let f = unbox<(unit -> AsyncReturn)> o this.ExecuteWithTrampoline f |> unfake) - // Preallocate a ctxt-switching callback delegate + // Preallocate a ctxt-switching callback delegate. // This should be the only call to QueueUserWorkItem in this library. We must always install a trampoline. let waitCallbackForQueueWorkItemWithTrampoline = WaitCallback (fun o -> @@ -467,16 +467,13 @@ namespace Microsoft.FSharp.Control MakeAsync (fun ctxt -> match res with | AsyncResult.Ok r -> ctxt.cont r - | AsyncResult.Error e -> ctxt.CallExceptionContinuation e + | AsyncResult.Error edi -> ctxt.CallExceptionContinuation edi | AsyncResult.Canceled oce -> ctxt.aux.ccont oce) - //---------------------------------- - // BUILDER OPERATIONS - // Generate async computation which calls its continuation with the given result let resultA x = MakeAsync (fun ctxt -> - if ctxt.aux.token.IsCancellationRequested then + if ctxt.IsCancellationRequested then ctxt.OnCancellation () else ctxt.aux.trampolineHolder.HijackCheck ctxt.cont x) @@ -486,7 +483,7 @@ namespace Microsoft.FSharp.Control // run 'f' with exception protection let bindA p1 f = MakeAsync (fun ctxt -> - if ctxt.aux.token.IsCancellationRequested then + if ctxt.IsCancellationRequested then ctxt.OnCancellation () else @@ -547,7 +544,8 @@ namespace Microsoft.FSharp.Control let econt (edi: ExceptionDispatchInfo) = let ecomputation = callA catchFunction edi ecomputation.Invoke ctxt - computation.Invoke { ctxt with aux = { ctxt.aux with econt = econt } }) + let newCtxt = { ctxt with aux = { ctxt.aux with econt = econt } } + computation.Invoke newCtxt) let tryWithExnA catchFunction computation = computation |> tryWithDispatchInfoA (fun edi -> catchFunction (edi.GetAssociatedSourceException())) @@ -560,13 +558,11 @@ namespace Microsoft.FSharp.Control let newCtxt = { ctxt with aux = { aux with ccont = ccont } } computation.Invoke newCtxt) - let GetCancellationTokenAsync = + /// A single pre-allocated computation that fetched the current cancellation token + let cancellationTokenAsync = MakeAsync (fun ctxt -> ctxt.cont ctxt.aux.token) - let getTrampolineHolder() = - MakeAsync (fun ctxt -> ctxt.cont ctxt.aux.trampolineHolder) - - /// Return a unit result + /// A single pre-allocated computation that returns a unit result let unitAsync = resultA() @@ -593,26 +589,22 @@ namespace Microsoft.FSharp.Control usingA (source.GetEnumerator()) (fun ie -> whileA (fun () -> ie.MoveNext()) - (delayA(fun () -> computation ie.Current))) - + (delayA (fun () -> computation ie.Current))) let sequentialA p1 p2 = bindA p1 (fun () -> p2) let switchTo (syncCtxt: SynchronizationContext) = protectUserCodeAsAsync (fun ctxt -> - ctxt.aux.trampolineHolder.Post syncCtxt (fun () -> ctxt.cont () )) + ctxt.aux.trampolineHolder.Post syncCtxt (fun () -> ctxt.cont ())) let switchToNewThread() = protectUserCodeAsAsync (fun ctxt -> - ctxt.aux.trampolineHolder.StartThread (fun () -> ctxt.cont () ) ) + ctxt.aux.trampolineHolder.StartThread (fun () -> ctxt.cont ())) let switchToThreadPool() = protectUserCodeAsAsync (fun ctxt -> - ctxt.aux.trampolineHolder.QueueWorkItem (fun () -> ctxt.cont ()) ) - - //---------------------------------- - // DERIVED ASYNC RESYNC HELPERS + ctxt.aux.trampolineHolder.QueueWorkItem (fun () -> ctxt.cont ())) let getSyncContext () = SynchronizationContext.Current @@ -621,7 +613,6 @@ namespace Microsoft.FSharp.Control | null -> trampolineHolder.QueueWorkItem f | _ -> trampolineHolder.Post ctxt f - let delimitSyncContext ctxt = match getSyncContext () with | null -> ctxt @@ -631,9 +622,8 @@ namespace Microsoft.FSharp.Control { ctxt with cont = (fun x -> trampolineHolder.Post syncCtxt (fun () -> ctxt.cont x)) aux = { aux with - econt = (fun x -> trampolineHolder.Post syncCtxt (fun () -> aux.econt x )); - ccont = (fun x -> trampolineHolder.Post syncCtxt (fun () -> aux.ccont x)) - } + econt = (fun x -> trampolineHolder.Post syncCtxt (fun () -> aux.econt x)) + ccont = (fun x -> trampolineHolder.Post syncCtxt (fun () -> aux.ccont x)) } } // When run, ensures that each of the continuations of the process are run in the same synchronization context. @@ -658,12 +648,12 @@ namespace Microsoft.FSharp.Control let thread = match syncCtxt with - | null -> null // saving a thread-local access - | _ -> Thread.CurrentThread + | null -> null // saving a thread-local access + | _ -> Thread.CurrentThread let trampolineHolder = ctxt.aux.trampolineHolder - member this.ContinueImmediate res = + member __.ContinueImmediate res = let action () = ctxt.cont res let inline executeImmediately () = trampolineHolder.ExecuteWithTrampoline action let currentSyncCtxt = SynchronizationContext.Current @@ -672,23 +662,22 @@ namespace Microsoft.FSharp.Control executeImmediately () // See bug 370350; this logic is incorrect from the perspective of how SynchronizationContext is meant to work, // but the logic works for mainline scenarios (WinForms/WPF/ASP.NET) and we won't change it again. - | _ when Object.Equals(ctxt, currentSyncCtxt) && thread.Equals(Thread.CurrentThread) -> - executeImmediately () + | _ when Object.Equals(syncCtxt, currentSyncCtxt) && thread.Equals(Thread.CurrentThread) -> + executeImmediately () | _ -> postOrQueue syncCtxt trampolineHolder action - member this.ContinueWithPostOrQueue res = + member __.ContinueWithPostOrQueue res = postOrQueue syncCtxt trampolineHolder (fun () -> ctxt.cont res) - - - // A utility type to provide a synchronization point between an asynchronous computation - // and callers waiting on the result of that computation. - // - // Use with care! + /// A utility type to provide a synchronization point between an asynchronous computation + /// and callers waiting on the result of that computation. + /// + /// Use with care! [] [] - type ResultCell<'T>() = + type ResultCell<'T>() = + let mutable result = None // The continuations for the result @@ -761,6 +750,7 @@ namespace Microsoft.FSharp.Control // Setting the event need to happen under lock so as not to race with Close() ev.Set () |> ignore List.rev savedConts) + // Run the action outside the lock match grabbedConts with | [] -> FakeUnit @@ -778,7 +768,7 @@ namespace Microsoft.FSharp.Control /// cancellation. That is, the underlying computation must fill the result /// if cancellation or timeout occurs. member x.AwaitResult_NoDirectCancelOrTimeout = - MakeAsync(fun ctxt -> + MakeAsync (fun ctxt -> // Check if a result is available synchronously let resOpt = match result with @@ -912,14 +902,14 @@ namespace Microsoft.FSharp.Control // for the cancellation and run the computation in another thread. | _ -> RunSynchronouslyInAnotherThread (token, computation, timeout) - let Start (token:CancellationToken,computation) = + let Start token computation = queueAsync - token - (fun () -> FakeUnit) // nothing to do on success - (fun edi -> edi.ThrowAny()) // raise exception in child - (fun _ -> FakeUnit) // ignore cancellation in child - computation - |> unfake + token + (fun () -> FakeUnit) // nothing to do on success + (fun edi -> edi.ThrowAny()) // raise exception in child + (fun _ -> FakeUnit) // ignore cancellation in child + computation + |> unfake let StartWithContinuations(token:CancellationToken, a:Async<'T>, cont, econt, ccont) : unit = startAsync token (cont >> fake) (econt >> fake) (ccont >> fake) a |> ignore @@ -943,31 +933,37 @@ namespace Microsoft.FSharp.Control // Helper to attach continuation to the given task. // Should be invoked as a part of protectUserCodeAsAsync(withResync) call - let taskContinueWith (task : Task<'T>, ctxt, useCcontForTaskCancellation) = + let taskContinueWith (task : Task<'T>) ctxt useCcontForTaskCancellation = - let continuation (completedTask : Task<_>) : unit = - ctxt.aux.trampolineHolder.ExecuteWithTrampoline((fun () -> + let continuation (completedTask: Task<_>) : unit = + ctxt.aux.trampolineHolder.ExecuteWithTrampoline ((fun () -> if completedTask.IsCanceled then - if useCcontForTaskCancellation - then ctxt.aux.ccont (new OperationCanceledException(ctxt.aux.token)) - else ctxt.aux.econt (ExceptionDispatchInfo.Capture(new TaskCanceledException(completedTask))) + if useCcontForTaskCancellation then + ctxt.OnCancellation () + else + let edi = ExceptionDispatchInfo.Capture(new TaskCanceledException(completedTask)) + ctxt.CallExceptionContinuation edi elif completedTask.IsFaulted then - ctxt.aux.econt (MayLoseStackTrace(completedTask.Exception)) + let edi = MayLoseStackTrace(completedTask.Exception) + ctxt.CallExceptionContinuation edi else ctxt.cont completedTask.Result)) |> unfake task.ContinueWith(Action>(continuation)) |> ignore |> fake - let taskContinueWithUnit (task : Task, ctxt, useCcontForTaskCancellation) = + let taskContinueWithUnit (task: Task) ctxt useCcontForTaskCancellation = - let continuation (completedTask : Task) : unit = - ctxt.aux.trampolineHolder.ExecuteWithTrampoline((fun () -> + let continuation (completedTask: Task) : unit = + ctxt.aux.trampolineHolder.ExecuteWithTrampoline ((fun () -> if completedTask.IsCanceled then - if useCcontForTaskCancellation - then ctxt.aux.ccont (new OperationCanceledException(ctxt.aux.token)) - else ctxt.aux.econt (ExceptionDispatchInfo.Capture(new TaskCanceledException(completedTask))) + if useCcontForTaskCancellation then + ctxt.OnCancellation () + else + let edi = ExceptionDispatchInfo.Capture(new TaskCanceledException(completedTask)) + ctxt.CallExceptionContinuation edi elif completedTask.IsFaulted then - ctxt.aux.econt (MayLoseStackTrace(completedTask.Exception)) + let edi = MayLoseStackTrace(completedTask.Exception) + ctxt.CallExceptionContinuation edi else ctxt.cont ())) |> unfake @@ -1026,50 +1022,60 @@ namespace Microsoft.FSharp.Control member x.Dispose() = x.Close() module AsBeginEndHelpers = - let beginAction(computation,callback,state) = - let aiar = new AsyncIAsyncResult<'T>(callback,state) - let cont v = aiar.SetResult (AsyncResult.Ok v) - let econt v = aiar.SetResult (AsyncResult.Error v) - let ccont v = aiar.SetResult (AsyncResult.Canceled v) - StartWithContinuations(aiar.Token, computation, cont, econt, ccont) - aiar.CheckForNotSynchronous() - (aiar :> IAsyncResult) + let beginAction(computation, callback, state) = + let aiar = new AsyncIAsyncResult<'T>(callback, state) + let cont v = aiar.SetResult (AsyncResult.Ok v) + let econt v = aiar.SetResult (AsyncResult.Error v) + let ccont v = aiar.SetResult (AsyncResult.Canceled v) + StartWithContinuations(aiar.Token, computation, cont, econt, ccont) + aiar.CheckForNotSynchronous() + (aiar :> IAsyncResult) let endAction<'T> (iar:IAsyncResult) = - match iar with - | :? AsyncIAsyncResult<'T> as aiar -> - if aiar.IsClosed then - raise (System.ObjectDisposedException("AsyncResult")) - else - let res = aiar.GetResult() - aiar.Close () - res - | _ -> - invalidArg "iar" (SR.GetString(SR.mismatchIAREnd)) + match iar with + | :? AsyncIAsyncResult<'T> as aiar -> + if aiar.IsClosed then + raise (System.ObjectDisposedException("AsyncResult")) + else + let res = aiar.GetResult() + aiar.Close () + res + | _ -> + invalidArg "iar" (SR.GetString(SR.mismatchIAREnd)) let cancelAction<'T>(iar:IAsyncResult) = - match iar with - | :? AsyncIAsyncResult<'T> as aiar -> - aiar.CancelAsync() - | _ -> - invalidArg "iar" (SR.GetString(SR.mismatchIARCancel)) + match iar with + | :? AsyncIAsyncResult<'T> as aiar -> + aiar.CancelAsync() + | _ -> + invalidArg "iar" (SR.GetString(SR.mismatchIARCancel)) open AsyncPrimitives [] [] type AsyncBuilder() = - member b.Zero() = unitAsync - member b.Delay(generator) = delayA(generator) - member b.Return(value) = resultA(value) - member b.ReturnFrom(computation:Async<_>) = computation - member b.Bind(computation, binder) = bindA computation binder - member b.Using(resource, binder) = usingA resource binder - member b.While(guard, computation) = whileA guard computation - member b.For(sequence, body) = forA sequence body - member b.Combine(computation1, computation2) = sequentialA computation1 computation2 - member b.TryFinally(computation, compensation) = tryFinallyA compensation computation - member b.TryWith(computation, catchHandler) = tryWithExnA catchHandler computation + member __.Zero() = unitAsync + + member __.Delay generator = delayA(generator) + + member __.Return value = resultA(value) + + member __.ReturnFrom (computation: Async<_>) = computation + + member __.Bind (computation, binder) = bindA computation binder + + member __.Using (resource, binder) = usingA resource binder + + member __.While (guard, computation) = whileA guard computation + + member __.For (sequence, body) = forA sequence body + + member b.Combine (computation1, computation2) = sequentialA computation1 computation2 + + member b.TryFinally (computation, compensation) = tryFinallyA compensation computation + + member b.TryWith (computation, catchHandler) = tryWithExnA catchHandler computation module AsyncImpl = let async = AsyncBuilder() @@ -1080,7 +1086,7 @@ namespace Microsoft.FSharp.Control [] type Async = - static member CancellationToken = GetCancellationTokenAsync + static member CancellationToken = cancellationTokenAsync static member CancelCheck () = unitAsync @@ -1130,7 +1136,7 @@ namespace Microsoft.FSharp.Control // we do not dispose the old default CTS - let GC collect it static member Catch (computation: Async<'T>) = - MakeAsync (fun ctxt -> + MakeAsync (fun ctxt -> let cont = (Choice1Of2 >> ctxt.cont) let econt (edi: ExceptionDispatchInfo) = ctxt.cont (Choice2Of2 (edi.GetAssociatedSourceException())) let ctxt = { cont = cont; aux = { ctxt.aux with econt = econt } } @@ -1146,17 +1152,16 @@ namespace Microsoft.FSharp.Control static member Start (computation, ?cancellationToken) = let cancellationToken = defaultArg cancellationToken defaultCancellationTokenSource.Token - AsyncPrimitives.Start (cancellationToken, computation) + AsyncPrimitives.Start cancellationToken computation static member StartAsTask (computation,?taskCreationOptions,?cancellationToken)= let cancellationToken = defaultArg cancellationToken defaultCancellationTokenSource.Token AsyncPrimitives.StartAsTask cancellationToken computation taskCreationOptions static member StartChildAsTask (computation,?taskCreationOptions) = - async { let! token = GetCancellationTokenAsync - return AsyncPrimitives.StartAsTask token computation taskCreationOptions } + async { let! cancellationToken = cancellationTokenAsync + return AsyncPrimitives.StartAsTask cancellationToken computation taskCreationOptions } - type Async with static member Parallel (computations: seq>) = MakeAsync (fun ctxt -> let tasks,result = @@ -1170,7 +1175,7 @@ namespace Microsoft.FSharp.Control | Some r -> r | None -> if tasks.Length = 0 then ctxt.cont [| |] else // must not be in a 'protect' if we call cont explicitly; if cont throws, it should unwind the stack, preserving Dev10 behavior - protectedPrimitiveCore ctxt (fun ctxt -> + protectUserCodeInCtxt ctxt (fun ctxt -> let ctxtWithSync = delimitSyncContext ctxt // manually resync let aux = ctxtWithSync.aux let count = ref tasks.Length @@ -1184,9 +1189,9 @@ namespace Microsoft.FSharp.Control if (remaining = 0) then innerCTS.Dispose() match (!firstExn) with - | None -> trampolineHolder.ExecuteWithTrampoline(fun () -> ctxtWithSync.cont results) - | Some (Choice1Of2 exn) -> trampolineHolder.ExecuteWithTrampoline(fun () -> aux.econt exn) - | Some (Choice2Of2 cexn) -> trampolineHolder.ExecuteWithTrampoline(fun () -> aux.ccont cexn) + | None -> trampolineHolder.ExecuteWithTrampoline (fun () -> ctxtWithSync.cont results) + | Some (Choice1Of2 exn) -> trampolineHolder.ExecuteWithTrampoline (fun () -> aux.econt exn) + | Some (Choice2Of2 cexn) -> trampolineHolder.ExecuteWithTrampoline (fun () -> aux.ccont cexn) else FakeUnit @@ -1225,15 +1230,16 @@ namespace Microsoft.FSharp.Control FakeUnit)) static member Choice(computations : Async<'T option> seq) : Async<'T option> = - MakeAsync(fun ctxt -> + MakeAsync (fun ctxt -> let result = try Seq.toArray computations |> Choice1Of2 with exn -> ExceptionDispatchInfo.RestoreOrCapture exn |> Choice2Of2 match result with + | Choice2Of2 edi -> ctxt.CallExceptionContinuation edi | Choice1Of2 [||] -> ctxt.cont None | Choice1Of2 computations -> - protectedPrimitiveCore ctxt (fun ctxt -> + protectUserCodeInCtxt ctxt (fun ctxt -> let ctxtWithSync = delimitSyncContext ctxt let aux = ctxtWithSync.aux let noneCount = ref 0 @@ -1245,33 +1251,32 @@ namespace Microsoft.FSharp.Control match result with | Some _ -> if Interlocked.Increment exnCount = 1 then - innerCts.Cancel(); trampolineHolder.ExecuteWithTrampoline(fun () -> ctxtWithSync.cont result) + innerCts.Cancel(); trampolineHolder.ExecuteWithTrampoline (fun () -> ctxtWithSync.cont result) else FakeUnit | None -> if Interlocked.Increment noneCount = computations.Length then - innerCts.Cancel(); trampolineHolder.ExecuteWithTrampoline(fun () -> ctxtWithSync.cont None) + innerCts.Cancel(); trampolineHolder.ExecuteWithTrampoline (fun () -> ctxtWithSync.cont None) else FakeUnit let econt (exn : ExceptionDispatchInfo) = if Interlocked.Increment exnCount = 1 then - innerCts.Cancel(); trampolineHolder.ExecuteWithTrampoline(fun () -> ctxtWithSync.aux.econt exn) + innerCts.Cancel(); trampolineHolder.ExecuteWithTrampoline (fun () -> ctxtWithSync.aux.econt exn) else FakeUnit let ccont (exn : OperationCanceledException) = if Interlocked.Increment exnCount = 1 then - innerCts.Cancel(); trampolineHolder.ExecuteWithTrampoline(fun () -> ctxtWithSync.aux.ccont exn) + innerCts.Cancel(); trampolineHolder.ExecuteWithTrampoline (fun () -> ctxtWithSync.aux.ccont exn) else FakeUnit for c in computations do queueAsync innerCts.Token scont econt ccont c |> unfake - FakeUnit) - | Choice2Of2 edi -> ctxt.aux.econt edi) + FakeUnit)) type Async with @@ -1312,7 +1317,7 @@ namespace Microsoft.FSharp.Control match !timer with | None -> () | Some t -> t.Dispose() - aux.trampolineHolder.ExecuteWithTrampoline(fun () -> savedCCont(new OperationCanceledException(aux.token))) |> unfake + aux.trampolineHolder.ExecuteWithTrampoline (fun () -> savedCCont(new OperationCanceledException(aux.token))) |> unfake ), null) let mutable edi = null @@ -1408,8 +1413,8 @@ namespace Microsoft.FSharp.Control /// Bind the result of a result cell, calling the appropriate continuation. - static member BindResult(result: AsyncResult<'T>) : Async<'T> = - MakeAsync(fun ctxt -> + static member BindResult (result: AsyncResult<'T>) : Async<'T> = + MakeAsync (fun ctxt -> (match result with | Ok v -> ctxt.cont v | Error exn -> ctxt.CallExceptionContinuation exn @@ -1421,7 +1426,7 @@ namespace Microsoft.FSharp.Control static member AwaitAndBindResult_NoDirectCancelOrTimeout(resultCell: ResultCell>) : Async<'T> = async { let! result = resultCell.AwaitResult_NoDirectCancelOrTimeout - return! Async.BindResult(result) + return! Async.BindResult result } /// Await the result of a result cell belonging to a child computation. The resulting async supports timeout and if @@ -1456,10 +1461,11 @@ namespace Microsoft.FSharp.Control static member FromBeginEnd(beginAction, endAction, ?cancelAction): Async<'T> = - async { let! cancellationToken = GetCancellationTokenAsync + async { let! cancellationToken = cancellationTokenAsync let resultCell = new ResultCell<_>() let once = Once() + let registration : CancellationTokenRegistration = let onCancel (_:obj) = @@ -1522,14 +1528,6 @@ namespace Microsoft.FSharp.Control static member FromBeginEnd(arg1,arg2,arg3,beginAction,endAction,?cancelAction): Async<'T> = Async.FromBeginEnd((fun (iar,state) -> beginAction(arg1,arg2,arg3,iar,state)), endAction, ?cancelAction=cancelAction) - - - - - type Async with - - - static member AsBeginEnd<'Arg,'T> (computation:('Arg -> Async<'T>)) : // The 'Begin' member ('Arg * System.AsyncCallback * obj -> System.IAsyncResult) * @@ -1541,7 +1539,7 @@ namespace Microsoft.FSharp.Control beginAction, AsBeginEndHelpers.endAction<'T>, AsBeginEndHelpers.cancelAction<'T> static member AwaitEvent(event:IEvent<'Delegate,'T>, ?cancelAction) : Async<'T> = - async { let! token = GetCancellationTokenAsync + async { let! cancellationToken = cancellationTokenAsync let resultCell = new ResultCell<_>() // Set up the handlers to listen to events and cancellation let once = new Once() @@ -1554,12 +1552,12 @@ namespace Microsoft.FSharp.Control event.RemoveHandler(del) // Register the result. This may race with a successful result, but // ResultCell allows a race and throws away whichever comes last. - once.Do(fun () -> resultCell.RegisterResult(Canceled (OperationCanceledException(token)),reuseThread=true) |> unfake) + once.Do(fun () -> resultCell.RegisterResult(Canceled (OperationCanceledException(cancellationToken)),reuseThread=true) |> unfake) | Some cancel -> // If we get an exception from a cooperative cancellation function // we assume the operation has already completed. try cancel() with _ -> () - token.Register(Action(onCancel), null) + cancellationToken.Register(Action(onCancel), null) and del = FuncDelegate<'T>.Create<'Delegate>(fun eventArgs -> @@ -1580,17 +1578,16 @@ namespace Microsoft.FSharp.Control // Note: ok to use "NoDirectTimeout" here because no timeout parameter to this method return! Async.AwaitAndBindResult_NoDirectCancelOrTimeout(resultCell) } - type Async with - static member Ignore (computation: Async<'T>) = bindA computation (fun _ -> unitAsync) + static member Ignore (computation: Async<'T>) = ignoreA computation + static member SwitchToNewThread() = switchToNewThread() - static member SwitchToThreadPool() = switchToThreadPool() - type Async with + static member SwitchToThreadPool() = switchToThreadPool() static member StartChild (computation:Async<'T>,?millisecondsTimeout) = async { let resultCell = new ResultCell<_>() - let! cancellationToken = GetCancellationTokenAsync + let! cancellationToken = cancellationTokenAsync let innerCTS = new CancellationTokenSource() // innerCTS does not require disposal let ctsRef = ref innerCTS let reg = cancellationToken.Register( @@ -1615,12 +1612,12 @@ namespace Microsoft.FSharp.Control | null -> // no synchronization context, just switch to the thread pool do! Async.SwitchToThreadPool() - | ctxt -> + | syncCtxt -> // post the continuation to the synchronization context - return! switchTo ctxt } + return! switchTo syncCtxt } static member OnCancel interruption = - async { let! cancellationToken = GetCancellationTokenAsync + async { let! cancellationToken = cancellationTokenAsync // latch protects CancellationTokenRegistration.Dispose from being called twice let latch = Latch() let rec handler (_ : obj) = @@ -1640,10 +1637,10 @@ namespace Microsoft.FSharp.Control whenCancelledA compensation computation static member AwaitTask (task:Task<'T>) : Async<'T> = - protectUserCodeAsAsyncWithResync (fun ctxt -> AsyncPrimitives.taskContinueWith(task, ctxt, false)) + protectUserCodeAsAsyncWithResync (fun ctxt -> taskContinueWith task ctxt false) static member AwaitTask (task:Task) : Async = - protectUserCodeAsAsyncWithResync (fun ctxt -> AsyncPrimitives.taskContinueWithUnit (task, ctxt, false)) + protectUserCodeAsAsyncWithResync (fun ctxt -> taskContinueWithUnit task ctxt false) module CommonExtensions = @@ -1654,10 +1651,8 @@ namespace Microsoft.FSharp.Control let offset = defaultArg offset 0 let count = defaultArg count buffer.Length #if FX_NO_BEGINEND_READWRITE - // use combo protectUserCodeAsAsyncWithResync + continueWith instead of AwaitTask so we can pass cancellation token to the ReadAsync task - protectUserCodeAsAsyncWithResync (fun ctxt -> - TaskHelpers.continueWith(stream.ReadAsync(buffer, offset, count, aux.token), ctxt, false) - ) + // use combo protectUserCodeAsAsyncWithResync + taskContinueWith instead of AwaitTask so we can pass cancellation token to the ReadAsync task + protectUserCodeAsAsyncWithResync (fun ctxt -> taskContinueWith (stream.ReadAsync(buffer, offset, count, ctxt.aux.token)) ctxt false) #else Async.FromBeginEnd (buffer,offset,count,stream.BeginRead,stream.EndRead) #endif @@ -1679,9 +1674,7 @@ namespace Microsoft.FSharp.Control let count = defaultArg count buffer.Length #if FX_NO_BEGINEND_READWRITE // use combo protectUserCodeAsAsyncWithResync + continueWith instead of AwaitTask so we can pass cancellation token to the WriteAsync task - protectUserCodeAsAsyncWithResync ( fun ({ aux = aux} as ctxt) -> - TaskHelpers.continueWithUnit(stream.WriteAsync(buffer, offset, count, aux.token), ctxt, false) - ) + protectUserCodeAsAsyncWithResync ( fun ctxt -> taskContinueWithUnit (stream.WriteAsync(buffer, offset, count, ctxt.aux.token)) ctxt false) #else Async.FromBeginEnd (buffer,offset,count,stream.BeginWrite,stream.EndWrite) #endif @@ -1781,13 +1774,13 @@ namespace Microsoft.FSharp.Control module AsyncHelpers = let awaitEither a1 a2 = async { - let c = new ResultCell<_>() + let resultCell = new ResultCell<_>() let! cancellationToken = Async.CancellationToken let start a f = Async.StartWithContinuationsUsingDispatchInfo(a, - (fun res -> c.RegisterResult(f res |> AsyncResult.Ok, reuseThread=false) |> unfake), - (fun edi -> c.RegisterResult(edi |> AsyncResult.Error, reuseThread=false) |> unfake), - (fun oce -> c.RegisterResult(oce |> AsyncResult.Canceled, reuseThread=false) |> unfake), + (fun res -> resultCell.RegisterResult(f res |> AsyncResult.Ok, reuseThread=false) |> unfake), + (fun edi -> resultCell.RegisterResult(edi |> AsyncResult.Error, reuseThread=false) |> unfake), + (fun oce -> resultCell.RegisterResult(oce |> AsyncResult.Canceled, reuseThread=false) |> unfake), cancellationToken = cancellationToken ) start a1 Choice1Of2 @@ -1795,24 +1788,24 @@ namespace Microsoft.FSharp.Control // Note: It is ok to use "NoDirectCancel" here because the started computations use the same // cancellation token and will register a cancelled result if cancellation occurs. // Note: It is ok to use "NoDirectTimeout" here because there is no specific timeout log to this routine. - let! result = c.AwaitResult_NoDirectCancelOrTimeout + let! result = resultCell.AwaitResult_NoDirectCancelOrTimeout return! asyncResultToAsync result } let timeout msec cancellationToken = if msec < 0 then - MakeAsync(fun _ -> FakeUnit) // "block" forever + MakeAsync (fun _ -> FakeUnit) // "block" forever else - let c = new ResultCell<_>() + let resultCell = new ResultCell<_>() Async.StartWithContinuations( computation=Async.Sleep(msec), - continuation=(fun () -> c.RegisterResult((), reuseThread = false) |> unfake), + continuation=(fun () -> resultCell.RegisterResult((), reuseThread = false) |> unfake), exceptionContinuation=ignore, cancellationContinuation=ignore, cancellationToken = cancellationToken) // Note: It is ok to use "NoDirectCancel" here because the started computations use the same // cancellation token and will register a cancelled result if cancellation occurs. // Note: It is ok to use "NoDirectTimeout" here because the child compuation above looks after the timeout. - c.AwaitResult_NoDirectCancelOrTimeout + resultCell.AwaitResult_NoDirectCancelOrTimeout [] [] @@ -1871,7 +1864,7 @@ namespace Microsoft.FSharp.Control member __.inbox = match inboxStore with - | null -> inboxStore <- new System.Collections.Generic.List<'Msg>(1) // ResizeArray + | null -> inboxStore <- new System.Collections.Generic.List<'Msg>(1) | _ -> () inboxStore @@ -1937,7 +1930,7 @@ namespace Microsoft.FSharp.Control // someone is waiting on the wait handle ev.Set() |> ignore - | Some(action,trampolineHolder) -> + | Some (action, trampolineHolder) -> savedCont <- None trampolineHolder.QueueWorkItem(fun () -> action true) |> unfake) @@ -2072,6 +2065,7 @@ namespace Microsoft.FSharp.Control [] [] type MailboxProcessor<'Msg>(body, ?cancellationToken) = + let cancellationSupported = cancellationToken.IsSome let cancellationToken = defaultArg cancellationToken Async.DefaultCancellationToken let mailbox = new Mailbox<'Msg>(cancellationSupported) @@ -2164,13 +2158,13 @@ namespace Microsoft.FSharp.Control member __.Receive(?timeout) = mailbox.Receive(timeout=defaultArg timeout defaultTimeout) - member __.TryReceive(?timeout) = + member __.TryReceive(?timeout) = mailbox.TryReceive(timeout=defaultArg timeout defaultTimeout) - member __.Scan(scanner: 'Msg -> (Async<'T>) option,?timeout) = + member __.Scan(scanner: 'Msg -> (Async<'T>) option,?timeout) = mailbox.Scan(scanner,timeout=defaultArg timeout defaultTimeout) - member __.TryScan(scanner: 'Msg -> (Async<'T>) option,?timeout) = + member __.TryScan(scanner: 'Msg -> (Async<'T>) option,?timeout) = mailbox.TryScan(scanner,timeout=defaultArg timeout defaultTimeout) interface System.IDisposable with @@ -2180,7 +2174,6 @@ namespace Microsoft.FSharp.Control let mailboxProcessor = new MailboxProcessor<'Msg>(body,?cancellationToken=cancellationToken) mailboxProcessor.Start() mailboxProcessor - [] [] @@ -2280,26 +2273,6 @@ namespace Microsoft.FSharp.Control member x.OnCompleted () = if not stopped then stopped <- true x.Completed () - -(* - type AutoDetachObserver<'T>(o : IObserver<'T>, s : IObservable) = - inherit BasicObserver<'T>() - override x.Next v = o.OnNext v - override x.Error e = o.OnError e - s.Add (fun d -> d.Dispose()) - override x.Completed () = o.OnCompleted () - s.Add (fun d -> d.Dispose()) - - type MyObservable<'T>() = - abstract MySubscribe : observer : IObserver<'T> -> System.IDisposable - interface IObservable<'T> - member x.Subscribe o = let (t, s) = create () - let ado = new AutoDetachObserver<'T>(o, s) - let d = x.MySubscribe ado - t d - d -*) - [] let map mapping (source: IObservable<'T>) = { new IObservable<'U> with From 60030b723cb851210df3315bf536216577a215d6 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 9 May 2018 13:49:24 +0100 Subject: [PATCH 07/39] integrate async-cleanup --- src/fsharp/FSharp.Core/control.fs | 30 +++++++++++++++--------------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/src/fsharp/FSharp.Core/control.fs b/src/fsharp/FSharp.Core/control.fs index 1359d134797..30d6f07c8ad 100644 --- a/src/fsharp/FSharp.Core/control.fs +++ b/src/fsharp/FSharp.Core/control.fs @@ -256,7 +256,7 @@ namespace Microsoft.FSharp.Control /// Call the cancellation continuation of the active computation member ctxt.OnCancellation () = ctxt.aux.ccont (new OperationCanceledException (ctxt.aux.token)) - + member ctxt.OnSuccess result = if ctxt.IsCancellationRequested then ctxt.OnCancellation () @@ -266,7 +266,7 @@ namespace Microsoft.FSharp.Control /// Call the exception continuation of the active computation member ctxt.CallExceptionContinuation edi = ctxt.aux.econt edi - + [] [] type Async<'T> = @@ -435,6 +435,9 @@ namespace Microsoft.FSharp.Control let trampolineHolder = new TrampolineHolder() trampolineHolder.QueueWorkItem (fun () -> startA cancellationToken trampolineHolder cont econt ccont p) + /// Build a primitive without any exception or resync protection + let MakeAsync body = { Invoke = body } + /// Use this to recover ExceptionDispatchInfo when outside the "with" part of a try/with block. /// This indicates all the places where we lose a stack trace. /// @@ -442,9 +445,6 @@ namespace Microsoft.FSharp.Control /// notably .NET 4.x tasks and user exceptions passed to the exception continuation in Async.FromContinuations. let MayLoseStackTrace exn = ExceptionDispatchInfo.RestoreOrCapture exn - /// Build a primitive without any exception or resync protection - let MakeAsync body = { Invoke = body } - /// Build a context suitable for running part1 of a computation and passing the result to part2f let bindPart2 ctxt part2f = let cont a = protectUserCodeNoHijackCheck part2f a ctxt.aux.econt (fun part2 -> part2.Invoke ctxt) @@ -625,7 +625,7 @@ namespace Microsoft.FSharp.Control (delayA (fun () -> computation ie.Current))) let switchTo (syncCtxt: SynchronizationContext) = - protectUserCodeAsAsync (fun ctxt -> + protectUserCodeAsAsync (fun ctxt -> ctxt.aux.trampolineHolder.Post syncCtxt (fun () -> ctxt.cont ())) let switchToNewThread() = @@ -656,7 +656,7 @@ namespace Microsoft.FSharp.Control ccont = (fun x -> trampolineHolder.Post syncCtxt (fun () -> aux.ccont x)) } } - // When run, ensures that each of the continuations of the process are run in the same synchronization ctxt. + // When run, ensures that each of the continuations of the process are run in the same synchronization context. let protectUserCodeAsAsyncWithResync f = protectUserCodeAsAsync (fun ctxt -> let ctxtWithSync = delimitSyncContext ctxt @@ -918,7 +918,7 @@ namespace Microsoft.FSharp.Control let RunSynchronously (token:CancellationToken,computation,timeout) = // Reuse the current ThreadPool thread if possible. Unfortunately // Thread.IsThreadPoolThread isn't available on all profiles so - // we approximate it by testing synchronization ctxt for null. + // we approximate it by testing synchronization context for null. match SynchronizationContext.Current, timeout with | null, None -> RunSynchronouslyInCurrentThread (token, computation) // When the timeout is given we need a dedicated thread @@ -1085,7 +1085,7 @@ namespace Microsoft.FSharp.Control [] [] type AsyncBuilder() = - member b.Zero () = unitAsync + member __.Zero () = unitAsync member inline __.Delay generator = delayA generator @@ -1640,7 +1640,7 @@ namespace Microsoft.FSharp.Control static member SwitchToContext syncContext = async { match syncContext with | null -> - // no synchronization ctxt, just switch to the thread pool + // no synchronization context, just switch to the thread pool do! Async.SwitchToThreadPool() | syncCtxt -> // post the continuation to the synchronization context @@ -1705,8 +1705,8 @@ namespace Microsoft.FSharp.Control let offset = defaultArg offset 0 let count = defaultArg count buffer.Length #if FX_NO_BEGINEND_READWRITE - // use combo protectUserCodeAsAsyncWithResync + taskContinueWith instead of AwaitTask so we can pass cancellation token to the WriteAsync task - protectUserCodeAsAsyncWithResync (fun ctxt -> TaskHelpers.taskContinueWithUnit (stream.WriteAsync(buffer, offset, count, ctxt.aux.token)) ctxt false) + // use combo protectUserCodeAsAsyncWithResync + taskContinueWithUnit instead of AwaitTask so we can pass cancellation token to the WriteAsync task + protectUserCodeAsAsyncWithResync (fun ctxt -> taskContinueWithUnit (stream.WriteAsync(buffer, offset, count, ctxt.aux.token)) ctxt false) #else Async.FromBeginEnd (buffer,offset,count,stream.BeginWrite,stream.EndWrite) #endif @@ -1719,7 +1719,7 @@ namespace Microsoft.FSharp.Control [] // give the extension member a 'nice', unmangled compiled name, unique within this module member x.Subscribe(callback) = x.Subscribe { new IObserver<'Args> with - member x.OnNext(ctxt) = callback ctxt + member x.OnNext(args) = callback args member x.OnError(e) = () member x.OnCompleted() = () } @@ -1778,7 +1778,7 @@ namespace Microsoft.FSharp.Control event = this.DownloadStringCompleted, handler = (fun action -> Net.DownloadStringCompletedEventHandler(action)), start = (fun userToken -> this.DownloadStringAsync(address, userToken)), - result = (fun ctxt -> ctxt.Result) + result = (fun args -> args.Result) ) [] // give the extension member a 'nice', unmangled compiled name, unique within this module @@ -1787,7 +1787,7 @@ namespace Microsoft.FSharp.Control event = this.DownloadDataCompleted, handler = (fun action -> Net.DownloadDataCompletedEventHandler(action)), start = (fun userToken -> this.DownloadDataAsync(address, userToken)), - result = (fun ctxt -> ctxt.Result) + result = (fun args -> args.Result) ) [] // give the extension member a 'nice', unmangled compiled name, unique within this module From 54a335c16d5107edb10d0f44de458d2383cc4a45 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 9 May 2018 13:51:43 +0100 Subject: [PATCH 08/39] async cleanup --- src/fsharp/FSharp.Core/control.fs | 24 +++++++++++++----------- 1 file changed, 13 insertions(+), 11 deletions(-) diff --git a/src/fsharp/FSharp.Core/control.fs b/src/fsharp/FSharp.Core/control.fs index 70842d1d74f..29a54443f5a 100644 --- a/src/fsharp/FSharp.Core/control.fs +++ b/src/fsharp/FSharp.Core/control.fs @@ -608,10 +608,10 @@ namespace Microsoft.FSharp.Control let getSyncContext () = SynchronizationContext.Current - let postOrQueue (ctxt : SynchronizationContext) (trampolineHolder:TrampolineHolder) f = - match ctxt with + let postOrQueue (syncCtxt : SynchronizationContext) (trampolineHolder:TrampolineHolder) f = + match syncCtxt with | null -> trampolineHolder.QueueWorkItem f - | _ -> trampolineHolder.Post ctxt f + | _ -> trampolineHolder.Post syncCtxt f let delimitSyncContext ctxt = match getSyncContext () with @@ -1022,7 +1022,7 @@ namespace Microsoft.FSharp.Control member x.Dispose() = x.Close() module AsBeginEndHelpers = - let beginAction(computation, callback, state) = + let beginAction (computation, callback, state) = let aiar = new AsyncIAsyncResult<'T>(callback, state) let cont v = aiar.SetResult (AsyncResult.Ok v) let econt v = aiar.SetResult (AsyncResult.Error v) @@ -1055,7 +1055,7 @@ namespace Microsoft.FSharp.Control [] [] type AsyncBuilder() = - member __.Zero() = unitAsync + member __.Zero () = unitAsync member __.Delay generator = delayA(generator) @@ -1071,11 +1071,11 @@ namespace Microsoft.FSharp.Control member __.For (sequence, body) = forA sequence body - member b.Combine (computation1, computation2) = sequentialA computation1 computation2 + member __.Combine (computation1, computation2) = sequentialA computation1 computation2 - member b.TryFinally (computation, compensation) = tryFinallyA compensation computation + member __.TryFinally (computation, compensation) = tryFinallyA compensation computation - member b.TryWith (computation, catchHandler) = tryWithExnA catchHandler computation + member __.TryWith (computation, catchHandler) = tryWithExnA catchHandler computation module AsyncImpl = let async = AsyncBuilder() @@ -1482,7 +1482,7 @@ namespace Microsoft.FSharp.Control // If we get an exception from a cooperative cancellation function // we assume the operation has already completed. try cancel() with _ -> () - + cancellationToken.Register(Action(onCancel), null) let callback = @@ -1673,8 +1673,8 @@ namespace Microsoft.FSharp.Control let offset = defaultArg offset 0 let count = defaultArg count buffer.Length #if FX_NO_BEGINEND_READWRITE - // use combo protectUserCodeAsAsyncWithResync + continueWith instead of AwaitTask so we can pass cancellation token to the WriteAsync task - protectUserCodeAsAsyncWithResync ( fun ctxt -> taskContinueWithUnit (stream.WriteAsync(buffer, offset, count, ctxt.aux.token)) ctxt false) + // use combo protectUserCodeAsAsyncWithResync + taskContinueWithUnit instead of AwaitTask so we can pass cancellation token to the WriteAsync task + protectUserCodeAsAsyncWithResync (fun ctxt -> taskContinueWithUnit (stream.WriteAsync(buffer, offset, count, ctxt.aux.token)) ctxt false) #else Async.FromBeginEnd (buffer,offset,count,stream.BeginWrite,stream.EndWrite) #endif @@ -1772,6 +1772,7 @@ namespace Microsoft.FSharp.Control open CommonExtensions module AsyncHelpers = + let awaitEither a1 a2 = async { let resultCell = new ResultCell<_>() @@ -1791,6 +1792,7 @@ namespace Microsoft.FSharp.Control let! result = resultCell.AwaitResult_NoDirectCancelOrTimeout return! asyncResultToAsync result } + let timeout msec cancellationToken = if msec < 0 then MakeAsync (fun _ -> FakeUnit) // "block" forever From 2dd05d7cabd647efc24a7347e380575a4b97ffea Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 9 May 2018 14:49:37 +0100 Subject: [PATCH 09/39] fix build --- src/FSharp.Profiles.props | 1 - src/fsharp/FSharp.Core/control.fs | 5 +---- 2 files changed, 1 insertion(+), 5 deletions(-) diff --git a/src/FSharp.Profiles.props b/src/FSharp.Profiles.props index 8e03b11fdcf..c926fca4f70 100644 --- a/src/FSharp.Profiles.props +++ b/src/FSharp.Profiles.props @@ -10,7 +10,6 @@ - $(DefineConstants);FX_PORTABLE_OR_NETSTANDARD $(DefineConstants);NETSTANDARD1_6 $(DefineConstants);FX_NO_APP_DOMAINS $(DefineConstants);FX_NO_ARRAY_LONG_LENGTH diff --git a/src/fsharp/FSharp.Core/control.fs b/src/fsharp/FSharp.Core/control.fs index 29a54443f5a..7ff03a1ce21 100644 --- a/src/fsharp/FSharp.Core/control.fs +++ b/src/fsharp/FSharp.Core/control.fs @@ -821,16 +821,13 @@ namespace Microsoft.FSharp.Control None + /// Create an instance of an arbitrary delegate type delegating to the given F# function type FuncDelegate<'T>(f) = member __.Invoke(sender:obj, a:'T) : unit = ignore(sender); f(a) static member Create<'Delegate when 'Delegate :> Delegate>(f) = let obj = FuncDelegate<'T>(f) -#if FX_PORTABLE_OR_NETSTANDARD let invokeMeth = (typeof>).GetMethod("Invoke", BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.Instance) System.Delegate.CreateDelegate(typeof<'Delegate>, obj, invokeMeth) :?> 'Delegate -#else - System.Delegate.CreateDelegate(typeof<'Delegate>, obj, "Invoke") :?> 'Delegate -#endif /// Run the asynchronous workflow and wait for its result. let private RunSynchronouslyInAnotherThread (token:CancellationToken,computation,timeout) = From 74626827d386bbccd361f24c8632f230829020d4 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 9 May 2018 15:13:22 +0100 Subject: [PATCH 10/39] more cleanup --- src/fsharp/FSharp.Core/control.fs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/fsharp/FSharp.Core/control.fs b/src/fsharp/FSharp.Core/control.fs index 7ff03a1ce21..10238d2c376 100644 --- a/src/fsharp/FSharp.Core/control.fs +++ b/src/fsharp/FSharp.Core/control.fs @@ -163,14 +163,14 @@ namespace Microsoft.FSharp.Control static let unfake FakeUnit = () - // Preallocate a ctxt-switching callback delegate. + // Preallocate a context-switching callback delegate. // This should be the only call to SynchronizationContext.Post in this library. We must always install a trampoline. let sendOrPostCallback = SendOrPostCallback (fun o -> let f = unbox<(unit -> AsyncReturn)> o this.ExecuteWithTrampoline f |> unfake) - // Preallocate a ctxt-switching callback delegate. + // Preallocate a context-switching callback delegate. // This should be the only call to QueueUserWorkItem in this library. We must always install a trampoline. let waitCallbackForQueueWorkItemWithTrampoline = WaitCallback (fun o -> From 683a777d6316eccf3f54ccf825938262552d8d96 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 9 May 2018 16:39:51 +0100 Subject: [PATCH 11/39] minor fixes --- src/fsharp/FSharp.Core/control.fs | 77 ++++++++++++++++++------------ src/fsharp/FSharp.Core/control.fsi | 5 +- 2 files changed, 50 insertions(+), 32 deletions(-) diff --git a/src/fsharp/FSharp.Core/control.fs b/src/fsharp/FSharp.Core/control.fs index aba7990acd6..d9ec279d42c 100644 --- a/src/fsharp/FSharp.Core/control.fs +++ b/src/fsharp/FSharp.Core/control.fs @@ -119,8 +119,9 @@ namespace Microsoft.FSharp.Control static let unfake FakeUnit = () - /// Use this object with a trampoline on the synchronous stack if none exists, and execute + /// Use this trampoline on the synchronous stack if none exists, and execute /// the given function. The function might write its continuation into the trampoline. + [] member __.Execute (firstAction : unit -> AsyncReturn) = let rec loop action = action() |> unfake @@ -129,6 +130,7 @@ namespace Microsoft.FSharp.Control | Some newAction -> cont <- None loop newAction + let thisIsTopTrampoline = if Trampoline.thisThreadHasTrampoline then false @@ -177,21 +179,21 @@ namespace Microsoft.FSharp.Control let sendOrPostCallback = SendOrPostCallback (fun o -> let f = unbox<(unit -> AsyncReturn)> o - this.ExecuteWithTrampoline f |> unfake) + this.Execute f |> unfake) // Preallocate a context-switching callback delegate. // This should be the only call to QueueUserWorkItem in this library. We must always install a trampoline. let waitCallbackForQueueWorkItemWithTrampoline = WaitCallback (fun o -> let f = unbox<(unit -> AsyncReturn)> o - this.ExecuteWithTrampoline f |> unfake) + this.Execute f |> unfake) #if !FX_NO_PARAMETERIZED_THREAD_START // This should be the only call to Thread.Start in this library. We must always install a trampoline. let threadStartCallbackForStartThreadWithTrampoline = ParameterizedThreadStart (fun o -> let f = unbox<(unit -> AsyncReturn)> o - this.ExecuteWithTrampoline f |> unfake) + this.Execute f |> unfake) #endif member this.Post (syncCtxt: SynchronizationContext) (f : unit -> AsyncReturn) = @@ -209,7 +211,7 @@ namespace Microsoft.FSharp.Control #if FX_NO_THREAD this.QueueWorkItem(f) #else - (new Thread((fun _ -> this.ExecuteWithTrampoline f |> unfake), IsBackground=true)).Start() + (new Thread((fun _ -> this.Execute f |> unfake), IsBackground=true)).Start() FakeUnit #endif @@ -221,7 +223,8 @@ namespace Microsoft.FSharp.Control #endif /// Execute an async computation after installing a trampoline on its synchronous stack. - member __.ExecuteWithTrampoline firstAction = + [] + member __.Execute firstAction = trampoline <- new Trampoline() trampoline.Execute firstAction @@ -401,7 +404,7 @@ namespace Microsoft.FSharp.Control let waitCallbackForQueueWorkItemWithTrampoline(trampolineHolder : TrampolineHolder) = WaitCallback(fun o -> let f = unbox o : unit -> AsyncReturn - trampolineHolder.ExecuteWithTrampoline f |> unfake) + trampolineHolder.Execute f |> unfake) let startThreadWithTrampoline (trampolineHolder:TrampolineHolder) (f : unit -> AsyncReturn) = #if FX_NO_THREAD @@ -409,7 +412,7 @@ namespace Microsoft.FSharp.Control failwith "failed to queue user work item" FakeUnit #else - (new Thread((fun _ -> trampolineHolder.ExecuteWithTrampoline f |> unfake), IsBackground=true)).Start() + (new Thread((fun _ -> trampolineHolder.Execute f |> unfake), IsBackground=true)).Start() FakeUnit #endif @@ -419,7 +422,7 @@ namespace Microsoft.FSharp.Control let threadStartCallbackForStartThreadWithTrampoline = ParameterizedThreadStart (fun o -> let (trampolineHolder,f) = unbox o : TrampolineHolder * (unit -> AsyncReturn) - trampolineHolder.ExecuteWithTrampoline f |> unfake) + trampolineHolder.Execute f |> unfake) // This should be the only call to Thread.Start in this library. We must always install a trampoline. let startThreadWithTrampoline (trampolineHolder:TrampolineHolder) (f : unit -> AsyncReturn) = @@ -429,7 +432,7 @@ namespace Microsoft.FSharp.Control let startAsync cancellationToken cont econt ccont p = let trampolineHolder = new TrampolineHolder() - trampolineHolder.ExecuteWithTrampoline (fun () -> startA cancellationToken trampolineHolder cont econt ccont p) + trampolineHolder.Execute (fun () -> startA cancellationToken trampolineHolder cont econt ccont p) let queueAsync cancellationToken cont econt ccont p = let trampolineHolder = new TrampolineHolder() @@ -507,6 +510,9 @@ namespace Microsoft.FSharp.Control else protectUserCodeIncludingHijackCheck ctxt.aux.trampolineHolder part2f result1 ctxt.aux.econt (fun part2 -> part2.Invoke ctxt) + let inline CallDelay ctxt generator = + Call ctxt () generator + let TryFinally (ctxt: AsyncActivation<'T>) finallyFunction computation = if ctxt.IsCancellationRequested then ctxt.OnCancellation () @@ -554,7 +560,9 @@ namespace Microsoft.FSharp.Control MakeAsync (fun ctxt -> Call ctxt result1 part2f) // delayPrim = "bindA (return ()) f" - let inline delayA f = callA f () + let inline delayA computation = + // Note: this code ends up in user assemblies via inlining + MakeAsync (fun ctxt -> CallDelay ctxt computation) /// Implements the sequencing construct of async computation expressions let inline sequentialA part1 part2 = @@ -574,9 +582,7 @@ namespace Microsoft.FSharp.Control if ctxt.IsCancellationRequested then ctxt.OnCancellation () else - let econt (edi: ExceptionDispatchInfo) = - let ecomputation = callA catchFunction edi - ecomputation.Invoke ctxt + let econt (edi: ExceptionDispatchInfo) = Call ctxt edi catchFunction let newCtxt = { ctxt with aux = { ctxt.aux with econt = econt } } computation.Invoke newCtxt) @@ -685,7 +691,7 @@ namespace Microsoft.FSharp.Control member __.ContinueImmediate res = let action () = ctxt.cont res - let inline executeImmediately () = trampolineHolder.ExecuteWithTrampoline action + let inline executeImmediately () = trampolineHolder.Execute action let currentSyncCtxt = SynchronizationContext.Current match syncCtxt, currentSyncCtxt with | null, null -> @@ -860,6 +866,7 @@ namespace Microsoft.FSharp.Control System.Delegate.CreateDelegate(typeof<'Delegate>, obj, invokeMeth) :?> 'Delegate /// Run the asynchronous workflow and wait for its result. + [] let private RunSynchronouslyInAnotherThread (token:CancellationToken,computation,timeout) = let token,innerCTS = // If timeout is provided, we govern the async by our own CTS, to cancel @@ -895,11 +902,12 @@ namespace Microsoft.FSharp.Control | None -> () commit res + [] let private RunSynchronouslyInCurrentThread (token:CancellationToken,computation) = use resultCell = new ResultCell>() let trampolineHolder = TrampolineHolder() - trampolineHolder.ExecuteWithTrampoline + trampolineHolder.Execute (fun () -> startA token @@ -912,7 +920,8 @@ namespace Microsoft.FSharp.Control commit (resultCell.TryWaitForResultSynchronously() |> Option.get) - let RunSynchronously (token:CancellationToken,computation,timeout) = + [] + let RunSynchronously (token:CancellationToken, computation: Async<'T>, timeout) = // Reuse the current ThreadPool thread if possible. Unfortunately // Thread.IsThreadPoolThread isn't available on all profiles so // we approximate it by testing synchronization context for null. @@ -929,6 +938,7 @@ namespace Microsoft.FSharp.Control // for the cancellation and run the computation in another thread. | _ -> RunSynchronouslyInAnotherThread (token, computation, timeout) + [] let Start token computation = queueAsync token @@ -938,9 +948,11 @@ namespace Microsoft.FSharp.Control computation |> unfake + [] let StartWithContinuations(token:CancellationToken, a:Async<'T>, cont, econt, ccont) : unit = startAsync token (cont >> fake) (econt >> fake) (ccont >> fake) a |> ignore + [] let StartAsTask token computation taskCreationOptions = let taskCreationOptions = defaultArg taskCreationOptions TaskCreationOptions.None let tcs = new TaskCompletionSource<_>(taskCreationOptions) @@ -960,10 +972,11 @@ namespace Microsoft.FSharp.Control // Helper to attach continuation to the given task. // Should be invoked as a part of protectUserCodeAsAsync(withResync) call + [] let taskContinueWith (task : Task<'T>) ctxt useCcontForTaskCancellation = let continuation (completedTask: Task<_>) : unit = - ctxt.aux.trampolineHolder.ExecuteWithTrampoline ((fun () -> + ctxt.aux.trampolineHolder.Execute ((fun () -> if completedTask.IsCanceled then if useCcontForTaskCancellation then ctxt.OnCancellation () @@ -978,10 +991,11 @@ namespace Microsoft.FSharp.Control task.ContinueWith(Action>(continuation)) |> ignore |> fake + [] let taskContinueWithUnit (task: Task) ctxt useCcontForTaskCancellation = let continuation (completedTask: Task) : unit = - ctxt.aux.trampolineHolder.ExecuteWithTrampoline ((fun () -> + ctxt.aux.trampolineHolder.Execute ((fun () -> if completedTask.IsCanceled then if useCcontForTaskCancellation then ctxt.OnCancellation () @@ -1025,6 +1039,7 @@ namespace Microsoft.FSharp.Control | None -> failwith "unreachable" member x.IsClosed = disposed + member x.Close() = if not disposed then disposed <- true @@ -1084,7 +1099,7 @@ namespace Microsoft.FSharp.Control type AsyncBuilder() = member __.Zero () = unitAsync - member inline __.Delay generator = delayA generator + member __.Delay generator = delayA generator member inline __.Return value = resultA value @@ -1135,7 +1150,7 @@ namespace Microsoft.FSharp.Control let syncCtxt = getSyncContext() postOrQueue syncCtxt aux.trampolineHolder (fun () -> cont x) |> unfake else - aux.trampolineHolder.ExecuteWithTrampoline (fun () -> cont x ) |> unfake + aux.trampolineHolder.Execute (fun () -> cont x ) |> unfake try callback (once ctxt.cont, (fun exn -> once aux.econt (MayLoseStackTrace(exn))), once aux.ccont) with exn -> @@ -1216,9 +1231,9 @@ namespace Microsoft.FSharp.Control if (remaining = 0) then innerCTS.Dispose() match (!firstExn) with - | None -> trampolineHolder.ExecuteWithTrampoline (fun () -> ctxtWithSync.cont results) - | Some (Choice1Of2 exn) -> trampolineHolder.ExecuteWithTrampoline (fun () -> aux.econt exn) - | Some (Choice2Of2 cexn) -> trampolineHolder.ExecuteWithTrampoline (fun () -> aux.ccont cexn) + | None -> trampolineHolder.Execute (fun () -> ctxtWithSync.cont results) + | Some (Choice1Of2 exn) -> trampolineHolder.Execute (fun () -> aux.econt exn) + | Some (Choice2Of2 cexn) -> trampolineHolder.Execute (fun () -> aux.ccont cexn) else FakeUnit @@ -1278,25 +1293,25 @@ namespace Microsoft.FSharp.Control match result with | Some _ -> if Interlocked.Increment exnCount = 1 then - innerCts.Cancel(); trampolineHolder.ExecuteWithTrampoline (fun () -> ctxtWithSync.cont result) + innerCts.Cancel(); trampolineHolder.Execute (fun () -> ctxtWithSync.cont result) else FakeUnit | None -> if Interlocked.Increment noneCount = computations.Length then - innerCts.Cancel(); trampolineHolder.ExecuteWithTrampoline (fun () -> ctxtWithSync.cont None) + innerCts.Cancel(); trampolineHolder.Execute (fun () -> ctxtWithSync.cont None) else FakeUnit let econt (exn : ExceptionDispatchInfo) = if Interlocked.Increment exnCount = 1 then - innerCts.Cancel(); trampolineHolder.ExecuteWithTrampoline (fun () -> ctxtWithSync.aux.econt exn) + innerCts.Cancel(); trampolineHolder.Execute (fun () -> ctxtWithSync.aux.econt exn) else FakeUnit let ccont (exn : OperationCanceledException) = if Interlocked.Increment exnCount = 1 then - innerCts.Cancel(); trampolineHolder.ExecuteWithTrampoline (fun () -> ctxtWithSync.aux.ccont exn) + innerCts.Cancel(); trampolineHolder.Execute (fun () -> ctxtWithSync.aux.ccont exn) else FakeUnit @@ -1344,7 +1359,7 @@ namespace Microsoft.FSharp.Control match !timer with | None -> () | Some t -> t.Dispose() - aux.trampolineHolder.ExecuteWithTrampoline (fun () -> savedCCont(new OperationCanceledException(aux.token))) |> unfake + aux.trampolineHolder.Execute (fun () -> savedCCont(new OperationCanceledException(aux.token))) |> unfake ), null) let mutable edi = null @@ -1364,7 +1379,7 @@ namespace Microsoft.FSharp.Control | None -> () | Some t -> t.Dispose() // Now we're done, so call the continuation - aux.trampolineHolder.ExecuteWithTrampoline (fun () -> savedCont()) |> unfake), + aux.trampolineHolder.Execute (fun () -> savedCont()) |> unfake), null, dueTime=millisecondsDueTime, period = -1) |> Some with exn -> if latch.Enter() then @@ -1420,7 +1435,7 @@ namespace Microsoft.FSharp.Control lock rwh (fun () -> rwh.Value.Value.Unregister(null) |> ignore) rwh := None registration.Dispose() - aux.trampolineHolder.ExecuteWithTrampoline (fun () -> savedCont (not timeOut)) |> unfake), + aux.trampolineHolder.Execute (fun () -> savedCont (not timeOut)) |> unfake), state=null, millisecondsTimeOutInterval=millisecondsTimeout, executeOnlyOnce=true)); diff --git a/src/fsharp/FSharp.Core/control.fsi b/src/fsharp/FSharp.Core/control.fsi index 02372782ab7..24f18c10c24 100644 --- a/src/fsharp/FSharp.Core/control.fsi +++ b/src/fsharp/FSharp.Core/control.fsi @@ -457,6 +457,9 @@ namespace Microsoft.FSharp.Control /// Calls to this member are emitted in compiled code val Call: ctxt:AsyncActivation<'T> -> result1:'U -> part2f:('U -> Async<'T>) -> AsyncReturn + // /// Calls to this member are emitted in compiled code + // val CallDelay: ctxt:AsyncActivation<'T> -> generator:(unit -> Async<'T>) -> AsyncReturn + /// Calls to this member are emitted in compiled code val Bind: keepStack: bool -> ctxt:AsyncActivation<'T> -> part1:Async<'U> -> part2f:('U -> Async<'T>) -> AsyncReturn @@ -538,7 +541,7 @@ namespace Microsoft.FSharp.Control /// A cancellation check is performed when the computation is executed. /// The function to run. /// An asynchronous computation that runs generator. - member inline Delay : generator:(unit -> Async<'T>) -> Async<'T> + member Delay : generator:(unit -> Async<'T>) -> Async<'T> /// Creates an asynchronous computation that runs binder(resource). /// The action resource.Dispose() is executed as this computation yields its result From cd2d7c7a909e67946e05d45ada5970f4a96b1fb6 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 9 May 2018 17:14:31 +0100 Subject: [PATCH 12/39] minor fixes --- src/fsharp/FSharp.Core/control.fs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/fsharp/FSharp.Core/control.fs b/src/fsharp/FSharp.Core/control.fs index febd86b2a56..eb6a2ce64d6 100644 --- a/src/fsharp/FSharp.Core/control.fs +++ b/src/fsharp/FSharp.Core/control.fs @@ -975,7 +975,7 @@ namespace Microsoft.FSharp.Control let taskContinueWith (task : Task<'T>) ctxt useCcontForTaskCancellation = let continuation (completedTask: Task<_>) : unit = - ctxt.aux.trampolineHolder.ExecuteWithTrampoline ((fun () -> + ctxt.aux.trampolineHolder.Execute (fun () -> if completedTask.IsCanceled then if useCcontForTaskCancellation then ctxt.OnCancellation () @@ -986,7 +986,7 @@ namespace Microsoft.FSharp.Control let edi = MayLoseStackTrace(completedTask.Exception) ctxt.CallExceptionContinuation edi else - ctxt.cont completedTask.Result)) |> unfake + ctxt.cont completedTask.Result) |> unfake task.ContinueWith(Action>(continuation)) |> ignore |> fake @@ -994,7 +994,7 @@ namespace Microsoft.FSharp.Control let taskContinueWithUnit (task: Task) ctxt useCcontForTaskCancellation = let continuation (completedTask: Task) : unit = - ctxt.aux.trampolineHolder.Execute ((fun () -> + ctxt.aux.trampolineHolder.Execute (fun () -> if completedTask.IsCanceled then if useCcontForTaskCancellation then ctxt.OnCancellation () @@ -1005,7 +1005,7 @@ namespace Microsoft.FSharp.Control let edi = MayLoseStackTrace(completedTask.Exception) ctxt.CallExceptionContinuation edi else - ctxt.cont ())) |> unfake + ctxt.cont ()) |> unfake task.ContinueWith(Action(continuation)) |> ignore |> fake From 660a881884f715d57daad33c0d716fefc121975a Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 9 May 2018 23:37:23 +0100 Subject: [PATCH 13/39] full exception stacktraces --- src/fsharp/FSharp.Core/control.fs | 230 +++++++++++------- src/fsharp/FSharp.Core/control.fsi | 4 +- .../SurfaceArea.coreclr.fs | 20 ++ .../SurfaceArea.net40.fs | 20 ++ 4 files changed, 185 insertions(+), 89 deletions(-) diff --git a/src/fsharp/FSharp.Core/control.fs b/src/fsharp/FSharp.Core/control.fs index f0fe3227515..3d9562343ce 100644 --- a/src/fsharp/FSharp.Core/control.fs +++ b/src/fsharp/FSharp.Core/control.fs @@ -84,6 +84,33 @@ namespace Microsoft.FSharp.Control member this.Dispose() = this.Dispose() + /// Global mutable state used to associate Exception + + [] + module ExceptionDispatchInfoHelpers = + + let associationTable = System.Runtime.CompilerServices.ConditionalWeakTable() + + type ExceptionDispatchInfo with + + member edi.GetAssociatedSourceException() = + let exn = edi.SourceException + // Try to store the entry in the association table to allow us to recover it later. + try lock associationTable (fun () -> associationTable.Add(exn, edi)) with _ -> () + exn + + // Capture, but prefer the saved information if available + //[] + static member RestoreOrCapture(exn) = + match lock associationTable (fun () -> associationTable.TryGetValue(exn)) with + | true, edi -> edi + | _ -> + ExceptionDispatchInfo.Capture(exn) + + member inline edi.ThrowAny() = + edi.Throw() + Unchecked.defaultof<'T> // Note, this line should not be reached, but gives a generic return type + // F# don't always take tailcalls to functions returning 'unit' because this // is represented as type 'void' in the underlying IL. // Hence we don't use the 'unit' return type here, and instead invent our own type. @@ -99,6 +126,8 @@ namespace Microsoft.FSharp.Control [] type Trampoline() = + let unfake FakeUnit = () + [] static let bindLimitBeforeHijack = 300 @@ -109,21 +138,20 @@ namespace Microsoft.FSharp.Control static member ThisThreadHasTrampoline = Trampoline.thisThreadHasTrampoline - let mutable cont = None + let mutable storedCont = None + let mutable storedExnCont = None let mutable bindCount = 0 - static let unfake FakeUnit = () - /// Use this trampoline on the synchronous stack if none exists, and execute /// the given function. The function might write its continuation into the trampoline. - [] + //[] member __.Execute (firstAction : unit -> AsyncReturn) = let rec loop action = action() |> unfake - match cont with + match storedCont with | None -> () | Some newAction -> - cont <- None + storedCont <- None loop newAction let thisIsTopTrampoline = @@ -136,13 +164,24 @@ namespace Microsoft.FSharp.Control let mutable keepGoing = true let mutable action = firstAction while keepGoing do - action() |> unfake - match cont with - | None -> - keepGoing <- false - | Some newAction -> - cont <- None - action <- newAction + try + action() |> unfake + match storedCont with + | None -> + keepGoing <- false + | Some cont -> + storedCont <- None + action <- cont + with exn -> + match storedExnCont with + | None -> + reraise() + | Some econt -> + storedExnCont <- None + keepGoing <- false + let edi = ExceptionDispatchInfo.RestoreOrCapture exn + econt edi |> unfake + finally if thisIsTopTrampoline then Trampoline.thisThreadHasTrampoline <- false @@ -154,15 +193,18 @@ namespace Microsoft.FSharp.Control bindCount <- bindCount + 1 bindCount >= bindLimitBeforeHijack - /// Abandon the synchronous stack of the current execution and save the continuation in the trampoline. + /// Prepare to abandon the synchronous stack of the current execution and save the continuation in the trampoline. member __.Set action = - match cont with + match storedCont with | None -> bindCount <- 0 - cont <- Some action + storedCont <- Some action | _ -> failwith "Internal error: attempting to install continuation twice" FakeUnit + /// Save the exception continuation during propagation of an exception + member __.SaveExceptionContinuation (action: econt) = + storedExnCont <- Some action type TrampolineHolder() as this = let mutable trampoline = null @@ -218,7 +260,7 @@ namespace Microsoft.FSharp.Control #endif /// Execute an async computation after installing a trampoline on its synchronous stack. - [] + //[] member __.Execute firstAction = trampoline <- new Trampoline() trampoline.Execute firstAction @@ -232,6 +274,10 @@ namespace Microsoft.FSharp.Control else // NOTE: this must be a tailcall cont res + + /// Call the exception continuation of the active computation + member __.SaveExceptionContinuation(econt) = + trampoline.SaveExceptionContinuation econt [] [] @@ -261,10 +307,14 @@ namespace Microsoft.FSharp.Control else ctxt.aux.trampolineHolder.HijackCheck ctxt.cont result - /// Call the exception continuation of the active computation + /// Call the exception continuation directly member ctxt.CallExceptionContinuation edi = ctxt.aux.econt edi + /// Call the exception continuation of the active computation + member ctxt.SaveExceptionContinuation() = + ctxt.aux.trampolineHolder.SaveExceptionContinuation ctxt.aux.econt + [] [] type Async<'T> = @@ -302,65 +352,65 @@ namespace Microsoft.FSharp.Control let mutable defaultCancellationTokenSource = new CancellationTokenSource() - /// Global mutable state used to associate Exception - let associationTable = System.Runtime.CompilerServices.ConditionalWeakTable() - - type ExceptionDispatchInfo with - - member edi.GetAssociatedSourceException() = - let exn = edi.SourceException - // Try to store the entry in the association table to allow us to recover it later. - try lock associationTable (fun () -> associationTable.Add(exn, edi)) with _ -> () - exn + /// Apply userCode to x and call either the continuation or exception continuation depending what happens + //[] + let inline protectUserCodeIncludingHijackCheck (trampolineHolder:TrampolineHolder) userCode x econt (cont : 'T -> AsyncReturn) : AsyncReturn = + // This is deliberately written in a allocation-free style, except when the trampoline is taken + let mutable res = Unchecked.defaultof<_> + let mutable ok = false - // Capture, but prefer the saved information if available - static member inline RestoreOrCapture(exn) = - match lock associationTable (fun () -> associationTable.TryGetValue(exn)) with - | true, edi -> edi - | _ -> - ExceptionDispatchInfo.Capture(exn) + try + res <- userCode x + ok <- true + finally + if not ok then + trampolineHolder.SaveExceptionContinuation econt - member inline edi.ThrowAny() = - edi.Throw() - Unchecked.defaultof<'T> // Note, this line should not be reached, but gives a generic return type + if ok then + trampolineHolder.HijackCheck cont res + else + FakeUnit /// Apply userCode to x and call either the continuation or exception continuation depending what happens - let inline protectUserCodeIncludingHijackCheck (trampolineHolder:TrampolineHolder) userCode x econt (cont : 'T -> AsyncReturn) : AsyncReturn = + //[] + let inline protectUserCodeIncludingHijackCheckThenBind (ctxt: AsyncActivation<_>) userCode x : AsyncReturn = // This is deliberately written in a allocation-free style, except when the trampoline is taken let mutable res = Unchecked.defaultof<_> - let mutable edi = null + let mutable ok = false try res <- userCode x - with exn -> - edi <- ExceptionDispatchInfo.RestoreOrCapture(exn) + ok <- true + finally + if not ok then + ctxt.SaveExceptionContinuation() - match edi with - | null -> - // NOTE: this must be a tailcall - trampolineHolder.HijackCheck cont res - | _ -> - // NOTE: this must be a tailcall - trampolineHolder.HijackCheck econt edi + if ok then + let trampoline = ctxt.aux.trampolineHolder.Trampoline + if trampoline.IncrementBindCount() then + trampoline.Set (fun () -> res.Invoke ctxt) + else + // NOTE: this must be a tailcall + res.Invoke ctxt + else + FakeUnit // Apply userCode to x and call either the continuation or exception continuation depending what happens - let inline protectUserCodeNoHijackCheck userCode x econt (cont : 'T -> AsyncReturn) : AsyncReturn = + let inline protectUserCodeNoHijackCheckThenBind (ctxt: AsyncActivation<_>) userCode x : AsyncReturn = // This is deliberately written in a allocation-free style let mutable res = Unchecked.defaultof<_> - let mutable edi = null + let mutable ok = false try res <- userCode x - with exn -> - edi <- ExceptionDispatchInfo.RestoreOrCapture(exn) + ok <- true + finally + if not ok then + ctxt.SaveExceptionContinuation() - match edi with - | null -> - // NOTE: this must be a tailcall - cont res - | exn -> - // NOTE: this must be a tailcall - econt exn + if ok then + res.Invoke ctxt + else FakeUnit /// Perform a cancellation check and ensure that any exceptions raised by /// the immediate execution of "userCode" are sent to the exception continuation. @@ -368,13 +418,17 @@ namespace Microsoft.FSharp.Control if ctxt.IsCancellationRequested then ctxt.OnCancellation () else + let mutable ok = false try - userCode ctxt - with exn -> - let edi = ExceptionDispatchInfo.RestoreOrCapture(exn) - ctxt.CallExceptionContinuation edi + let res = userCode ctxt + ok <- true + res + finally + if not ok then + ctxt.SaveExceptionContinuation() /// Reify exceptional results as exceptions + //[] let commit res = match res with | AsyncResult.Ok res -> res @@ -383,6 +437,7 @@ namespace Microsoft.FSharp.Control // Reify exceptional results as exceptionsJIT 64 doesn't always take tailcalls correctly + //[] let commitWithPossibleTimeout res = match res with | None -> raise (System.TimeoutException()) @@ -443,14 +498,14 @@ namespace Microsoft.FSharp.Control /// notably .NET 4.x tasks and user exceptions passed to the exception continuation in Async.FromContinuations. let MayLoseStackTrace exn = ExceptionDispatchInfo.RestoreOrCapture exn - /// Build a context suitable for running part1 of a computation and passing the result to part2f - let bindPart2 ctxt part2f = - let cont a = protectUserCodeNoHijackCheck part2f a ctxt.aux.econt (fun part2 -> part2.Invoke ctxt) + /// Build a context suitable for running part1 of a computation and passing the result to part2 + let bindPart2 ctxt part2 = + let cont a = protectUserCodeNoHijackCheckThenBind ctxt part2 a { cont=cont; aux = ctxt.aux } - [] + //[] // Note: direct calls to this function end up in user assemblies via inlining - let rec Bind keepStack (ctxt: AsyncActivation<_>) part1 part2f = + let rec Bind keepStack (ctxt: AsyncActivation<_>) part1 part2 = // Cancellation check if ctxt.IsCancellationRequested then ctxt.OnCancellation () @@ -459,7 +514,7 @@ namespace Microsoft.FSharp.Control let trampoline = ctxt.aux.trampolineHolder.Trampoline if trampoline.IncrementBindCount() then - trampoline.Set(fun () -> Bind keepStack ctxt part1 part2f) + trampoline.Set(fun () -> Bind keepStack ctxt part1 part2) // In debug code, keep a stack frame for the synchronous invocation of part1, but drop it for part2 elif keepStack then @@ -474,7 +529,7 @@ namespace Microsoft.FSharp.Control if latch.Enter() then FakeUnit else - protectUserCodeNoHijackCheck part2f result1 ctxt.aux.econt (fun part2 -> part2.Invoke ctxt) + protectUserCodeNoHijackCheckThenBind ctxt part2 result1 { cont=cont; aux = ctxt.aux } let result2 = part1.Invoke ctxtPart1ThenPart2 @@ -489,25 +544,26 @@ namespace Microsoft.FSharp.Control // This indicates the body should be run sync using the saved result. // // NOTE: this must be a tailcall to drop the part1 frame off the stack. - protectUserCodeNoHijackCheck part2f savedResult1 ctxt.aux.econt (fun part2 -> part2.Invoke ctxt) + protectUserCodeNoHijackCheckThenBind ctxt part2 savedResult1 else - let ctxtPart1ThenPart2 = bindPart2 ctxt part2f + let ctxtPart1ThenPart2 = bindPart2 ctxt part2 part1.Invoke ctxtPart1ThenPart2 - [] + //[] /// Execute user code but first check for trampoline and cancellation. // // Note: direct calls to this function end up in user assemblies via inlining - let Call (ctxt: AsyncActivation<'T>) result1 (part2f: 'U -> Async<'T>) = + let Call (ctxt: AsyncActivation<'T>) result1 (part2: 'U -> Async<'T>) = if ctxt.IsCancellationRequested then ctxt.OnCancellation () else - protectUserCodeIncludingHijackCheck ctxt.aux.trampolineHolder part2f result1 ctxt.aux.econt (fun part2 -> part2.Invoke ctxt) + protectUserCodeIncludingHijackCheckThenBind ctxt part2 result1 let inline CallDelay ctxt generator = Call ctxt () generator + //[] let TryFinally (ctxt: AsyncActivation<'T>) finallyFunction computation = if ctxt.IsCancellationRequested then ctxt.OnCancellation () @@ -533,7 +589,7 @@ namespace Microsoft.FSharp.Control MakeAsync (fun ctxt -> match res with | AsyncResult.Ok r -> ctxt.cont r - | AsyncResult.Error edi -> ctxt.CallExceptionContinuation edi + | AsyncResult.Error edi -> ctxt.SaveExceptionContinuation(); edi.ThrowAny() | AsyncResult.Canceled oce -> ctxt.aux.ccont oce) // Generate async computation which calls its continuation with the given result @@ -544,15 +600,15 @@ namespace Microsoft.FSharp.Control // The primitive bind operation. Generate a process that runs the first process, takes // its result, applies f and then runs the new process produced. Hijack if necessary and // run 'f' with exception protection - let inline bindA keepStack part1 part2f = + let inline bindA keepStack part1 part2 = // Note: this code ends up in user assemblies via inlining - MakeAsync (fun ctxt -> Bind keepStack ctxt part1 part2f) + MakeAsync (fun ctxt -> Bind keepStack ctxt part1 part2) // Call the given function with exception protection, but first // check for cancellation. - let inline callA part2f result1 = + let inline callA part2 result1 = // Note: this code ends up in user assemblies via inlining - MakeAsync (fun ctxt -> Call ctxt result1 part2f) + MakeAsync (fun ctxt -> Call ctxt result1 part2) // delayPrim = "bindA (return ()) f" let inline delayA computation = @@ -861,7 +917,7 @@ namespace Microsoft.FSharp.Control System.Delegate.CreateDelegate(typeof<'Delegate>, obj, invokeMeth) :?> 'Delegate /// Run the asynchronous workflow and wait for its result. - [] + //[] let private RunSynchronouslyInAnotherThread (token:CancellationToken,computation,timeout) = let token,innerCTS = // If timeout is provided, we govern the async by our own CTS, to cancel @@ -897,7 +953,7 @@ namespace Microsoft.FSharp.Control | None -> () commit res - [] + //[] let private RunSynchronouslyInCurrentThread (token:CancellationToken,computation) = use resultCell = new ResultCell>() let trampolineHolder = TrampolineHolder() @@ -915,7 +971,7 @@ namespace Microsoft.FSharp.Control commit (resultCell.TryWaitForResultSynchronously() |> Option.get) - [] + //[] let RunSynchronously (token:CancellationToken, computation: Async<'T>, timeout) = // Reuse the current ThreadPool thread if possible. Unfortunately // Thread.IsThreadPoolThread isn't available on all profiles so @@ -933,7 +989,7 @@ namespace Microsoft.FSharp.Control // for the cancellation and run the computation in another thread. | _ -> RunSynchronouslyInAnotherThread (token, computation, timeout) - [] + //[] let Start token computation = queueAsync token @@ -943,11 +999,11 @@ namespace Microsoft.FSharp.Control computation |> unfake - [] + //[] let StartWithContinuations(token:CancellationToken, a:Async<'T>, cont, econt, ccont) : unit = startAsync token (cont >> fake) (econt >> fake) (ccont >> fake) a |> ignore - [] + //[] let StartAsTask token computation taskCreationOptions = let taskCreationOptions = defaultArg taskCreationOptions TaskCreationOptions.None let tcs = new TaskCompletionSource<_>(taskCreationOptions) @@ -985,7 +1041,7 @@ namespace Microsoft.FSharp.Control task.ContinueWith(Action>(continuation)) |> ignore |> fake - [] + //[] let taskContinueWithUnit (task: Task) ctxt useCcontForTaskCancellation = let continuation (completedTask: Task) : unit = diff --git a/src/fsharp/FSharp.Core/control.fsi b/src/fsharp/FSharp.Core/control.fsi index 24f18c10c24..386ca9f8ead 100644 --- a/src/fsharp/FSharp.Core/control.fsi +++ b/src/fsharp/FSharp.Core/control.fsi @@ -455,13 +455,13 @@ namespace Microsoft.FSharp.Control val MakeAsync: body:(AsyncActivation<'T> -> AsyncReturn) -> Async<'T> /// Calls to this member are emitted in compiled code - val Call: ctxt:AsyncActivation<'T> -> result1:'U -> part2f:('U -> Async<'T>) -> AsyncReturn + val Call: ctxt:AsyncActivation<'T> -> result1:'U -> part2:('U -> Async<'T>) -> AsyncReturn // /// Calls to this member are emitted in compiled code // val CallDelay: ctxt:AsyncActivation<'T> -> generator:(unit -> Async<'T>) -> AsyncReturn /// Calls to this member are emitted in compiled code - val Bind: keepStack: bool -> ctxt:AsyncActivation<'T> -> part1:Async<'U> -> part2f:('U -> Async<'T>) -> AsyncReturn + val Bind: keepStack: bool -> ctxt:AsyncActivation<'T> -> part1:Async<'U> -> part2:('U -> Async<'T>) -> AsyncReturn /// Calls to this member are emitted in compiled code val TryFinally: ctxt:AsyncActivation<'T> -> finallyFunction: (unit -> unit) -> computation: Async<'T> -> AsyncReturn diff --git a/tests/FSharp.Core.UnitTests/SurfaceArea.coreclr.fs b/tests/FSharp.Core.UnitTests/SurfaceArea.coreclr.fs index c9738c1b8ba..655325c92d0 100644 --- a/tests/FSharp.Core.UnitTests/SurfaceArea.coreclr.fs +++ b/tests/FSharp.Core.UnitTests/SurfaceArea.coreclr.fs @@ -567,6 +567,26 @@ Microsoft.FSharp.Collections.SetModule: TState FoldBack[T,TState](Microsoft.FSha Microsoft.FSharp.Collections.SetModule: TState Fold[T,TState](Microsoft.FSharp.Core.FSharpFunc`2[TState,Microsoft.FSharp.Core.FSharpFunc`2[T,TState]], TState, Microsoft.FSharp.Collections.FSharpSet`1[T]) Microsoft.FSharp.Collections.SetModule: T[] ToArray[T](Microsoft.FSharp.Collections.FSharpSet`1[T]) Microsoft.FSharp.Collections.SetModule: Void Iterate[T](Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.Unit], Microsoft.FSharp.Collections.FSharpSet`1[T]) +Microsoft.FSharp.Control.AsyncActivation`1[T]: Boolean Equals(System.Object) +Microsoft.FSharp.Control.AsyncActivation`1[T]: Boolean IsCancellationRequested +Microsoft.FSharp.Control.AsyncActivation`1[T]: Boolean get_IsCancellationRequested() +Microsoft.FSharp.Control.AsyncActivation`1[T]: Int32 GetHashCode() +Microsoft.FSharp.Control.AsyncActivation`1[T]: Microsoft.FSharp.Control.AsyncReturn OnCancellation() +Microsoft.FSharp.Control.AsyncActivation`1[T]: Microsoft.FSharp.Control.AsyncReturn OnSuccess(T) +Microsoft.FSharp.Control.AsyncActivation`1[T]: System.String ToString() +Microsoft.FSharp.Control.AsyncActivation`1[T]: System.Type GetType() +Microsoft.FSharp.Control.AsyncPrimitives: Boolean Equals(System.Object) +Microsoft.FSharp.Control.AsyncPrimitives: Int32 GetHashCode() +Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.AsyncReturn Bind[T,TResult](Boolean, Microsoft.FSharp.Control.AsyncActivation`1[T], Microsoft.FSharp.Control.FSharpAsync`1[TResult], Microsoft.FSharp.Core.FSharpFunc`2[TResult,Microsoft.FSharp.Control.FSharpAsync`1[T]]) +Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.AsyncReturn Call[T,TResult](Microsoft.FSharp.Control.AsyncActivation`1[T], TResult, Microsoft.FSharp.Core.FSharpFunc`2[TResult,Microsoft.FSharp.Control.FSharpAsync`1[T]]) +Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.AsyncReturn TryFinally[T](Microsoft.FSharp.Control.AsyncActivation`1[T], Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit], Microsoft.FSharp.Control.FSharpAsync`1[T]) +Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.FSharpAsync`1[T] MakeAsync[T](Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Control.AsyncActivation`1[T],Microsoft.FSharp.Control.AsyncReturn]) +Microsoft.FSharp.Control.AsyncPrimitives: System.String ToString() +Microsoft.FSharp.Control.AsyncPrimitives: System.Type GetType() +Microsoft.FSharp.Control.AsyncReturn: Boolean Equals(System.Object) +Microsoft.FSharp.Control.AsyncReturn: Int32 GetHashCode() +Microsoft.FSharp.Control.AsyncReturn: System.String ToString() +Microsoft.FSharp.Control.AsyncReturn: System.Type GetType() Microsoft.FSharp.Control.CommonExtensions: Boolean Equals(System.Object) Microsoft.FSharp.Control.CommonExtensions: Int32 GetHashCode() Microsoft.FSharp.Control.CommonExtensions: Microsoft.FSharp.Control.FSharpAsync`1[Microsoft.FSharp.Core.Unit] AsyncWrite(System.IO.Stream, Byte[], Microsoft.FSharp.Core.FSharpOption`1[System.Int32], Microsoft.FSharp.Core.FSharpOption`1[System.Int32]) diff --git a/tests/FSharp.Core.UnitTests/SurfaceArea.net40.fs b/tests/FSharp.Core.UnitTests/SurfaceArea.net40.fs index 27527ff429a..5ed5827b6fb 100644 --- a/tests/FSharp.Core.UnitTests/SurfaceArea.net40.fs +++ b/tests/FSharp.Core.UnitTests/SurfaceArea.net40.fs @@ -554,6 +554,26 @@ Microsoft.FSharp.Collections.SetModule: TState FoldBack[T,TState](Microsoft.FSha Microsoft.FSharp.Collections.SetModule: TState Fold[T,TState](Microsoft.FSharp.Core.FSharpFunc`2[TState,Microsoft.FSharp.Core.FSharpFunc`2[T,TState]], TState, Microsoft.FSharp.Collections.FSharpSet`1[T]) Microsoft.FSharp.Collections.SetModule: T[] ToArray[T](Microsoft.FSharp.Collections.FSharpSet`1[T]) Microsoft.FSharp.Collections.SetModule: Void Iterate[T](Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.Unit], Microsoft.FSharp.Collections.FSharpSet`1[T]) +Microsoft.FSharp.Control.AsyncActivation`1[T]: Boolean Equals(System.Object) +Microsoft.FSharp.Control.AsyncActivation`1[T]: Boolean IsCancellationRequested +Microsoft.FSharp.Control.AsyncActivation`1[T]: Boolean get_IsCancellationRequested() +Microsoft.FSharp.Control.AsyncActivation`1[T]: Int32 GetHashCode() +Microsoft.FSharp.Control.AsyncActivation`1[T]: Microsoft.FSharp.Control.AsyncReturn OnCancellation() +Microsoft.FSharp.Control.AsyncActivation`1[T]: Microsoft.FSharp.Control.AsyncReturn OnSuccess(T) +Microsoft.FSharp.Control.AsyncActivation`1[T]: System.String ToString() +Microsoft.FSharp.Control.AsyncActivation`1[T]: System.Type GetType() +Microsoft.FSharp.Control.AsyncPrimitives: Boolean Equals(System.Object) +Microsoft.FSharp.Control.AsyncPrimitives: Int32 GetHashCode() +Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.AsyncReturn Bind[T,TResult](Boolean, Microsoft.FSharp.Control.AsyncActivation`1[T], Microsoft.FSharp.Control.FSharpAsync`1[TResult], Microsoft.FSharp.Core.FSharpFunc`2[TResult,Microsoft.FSharp.Control.FSharpAsync`1[T]]) +Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.AsyncReturn Call[T,TResult](Microsoft.FSharp.Control.AsyncActivation`1[T], TResult, Microsoft.FSharp.Core.FSharpFunc`2[TResult,Microsoft.FSharp.Control.FSharpAsync`1[T]]) +Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.AsyncReturn TryFinally[T](Microsoft.FSharp.Control.AsyncActivation`1[T], Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit], Microsoft.FSharp.Control.FSharpAsync`1[T]) +Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.FSharpAsync`1[T] MakeAsync[T](Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Control.AsyncActivation`1[T],Microsoft.FSharp.Control.AsyncReturn]) +Microsoft.FSharp.Control.AsyncPrimitives: System.String ToString() +Microsoft.FSharp.Control.AsyncPrimitives: System.Type GetType() +Microsoft.FSharp.Control.AsyncReturn: Boolean Equals(System.Object) +Microsoft.FSharp.Control.AsyncReturn: Int32 GetHashCode() +Microsoft.FSharp.Control.AsyncReturn: System.String ToString() +Microsoft.FSharp.Control.AsyncReturn: System.Type GetType() Microsoft.FSharp.Control.CommonExtensions: Boolean Equals(System.Object) Microsoft.FSharp.Control.CommonExtensions: Int32 GetHashCode() Microsoft.FSharp.Control.CommonExtensions: Microsoft.FSharp.Control.FSharpAsync`1[Microsoft.FSharp.Core.Unit] AsyncWrite(System.IO.Stream, Byte[], Microsoft.FSharp.Core.FSharpOption`1[System.Int32], Microsoft.FSharp.Core.FSharpOption`1[System.Int32]) From fa9d4dc86beaf8edad6f1c713919527a760b3cf9 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Thu, 10 May 2018 00:42:16 +0100 Subject: [PATCH 14/39] fix test --- src/fsharp/FSharp.Core/control.fs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/fsharp/FSharp.Core/control.fs b/src/fsharp/FSharp.Core/control.fs index 3d9562343ce..ceea968813c 100644 --- a/src/fsharp/FSharp.Core/control.fs +++ b/src/fsharp/FSharp.Core/control.fs @@ -172,15 +172,15 @@ namespace Microsoft.FSharp.Control | Some cont -> storedCont <- None action <- cont + // Let the exception propagate all the way to the trampoline to get a full .StackTrace entry with exn -> match storedExnCont with | None -> reraise() | Some econt -> storedExnCont <- None - keepGoing <- false let edi = ExceptionDispatchInfo.RestoreOrCapture exn - econt edi |> unfake + action <- (fun () -> econt edi) finally if thisIsTopTrampoline then From 1742cb99826edc14656887218866d2f9e9ffc71c Mon Sep 17 00:00:00 2001 From: Don Syme Date: Thu, 10 May 2018 00:46:58 +0100 Subject: [PATCH 15/39] fix test --- src/fsharp/FSharp.Core/control.fs | 52 +++++++++++++++++-------------- 1 file changed, 29 insertions(+), 23 deletions(-) diff --git a/src/fsharp/FSharp.Core/control.fs b/src/fsharp/FSharp.Core/control.fs index ceea968813c..bc860e2e00e 100644 --- a/src/fsharp/FSharp.Core/control.fs +++ b/src/fsharp/FSharp.Core/control.fs @@ -100,7 +100,7 @@ namespace Microsoft.FSharp.Control exn // Capture, but prefer the saved information if available - //[] + [] static member RestoreOrCapture(exn) = match lock associationTable (fun () -> associationTable.TryGetValue(exn)) with | true, edi -> edi @@ -144,7 +144,7 @@ namespace Microsoft.FSharp.Control /// Use this trampoline on the synchronous stack if none exists, and execute /// the given function. The function might write its continuation into the trampoline. - //[] + [] member __.Execute (firstAction : unit -> AsyncReturn) = let rec loop action = action() |> unfake @@ -260,7 +260,7 @@ namespace Microsoft.FSharp.Control #endif /// Execute an async computation after installing a trampoline on its synchronous stack. - //[] + [] member __.Execute firstAction = trampoline <- new Trampoline() trampoline.Execute firstAction @@ -353,8 +353,8 @@ namespace Microsoft.FSharp.Control let mutable defaultCancellationTokenSource = new CancellationTokenSource() /// Apply userCode to x and call either the continuation or exception continuation depending what happens - //[] - let inline protectUserCodeIncludingHijackCheck (trampolineHolder:TrampolineHolder) userCode x econt (cont : 'T -> AsyncReturn) : AsyncReturn = + [] + let protectUserCodeIncludingHijackCheck (trampolineHolder:TrampolineHolder) userCode x econt (cont : 'T -> AsyncReturn) : AsyncReturn = // This is deliberately written in a allocation-free style, except when the trampoline is taken let mutable res = Unchecked.defaultof<_> let mutable ok = false @@ -372,8 +372,8 @@ namespace Microsoft.FSharp.Control FakeUnit /// Apply userCode to x and call either the continuation or exception continuation depending what happens - //[] - let inline protectUserCodeIncludingHijackCheckThenBind (ctxt: AsyncActivation<_>) userCode x : AsyncReturn = + [] + let protectUserCodeIncludingHijackCheckThenBind (ctxt: AsyncActivation<_>) userCode x : AsyncReturn = // This is deliberately written in a allocation-free style, except when the trampoline is taken let mutable res = Unchecked.defaultof<_> let mutable ok = false @@ -396,7 +396,8 @@ namespace Microsoft.FSharp.Control FakeUnit // Apply userCode to x and call either the continuation or exception continuation depending what happens - let inline protectUserCodeNoHijackCheckThenBind (ctxt: AsyncActivation<_>) userCode x : AsyncReturn = + [] + let protectUserCodeNoHijackCheckThenBind (ctxt: AsyncActivation<_>) userCode x : AsyncReturn = // This is deliberately written in a allocation-free style let mutable res = Unchecked.defaultof<_> let mutable ok = false @@ -414,6 +415,7 @@ namespace Microsoft.FSharp.Control /// Perform a cancellation check and ensure that any exceptions raised by /// the immediate execution of "userCode" are sent to the exception continuation. + [] let protectUserCodeInCtxt (ctxt: AsyncActivation<_>) userCode = if ctxt.IsCancellationRequested then ctxt.OnCancellation () @@ -428,7 +430,7 @@ namespace Microsoft.FSharp.Control ctxt.SaveExceptionContinuation() /// Reify exceptional results as exceptions - //[] + [] let commit res = match res with | AsyncResult.Ok res -> res @@ -437,7 +439,7 @@ namespace Microsoft.FSharp.Control // Reify exceptional results as exceptionsJIT 64 doesn't always take tailcalls correctly - //[] + [] let commitWithPossibleTimeout res = match res with | None -> raise (System.TimeoutException()) @@ -503,7 +505,7 @@ namespace Microsoft.FSharp.Control let cont a = protectUserCodeNoHijackCheckThenBind ctxt part2 a { cont=cont; aux = ctxt.aux } - //[] + [] // Note: direct calls to this function end up in user assemblies via inlining let rec Bind keepStack (ctxt: AsyncActivation<_>) part1 part2 = // Cancellation check @@ -550,7 +552,7 @@ namespace Microsoft.FSharp.Control let ctxtPart1ThenPart2 = bindPart2 ctxt part2 part1.Invoke ctxtPart1ThenPart2 - //[] + [] /// Execute user code but first check for trampoline and cancellation. // // Note: direct calls to this function end up in user assemblies via inlining @@ -563,7 +565,7 @@ namespace Microsoft.FSharp.Control let inline CallDelay ctxt generator = Call ctxt () generator - //[] + [] let TryFinally (ctxt: AsyncActivation<'T>) finallyFunction computation = if ctxt.IsCancellationRequested then ctxt.OnCancellation () @@ -917,7 +919,7 @@ namespace Microsoft.FSharp.Control System.Delegate.CreateDelegate(typeof<'Delegate>, obj, invokeMeth) :?> 'Delegate /// Run the asynchronous workflow and wait for its result. - //[] + [] let private RunSynchronouslyInAnotherThread (token:CancellationToken,computation,timeout) = let token,innerCTS = // If timeout is provided, we govern the async by our own CTS, to cancel @@ -953,7 +955,7 @@ namespace Microsoft.FSharp.Control | None -> () commit res - //[] + [] let private RunSynchronouslyInCurrentThread (token:CancellationToken,computation) = use resultCell = new ResultCell>() let trampolineHolder = TrampolineHolder() @@ -971,7 +973,7 @@ namespace Microsoft.FSharp.Control commit (resultCell.TryWaitForResultSynchronously() |> Option.get) - //[] + [] let RunSynchronously (token:CancellationToken, computation: Async<'T>, timeout) = // Reuse the current ThreadPool thread if possible. Unfortunately // Thread.IsThreadPoolThread isn't available on all profiles so @@ -989,7 +991,7 @@ namespace Microsoft.FSharp.Control // for the cancellation and run the computation in another thread. | _ -> RunSynchronouslyInAnotherThread (token, computation, timeout) - //[] + [] let Start token computation = queueAsync token @@ -999,11 +1001,11 @@ namespace Microsoft.FSharp.Control computation |> unfake - //[] + [] let StartWithContinuations(token:CancellationToken, a:Async<'T>, cont, econt, ccont) : unit = startAsync token (cont >> fake) (econt >> fake) (ccont >> fake) a |> ignore - //[] + [] let StartAsTask token computation taskCreationOptions = let taskCreationOptions = defaultArg taskCreationOptions TaskCreationOptions.None let tcs = new TaskCompletionSource<_>(taskCreationOptions) @@ -1041,7 +1043,7 @@ namespace Microsoft.FSharp.Control task.ContinueWith(Action>(continuation)) |> ignore |> fake - //[] + [] let taskContinueWithUnit (task: Task) ctxt useCcontForTaskCancellation = let continuation (completedTask: Task) : unit = @@ -1256,7 +1258,7 @@ namespace Microsoft.FSharp.Control static member Parallel (computations: seq>) = MakeAsync (fun ctxt -> - let tasks,result = + let tasks, result = try Seq.toArray computations, None // manually protect eval of seq with exn -> @@ -1266,8 +1268,11 @@ namespace Microsoft.FSharp.Control match result with | Some r -> r | None -> - if tasks.Length = 0 then ctxt.cont [| |] else // must not be in a 'protect' if we call cont explicitly; if cont throws, it should unwind the stack, preserving Dev10 behavior - protectUserCodeInCtxt ctxt (fun ctxt -> + if tasks.Length = 0 then + // must not be in a 'protect' if we call cont explicitly; if cont throws, it should unwind the stack, preserving Dev10 behavior + ctxt.cont [| |] + else + protectUserCodeInCtxt ctxt (fun ctxt -> let ctxtWithSync = delimitSyncContext ctxt // manually resync let aux = ctxtWithSync.aux let count = ref tasks.Length @@ -1391,6 +1396,7 @@ namespace Microsoft.FSharp.Control (fun _ -> ts.SetCanceled()), token) task + static member StartImmediate(computation:Async, ?cancellationToken) : unit = let token = defaultArg cancellationToken defaultCancellationTokenSource.Token AsyncPrimitives.StartWithContinuations(token, computation, id, (fun edi -> edi.ThrowAny()), ignore) From 4f043dc7cd7e5e460cffb221c7f13f560d0e14fc Mon Sep 17 00:00:00 2001 From: Don Syme Date: Thu, 10 May 2018 00:50:38 +0100 Subject: [PATCH 16/39] code review --- src/fsharp/FSharp.Core/control.fs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/fsharp/FSharp.Core/control.fs b/src/fsharp/FSharp.Core/control.fs index bc860e2e00e..04613ac2397 100644 --- a/src/fsharp/FSharp.Core/control.fs +++ b/src/fsharp/FSharp.Core/control.fs @@ -14,6 +14,7 @@ namespace Microsoft.FSharp.Control open System.Diagnostics.CodeAnalysis open System.IO open System.Reflection + open System.Runtime.CompilerServices open System.Runtime.ExceptionServices open System.Threading open System.Threading.Tasks @@ -89,20 +90,20 @@ namespace Microsoft.FSharp.Control [] module ExceptionDispatchInfoHelpers = - let associationTable = System.Runtime.CompilerServices.ConditionalWeakTable() + let associationTable = ConditionalWeakTable() type ExceptionDispatchInfo with member edi.GetAssociatedSourceException() = let exn = edi.SourceException // Try to store the entry in the association table to allow us to recover it later. - try lock associationTable (fun () -> associationTable.Add(exn, edi)) with _ -> () + try associationTable.Add(exn, edi) with _ -> () exn // Capture, but prefer the saved information if available [] static member RestoreOrCapture(exn) = - match lock associationTable (fun () -> associationTable.TryGetValue(exn)) with + match associationTable.TryGetValue(exn) with | true, edi -> edi | _ -> ExceptionDispatchInfo.Capture(exn) From d7572f285c09a388a32d74bb84c57c9be857d57d Mon Sep 17 00:00:00 2001 From: Don Syme Date: Thu, 10 May 2018 01:28:26 +0100 Subject: [PATCH 17/39] cleanup naming --- src/fsharp/FSharp.Core/control.fs | 101 +++++++++++++----------------- 1 file changed, 43 insertions(+), 58 deletions(-) diff --git a/src/fsharp/FSharp.Core/control.fs b/src/fsharp/FSharp.Core/control.fs index 04613ac2397..9f510a2fe39 100644 --- a/src/fsharp/FSharp.Core/control.fs +++ b/src/fsharp/FSharp.Core/control.fs @@ -203,7 +203,7 @@ namespace Microsoft.FSharp.Control | _ -> failwith "Internal error: attempting to install continuation twice" FakeUnit - /// Save the exception continuation during propagation of an exception + /// Save the exception continuation during propagation of an exception, or prior to raising an exception member __.SaveExceptionContinuation (action: econt) = storedExnCont <- Some action @@ -276,7 +276,7 @@ namespace Microsoft.FSharp.Control // NOTE: this must be a tailcall cont res - /// Call the exception continuation of the active computation + /// Save the exception continuation during propagation of an exception, or prior to raising an exception member __.SaveExceptionContinuation(econt) = trampoline.SaveExceptionContinuation econt @@ -312,7 +312,7 @@ namespace Microsoft.FSharp.Control member ctxt.CallExceptionContinuation edi = ctxt.aux.econt edi - /// Call the exception continuation of the active computation + /// Save the exception continuation during propagation of an exception, or prior to raising an exception member ctxt.SaveExceptionContinuation() = ctxt.aux.trampolineHolder.SaveExceptionContinuation ctxt.aux.econt @@ -339,6 +339,13 @@ namespace Microsoft.FSharp.Control | Error of ExceptionDispatchInfo | Canceled of OperationCanceledException + [] + member res.Commit () = + match res with + | AsyncResult.Ok res -> res + | AsyncResult.Error edi -> edi.ThrowAny() + | AsyncResult.Canceled exn -> raise exn + module AsyncPrimitives = // To consider: augment with more exception traceability information // To consider: add the ability to suspend running ps in debug mode @@ -355,7 +362,7 @@ namespace Microsoft.FSharp.Control /// Apply userCode to x and call either the continuation or exception continuation depending what happens [] - let protectUserCodeIncludingHijackCheck (trampolineHolder:TrampolineHolder) userCode x econt (cont : 'T -> AsyncReturn) : AsyncReturn = + let ProtectUserCodePlusHijackCheck (ctxt: AsyncActivation<_>) userCode x : AsyncReturn = // This is deliberately written in a allocation-free style, except when the trampoline is taken let mutable res = Unchecked.defaultof<_> let mutable ok = false @@ -365,16 +372,16 @@ namespace Microsoft.FSharp.Control ok <- true finally if not ok then - trampolineHolder.SaveExceptionContinuation econt + ctxt.SaveExceptionContinuation() if ok then - trampolineHolder.HijackCheck cont res + ctxt.aux.trampolineHolder.HijackCheck ctxt.cont res else FakeUnit /// Apply userCode to x and call either the continuation or exception continuation depending what happens [] - let protectUserCodeIncludingHijackCheckThenBind (ctxt: AsyncActivation<_>) userCode x : AsyncReturn = + let ProtectUserCodePlusHijackCheckThenBind (ctxt: AsyncActivation<_>) userCode x : AsyncReturn = // This is deliberately written in a allocation-free style, except when the trampoline is taken let mutable res = Unchecked.defaultof<_> let mutable ok = false @@ -396,9 +403,10 @@ namespace Microsoft.FSharp.Control else FakeUnit - // Apply userCode to x and call either the continuation or exception continuation depending what happens + /// Apply userCode to x and call either the continuation or exception continuation depending what happens. + /// Does not do a hijack check. [] - let protectUserCodeNoHijackCheckThenBind (ctxt: AsyncActivation<_>) userCode x : AsyncReturn = + let ProtectUserCodeThenBind (ctxt: AsyncActivation<_>) userCode x : AsyncReturn = // This is deliberately written in a allocation-free style let mutable res = Unchecked.defaultof<_> let mutable ok = false @@ -417,7 +425,7 @@ namespace Microsoft.FSharp.Control /// Perform a cancellation check and ensure that any exceptions raised by /// the immediate execution of "userCode" are sent to the exception continuation. [] - let protectUserCodeInCtxt (ctxt: AsyncActivation<_>) userCode = + let ProtectUserCode (ctxt: AsyncActivation<_>) userCode = if ctxt.IsCancellationRequested then ctxt.OnCancellation () else @@ -430,23 +438,8 @@ namespace Microsoft.FSharp.Control if not ok then ctxt.SaveExceptionContinuation() - /// Reify exceptional results as exceptions - [] - let commit res = - match res with - | AsyncResult.Ok res -> res - | AsyncResult.Error edi -> edi.ThrowAny() - | AsyncResult.Canceled exn -> raise exn - - // Reify exceptional results as exceptionsJIT 64 doesn't always take tailcalls correctly - - [] - let commitWithPossibleTimeout res = - match res with - | None -> raise (System.TimeoutException()) - | Some res -> commit res - /// Make an initial ctxt and execute the async computation. + [] let startA cancellationToken trampolineHolder cont econt ccont computation = let ctxt = { cont = cont; aux = { token = cancellationToken; econt = econt; ccont = ccont; trampolineHolder = trampolineHolder } } computation.Invoke ctxt @@ -458,29 +451,12 @@ namespace Microsoft.FSharp.Control WaitCallback(fun o -> let f = unbox o : unit -> AsyncReturn trampolineHolder.Execute f |> unfake) - - let startThreadWithTrampoline (trampolineHolder:TrampolineHolder) (f : unit -> AsyncReturn) = -#if FX_NO_THREAD - if not (ThreadPool.QueueUserWorkItem((waitCallbackForQueueWorkItemWithTrampoline trampolineHolder), f |> box)) then - failwith "failed to queue user work item" - FakeUnit -#else - (new Thread((fun _ -> trampolineHolder.Execute f |> unfake), IsBackground=true)).Start() - FakeUnit -#endif - #else - // Statically preallocate the delegate let threadStartCallbackForStartThreadWithTrampoline = ParameterizedThreadStart (fun o -> let (trampolineHolder,f) = unbox o : TrampolineHolder * (unit -> AsyncReturn) trampolineHolder.Execute f |> unfake) - - // This should be the only call to Thread.Start in this library. We must always install a trampoline. - let startThreadWithTrampoline (trampolineHolder:TrampolineHolder) (f : unit -> AsyncReturn) = - (new Thread(threadStartCallbackForStartThreadWithTrampoline,IsBackground=true)).Start((trampolineHolder,f)|>box) - FakeUnit #endif let startAsync cancellationToken cont econt ccont p = @@ -503,7 +479,7 @@ namespace Microsoft.FSharp.Control /// Build a context suitable for running part1 of a computation and passing the result to part2 let bindPart2 ctxt part2 = - let cont a = protectUserCodeNoHijackCheckThenBind ctxt part2 a + let cont a = ProtectUserCodeThenBind ctxt part2 a { cont=cont; aux = ctxt.aux } [] @@ -532,7 +508,7 @@ namespace Microsoft.FSharp.Control if latch.Enter() then FakeUnit else - protectUserCodeNoHijackCheckThenBind ctxt part2 result1 + ProtectUserCodeThenBind ctxt part2 result1 { cont=cont; aux = ctxt.aux } let result2 = part1.Invoke ctxtPart1ThenPart2 @@ -547,7 +523,7 @@ namespace Microsoft.FSharp.Control // This indicates the body should be run sync using the saved result. // // NOTE: this must be a tailcall to drop the part1 frame off the stack. - protectUserCodeNoHijackCheckThenBind ctxt part2 savedResult1 + ProtectUserCodeThenBind ctxt part2 savedResult1 else let ctxtPart1ThenPart2 = bindPart2 ctxt part2 @@ -561,7 +537,7 @@ namespace Microsoft.FSharp.Control if ctxt.IsCancellationRequested then ctxt.OnCancellation () else - protectUserCodeIncludingHijackCheckThenBind ctxt part2 result1 + ProtectUserCodePlusHijackCheckThenBind ctxt part2 result1 let inline CallDelay ctxt generator = Call ctxt () generator @@ -574,19 +550,25 @@ namespace Microsoft.FSharp.Control let trampolineHolder = ctxt.aux.trampolineHolder // The new continuation runs the finallyFunction and resumes the old continuation // If an exception is thrown we continue with the previous exception continuation. - let cont b = protectUserCodeIncludingHijackCheck trampolineHolder finallyFunction () ctxt.aux.econt (fun () -> ctxt.cont b) + let cont b = + let ctxt = { cont = (fun () -> ctxt.cont b); aux = ctxt.aux } + ProtectUserCodePlusHijackCheck ctxt finallyFunction () // The new exception continuation runs the finallyFunction and then runs the previous exception continuation. // If an exception is thrown we continue with the previous exception continuation. - let econt exn = protectUserCodeIncludingHijackCheck trampolineHolder finallyFunction () ctxt.aux.econt (fun () -> ctxt.aux.econt exn) + let econt exn = + let ctxt = { cont = (fun () -> ctxt.aux.econt exn); aux = ctxt.aux } + ProtectUserCodePlusHijackCheck ctxt finallyFunction () // The cancellation continuation runs the finallyFunction and then runs the previous cancellation continuation. // If an exception is thrown we continue with the previous cancellation continuation (the exception is lost) - let ccont cexn = protectUserCodeIncludingHijackCheck trampolineHolder finallyFunction () (fun _ -> ctxt.aux.ccont cexn) (fun () -> ctxt.aux.ccont cexn) + let ccont cexn = + let ctxt = { cont = (fun () -> ctxt.aux.ccont cexn); aux = { ctxt.aux with econt = (fun _ -> ctxt.aux.ccont cexn) } } + ProtectUserCodePlusHijackCheck ctxt finallyFunction () computation.Invoke { ctxt with cont = cont; aux = { ctxt.aux with econt = econt; ccont = ccont } } /// When run, ensures that any exceptions raised by the immediate execution of "f" are /// sent to the exception continuation. let protectUserCodeAsAsync f = - MakeAsync (fun ctxt -> protectUserCodeInCtxt ctxt f) + MakeAsync (fun ctxt -> ProtectUserCode ctxt f) let asyncResultToAsync res = MakeAsync (fun ctxt -> @@ -613,13 +595,13 @@ namespace Microsoft.FSharp.Control // Note: this code ends up in user assemblies via inlining MakeAsync (fun ctxt -> Call ctxt result1 part2) - // delayPrim = "bindA (return ()) f" let inline delayA computation = // Note: this code ends up in user assemblies via inlining MakeAsync (fun ctxt -> CallDelay ctxt computation) /// Implements the sequencing construct of async computation expressions let inline sequentialA part1 part2 = + // Note: this code ends up in user assemblies via inlining bindA false part1 (fun () -> part2) // Call p but augment the normal, exception and cancel continuations with a call to finallyFunction. @@ -647,7 +629,9 @@ namespace Microsoft.FSharp.Control let whenCancelledA (finallyFunction : OperationCanceledException -> unit) computation = MakeAsync (fun ctxt -> let aux = ctxt.aux - let ccont exn = protectUserCodeIncludingHijackCheck aux.trampolineHolder finallyFunction exn (fun _ -> aux.ccont exn) (fun _ -> aux.ccont exn) + let ccont exn = + let ctxt = { cont = (fun _ -> aux.ccont exn); aux = { aux with econt = (fun _ -> aux.ccont exn) } } + ProtectUserCodePlusHijackCheck ctxt finallyFunction exn let newCtxt = { ctxt with aux = { aux with ccont = ccont } } computation.Invoke newCtxt) @@ -940,7 +924,7 @@ namespace Microsoft.FSharp.Control computation |> unfake - let res = resultCell.TryWaitForResultSynchronously(?timeout = timeout) in + let res = resultCell.TryWaitForResultSynchronously(?timeout = timeout) match res with | None -> // timed out // issue cancellation signal @@ -954,7 +938,7 @@ namespace Microsoft.FSharp.Control match innerCTS with | Some subSource -> subSource.Dispose() | None -> () - commit res + res.Commit() [] let private RunSynchronouslyInCurrentThread (token:CancellationToken,computation) = @@ -972,7 +956,8 @@ namespace Microsoft.FSharp.Control computation) |> unfake - commit (resultCell.TryWaitForResultSynchronously() |> Option.get) + let res = resultCell.TryWaitForResultSynchronously().Value + res.Commit() [] let RunSynchronously (token:CancellationToken, computation: Async<'T>, timeout) = @@ -1273,7 +1258,7 @@ namespace Microsoft.FSharp.Control // must not be in a 'protect' if we call cont explicitly; if cont throws, it should unwind the stack, preserving Dev10 behavior ctxt.cont [| |] else - protectUserCodeInCtxt ctxt (fun ctxt -> + ProtectUserCode ctxt (fun ctxt -> let ctxtWithSync = delimitSyncContext ctxt // manually resync let aux = ctxtWithSync.aux let count = ref tasks.Length @@ -1337,7 +1322,7 @@ namespace Microsoft.FSharp.Control | Choice2Of2 edi -> ctxt.CallExceptionContinuation edi | Choice1Of2 [||] -> ctxt.cont None | Choice1Of2 computations -> - protectUserCodeInCtxt ctxt (fun ctxt -> + ProtectUserCode ctxt (fun ctxt -> let ctxtWithSync = delimitSyncContext ctxt let aux = ctxtWithSync.aux let noneCount = ref 0 From f195fda653921e84990bacf1eda9ca566a2e2be7 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Thu, 10 May 2018 02:12:14 +0100 Subject: [PATCH 18/39] fix build --- src/fsharp/FSharp.Core/control.fs | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/src/fsharp/FSharp.Core/control.fs b/src/fsharp/FSharp.Core/control.fs index 9f510a2fe39..fb1fbeea13d 100644 --- a/src/fsharp/FSharp.Core/control.fs +++ b/src/fsharp/FSharp.Core/control.fs @@ -547,7 +547,6 @@ namespace Microsoft.FSharp.Control if ctxt.IsCancellationRequested then ctxt.OnCancellation () else - let trampolineHolder = ctxt.aux.trampolineHolder // The new continuation runs the finallyFunction and resumes the old continuation // If an exception is thrown we continue with the previous exception continuation. let cont b = @@ -1523,17 +1522,20 @@ namespace Microsoft.FSharp.Control | Some 0 -> async { if resultCell.ResultAvailable then - return commit (resultCell.GrabResult()) + let res = resultCell.GrabResult() + return res.Commit() else return raise (System.TimeoutException()) } | _ -> async { try if resultCell.ResultAvailable then - return commit (resultCell.GrabResult()) + let res = resultCell.GrabResult() + return res.Commit() else let! ok = Async.AwaitWaitHandle (resultCell.GetWaitHandle(), ?millisecondsTimeout=millisecondsTimeout) if ok then - return commit (resultCell.GrabResult()) + let res = resultCell.GrabResult() + return res.Commit() else // timed out // issue cancellation signal innerCTS.Cancel() From d17ed221b38646a65c378202fe50601d5e5720f8 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Thu, 10 May 2018 13:15:18 +0100 Subject: [PATCH 19/39] undo rethrow and integrate cleanup --- src/fsharp/FSharp.Core/control.fs | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/fsharp/FSharp.Core/control.fs b/src/fsharp/FSharp.Core/control.fs index fb1fbeea13d..ed0b8e49125 100644 --- a/src/fsharp/FSharp.Core/control.fs +++ b/src/fsharp/FSharp.Core/control.fs @@ -470,12 +470,12 @@ namespace Microsoft.FSharp.Control /// Build a primitive without any exception or resync protection let MakeAsync body = { Invoke = body } - /// Use this to recover ExceptionDispatchInfo when outside the "with" part of a try/with block. - /// This indicates all the places where we lose a stack trace. - /// - /// Stack trace losses come when interoperating with other code that only provide us with an exception value, - /// notably .NET 4.x tasks and user exceptions passed to the exception continuation in Async.FromContinuations. - let MayLoseStackTrace exn = ExceptionDispatchInfo.RestoreOrCapture exn + // Use this to recover ExceptionDispatchInfo when outside the "with" part of a try/with block. + // This indicates all the places where we lose a stack trace. + // + // Stack trace losses come when interoperating with other code that only provide us with an exception value, + // notably .NET 4.x tasks and user exceptions passed to the exception continuation in Async.FromContinuations. + let MayLoseStackTrace exn = ExceptionDispatchInfo.RestoreOrCapture(exn) /// Build a context suitable for running part1 of a computation and passing the result to part2 let bindPart2 ctxt part2 = @@ -573,7 +573,7 @@ namespace Microsoft.FSharp.Control MakeAsync (fun ctxt -> match res with | AsyncResult.Ok r -> ctxt.cont r - | AsyncResult.Error edi -> ctxt.SaveExceptionContinuation(); edi.ThrowAny() + | AsyncResult.Error edi -> ctxt.CallExceptionContinuation edi //ctxt.SaveExceptionContinuation(); edi.ThrowAny() | AsyncResult.Canceled oce -> ctxt.aux.ccont oce) // Generate async computation which calls its continuation with the given result From e2b3d09289ba5bbcab93371ff214b7ea31eb3511 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Thu, 10 May 2018 14:23:58 +0100 Subject: [PATCH 20/39] apply renamings --- src/fsharp/FSharp.Core/control.fs | 268 ++++++++++++++---------------- 1 file changed, 127 insertions(+), 141 deletions(-) diff --git a/src/fsharp/FSharp.Core/control.fs b/src/fsharp/FSharp.Core/control.fs index ed0b8e49125..165d771b18d 100644 --- a/src/fsharp/FSharp.Core/control.fs +++ b/src/fsharp/FSharp.Core/control.fs @@ -73,6 +73,7 @@ namespace Microsoft.FSharp.Control type LinkedSubSource(cancellationToken : CancellationToken) = let failureCTS = new CancellationTokenSource() + let linkedCTS = CancellationTokenSource.CreateLinkedTokenSource(cancellationToken, failureCTS.Token) member this.Token = linkedCTS.Token @@ -84,9 +85,7 @@ namespace Microsoft.FSharp.Control interface IDisposable with member this.Dispose() = this.Dispose() - /// Global mutable state used to associate Exception - [] module ExceptionDispatchInfoHelpers = @@ -119,7 +118,6 @@ namespace Microsoft.FSharp.Control type AsyncReturn = | FakeUnit - type cont<'T> = ('T -> AsyncReturn) type econt = (ExceptionDispatchInfo -> AsyncReturn) type ccont = (OperationCanceledException -> AsyncReturn) @@ -212,22 +210,20 @@ namespace Microsoft.FSharp.Control static let unfake FakeUnit = () - // Preallocate a context-switching callback delegate. - // This should be the only call to SynchronizationContext.Post in this library. We must always install a trampoline. + // Preallocate this delegate and keep it in the trampoline holder. let sendOrPostCallback = SendOrPostCallback (fun o -> let f = unbox<(unit -> AsyncReturn)> o this.Execute f |> unfake) - // Preallocate a context-switching callback delegate. - // This should be the only call to QueueUserWorkItem in this library. We must always install a trampoline. + // Preallocate this delegate and keep it in the trampoline holder. let waitCallbackForQueueWorkItemWithTrampoline = WaitCallback (fun o -> let f = unbox<(unit -> AsyncReturn)> o this.Execute f |> unfake) #if !FX_NO_PARAMETERIZED_THREAD_START - // This should be the only call to Thread.Start in this library. We must always install a trampoline. + // Preallocate this delegate and keep it in the trampoline holder. let threadStartCallbackForStartThreadWithTrampoline = ParameterizedThreadStart (fun o -> let f = unbox<(unit -> AsyncReturn)> o @@ -242,6 +238,11 @@ namespace Microsoft.FSharp.Control if not (ThreadPool.QueueUserWorkItem(waitCallbackForQueueWorkItemWithTrampoline, f |> box)) then failwith "failed to queue user work item" FakeUnit + + member this.PostOrQueue (syncCtxt : SynchronizationContext) f = + match syncCtxt with + | null -> this.QueueWorkItem f + | _ -> this.Post syncCtxt f #if FX_NO_PARAMETERIZED_THREAD_START // This should be the only call to Thread.Start in this library. We must always install a trampoline. @@ -333,6 +334,14 @@ namespace Microsoft.FSharp.Control let mutable i = 0 member this.Enter() = Interlocked.CompareExchange(&i, 1, 0) = 0 + [] + [] + type Once() = + let latch = Latch() + member this.Do f = + if latch.Enter() then + f() + [] type AsyncResult<'T> = | Ok of 'T @@ -347,13 +356,6 @@ namespace Microsoft.FSharp.Control | AsyncResult.Canceled exn -> raise exn module AsyncPrimitives = - // To consider: augment with more exception traceability information - // To consider: add the ability to suspend running ps in debug mode - // To consider: add the ability to trace running ps in debug mode - open System - open System.Threading - open System.IO - open Microsoft.FSharp.Core let fake () = FakeUnit let unfake FakeUnit = () @@ -438,34 +440,31 @@ namespace Microsoft.FSharp.Control if not ok then ctxt.SaveExceptionContinuation() - /// Make an initial ctxt and execute the async computation. + /// Make an initial asyc activation. [] - let startA cancellationToken trampolineHolder cont econt ccont computation = - let ctxt = { cont = cont; aux = { token = cancellationToken; econt = econt; ccont = ccont; trampolineHolder = trampolineHolder } } - computation.Invoke ctxt + let CreateAsyncActivation cancellationToken trampolineHolder cont econt ccont = + { cont = cont; aux = { token = cancellationToken; econt = econt; ccont = ccont; trampolineHolder = trampolineHolder } } #if FX_NO_PARAMETERIZED_THREAD_START - // Preallocate the delegate - // This should be the only call to QueueUserWorkItem in this library. We must always install a trampoline. - let waitCallbackForQueueWorkItemWithTrampoline(trampolineHolder : TrampolineHolder) = + // Preallocate the delegate and keep it in the trampoline + let waitCallbackForQueueWorkItemWithTrampoline(trampolineHolder: TrampolineHolder) = WaitCallback(fun o -> let f = unbox o : unit -> AsyncReturn trampolineHolder.Execute f |> unfake) #else - // Statically preallocate the delegate + // Preallocate the delegate and keep it in the trampoline let threadStartCallbackForStartThreadWithTrampoline = ParameterizedThreadStart (fun o -> let (trampolineHolder,f) = unbox o : TrampolineHolder * (unit -> AsyncReturn) trampolineHolder.Execute f |> unfake) #endif - let startAsync cancellationToken cont econt ccont p = - let trampolineHolder = new TrampolineHolder() - trampolineHolder.Execute (fun () -> startA cancellationToken trampolineHolder cont econt ccont p) - - let queueAsync cancellationToken cont econt ccont p = + [] + let QueueAsync cancellationToken cont econt ccont computation = let trampolineHolder = new TrampolineHolder() - trampolineHolder.QueueWorkItem (fun () -> startA cancellationToken trampolineHolder cont econt ccont p) + trampolineHolder.QueueWorkItem (fun () -> + let ctxt = CreateAsyncActivation cancellationToken trampolineHolder cont econt ccont + computation.Invoke ctxt) /// Build a primitive without any exception or resync protection let MakeAsync body = { Invoke = body } @@ -477,11 +476,6 @@ namespace Microsoft.FSharp.Control // notably .NET 4.x tasks and user exceptions passed to the exception continuation in Async.FromContinuations. let MayLoseStackTrace exn = ExceptionDispatchInfo.RestoreOrCapture(exn) - /// Build a context suitable for running part1 of a computation and passing the result to part2 - let bindPart2 ctxt part2 = - let cont a = ProtectUserCodeThenBind ctxt part2 a - { cont=cont; aux = ctxt.aux } - [] // Note: direct calls to this function end up in user assemblies via inlining let rec Bind keepStack (ctxt: AsyncActivation<_>) part1 part2 = @@ -526,7 +520,8 @@ namespace Microsoft.FSharp.Control ProtectUserCodeThenBind ctxt part2 savedResult1 else - let ctxtPart1ThenPart2 = bindPart2 ctxt part2 + let cont a = ProtectUserCodeThenBind ctxt part2 a + let ctxtPart1ThenPart2 = { cont=cont; aux = ctxt.aux } part1.Invoke ctxtPart1ThenPart2 [] @@ -566,10 +561,10 @@ namespace Microsoft.FSharp.Control /// When run, ensures that any exceptions raised by the immediate execution of "f" are /// sent to the exception continuation. - let protectUserCodeAsAsync f = + let CreateUserCodeAsync f = MakeAsync (fun ctxt -> ProtectUserCode ctxt f) - let asyncResultToAsync res = + let CreateAsyncResultAsync res = MakeAsync (fun ctxt -> match res with | AsyncResult.Ok r -> ctxt.cont r @@ -577,42 +572,42 @@ namespace Microsoft.FSharp.Control | AsyncResult.Canceled oce -> ctxt.aux.ccont oce) // Generate async computation which calls its continuation with the given result - let inline resultA res = + let inline CreateResultAsync res = // Note: this code ends up in user assemblies via inlining MakeAsync (fun ctxt -> ctxt.OnSuccess res) // The primitive bind operation. Generate a process that runs the first process, takes // its result, applies f and then runs the new process produced. Hijack if necessary and // run 'f' with exception protection - let inline bindA keepStack part1 part2 = + let inline CreateBindAsync keepStack part1 part2 = // Note: this code ends up in user assemblies via inlining MakeAsync (fun ctxt -> Bind keepStack ctxt part1 part2) // Call the given function with exception protection, but first // check for cancellation. - let inline callA part2 result1 = + let inline CreateCallAsync part2 result1 = // Note: this code ends up in user assemblies via inlining MakeAsync (fun ctxt -> Call ctxt result1 part2) - let inline delayA computation = + let inline CreateDelayAsync computation = // Note: this code ends up in user assemblies via inlining MakeAsync (fun ctxt -> CallDelay ctxt computation) /// Implements the sequencing construct of async computation expressions - let inline sequentialA part1 part2 = + let inline CreateSequentialAsync part1 part2 = // Note: this code ends up in user assemblies via inlining - bindA false part1 (fun () -> part2) + CreateBindAsync false part1 (fun () -> part2) // Call p but augment the normal, exception and cancel continuations with a call to finallyFunction. // If the finallyFunction raises an exception then call the original exception continuation // with the new exception. If exception is raised after a cancellation, exception is ignored // and cancel continuation is called. - let inline tryFinallyA finallyFunction computation = + let inline CreateTryFinallyAsync finallyFunction computation = MakeAsync (fun ctxt -> TryFinally ctxt finallyFunction computation) // Re-route the exception continuation to call to catchFunction. If catchFunction or the new process fail // then call the original exception continuation with the failure. - let tryWithDispatchInfoA catchFunction computation = + let CreateTryWithDispatchInfoAsync catchFunction computation = MakeAsync (fun ctxt -> if ctxt.IsCancellationRequested then ctxt.OnCancellation () @@ -621,11 +616,11 @@ namespace Microsoft.FSharp.Control let newCtxt = { ctxt with aux = { ctxt.aux with econt = econt } } computation.Invoke newCtxt) - let tryWithExnA catchFunction computation = - computation |> tryWithDispatchInfoA (fun edi -> catchFunction (edi.GetAssociatedSourceException())) + let CreateTryWithAsync catchFunction computation = + computation |> CreateTryWithDispatchInfoAsync (fun edi -> catchFunction (edi.GetAssociatedSourceException())) /// Call the finallyFunction if the computation results in a cancellation - let whenCancelledA (finallyFunction : OperationCanceledException -> unit) computation = + let CreateWhenCancelledAsync (finallyFunction : OperationCanceledException -> unit) computation = MakeAsync (fun ctxt -> let aux = ctxt.aux let ccont exn = @@ -640,54 +635,49 @@ namespace Microsoft.FSharp.Control /// A single pre-allocated computation that returns a unit result let unitAsync = - resultA() + CreateResultAsync() /// Implement use/Dispose - let usingA (resource:'T :> IDisposable) (computation:'T -> Async<'a>) : Async<'a> = + let CreateUsingAsync (resource:'T :> IDisposable) (computation:'T -> Async<'a>) : Async<'a> = let mutable x = 0 let disposeFunction _ = if Interlocked.CompareExchange(&x, 1, 0) = 0 then Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicFunctions.Dispose resource - tryFinallyA disposeFunction (callA computation resource) |> whenCancelledA disposeFunction + CreateTryFinallyAsync disposeFunction (CreateCallAsync computation resource) |> CreateWhenCancelledAsync disposeFunction - let inline ignoreA computation = - bindA false computation (fun _ -> unitAsync) + let inline CreateIgnoreAsync computation = + CreateBindAsync false computation (fun _ -> unitAsync) - /// Implement the while loop construct of async commputation expressions - let rec whileA guardFunc computation = + /// Implement the while loop construct of async computation expressions + let CreateWhileAsync guardFunc computation = + let mutable whileAsync = Unchecked.defaultof<_> if guardFunc() then - bindA false computation (fun () -> whileA guardFunc computation) + whileAsync <- CreateBindAsync false computation (fun () -> if guardFunc() then whileAsync else unitAsync) + whileAsync else unitAsync /// Implement the for loop construct of async commputation expressions - let rec forA (source: seq<_>) computation = - usingA (source.GetEnumerator()) (fun ie -> - whileA + let CreateForLoopAsync (source: seq<_>) computation = + CreateUsingAsync (source.GetEnumerator()) (fun ie -> + CreateWhileAsync (fun () -> ie.MoveNext()) - (delayA (fun () -> computation ie.Current))) + (CreateDelayAsync (fun () -> computation ie.Current))) - let switchTo (syncCtxt: SynchronizationContext) = - protectUserCodeAsAsync (fun ctxt -> + let CreateSwitchToAsync (syncCtxt: SynchronizationContext) = + CreateUserCodeAsync (fun ctxt -> ctxt.aux.trampolineHolder.Post syncCtxt (fun () -> ctxt.cont ())) - let switchToNewThread() = - protectUserCodeAsAsync (fun ctxt -> + let CreateSwitchToNewThreadAsync() = + CreateUserCodeAsync (fun ctxt -> ctxt.aux.trampolineHolder.StartThread (fun () -> ctxt.cont ())) - let switchToThreadPool() = - protectUserCodeAsAsync (fun ctxt -> + let CreateSwitchToThreadPoolAsync() = + CreateUserCodeAsync (fun ctxt -> ctxt.aux.trampolineHolder.QueueWorkItem (fun () -> ctxt.cont ())) - let getSyncContext () = SynchronizationContext.Current - - let postOrQueue (syncCtxt : SynchronizationContext) (trampolineHolder:TrampolineHolder) f = - match syncCtxt with - | null -> trampolineHolder.QueueWorkItem f - | _ -> trampolineHolder.Post syncCtxt f - let delimitSyncContext ctxt = - match getSyncContext () with + match SynchronizationContext.Current with | null -> ctxt | syncCtxt -> let aux = ctxt.aux @@ -700,24 +690,16 @@ namespace Microsoft.FSharp.Control } // When run, ensures that each of the continuations of the process are run in the same synchronization context. - let protectUserCodeAsAsyncWithResync f = - protectUserCodeAsAsync (fun ctxt -> + let CreateDelimitedUserCodeAsync f = + CreateUserCodeAsync (fun ctxt -> let ctxtWithSync = delimitSyncContext ctxt f ctxtWithSync) - [] - [] - type Once() = - let latch = Latch() - member this.Do f = - if latch.Enter() then - f() - [] [] type SuspendedAsync<'T>(ctxt : AsyncActivation<'T>) = - let syncCtxt = getSyncContext () + let syncCtxt = SynchronizationContext.Current let thread = match syncCtxt with @@ -738,10 +720,10 @@ namespace Microsoft.FSharp.Control | _ when Object.Equals(syncCtxt, currentSyncCtxt) && thread.Equals(Thread.CurrentThread) -> executeImmediately () | _ -> - postOrQueue syncCtxt trampolineHolder action + trampolineHolder.PostOrQueue syncCtxt action member __.ContinueWithPostOrQueue res = - postOrQueue syncCtxt trampolineHolder (fun () -> ctxt.cont res) + trampolineHolder.PostOrQueue syncCtxt (fun () -> ctxt.cont res) /// A utility type to provide a synchronization point between an asynchronous computation /// and callers waiting on the result of that computation. @@ -904,7 +886,7 @@ namespace Microsoft.FSharp.Control /// Run the asynchronous workflow and wait for its result. [] - let private RunSynchronouslyInAnotherThread (token:CancellationToken,computation,timeout) = + let RunSynchronouslyInAnotherThread (token:CancellationToken,computation,timeout) = let token,innerCTS = // If timeout is provided, we govern the async by our own CTS, to cancel // when execution times out. Otherwise, the user-supplied token governs the async. @@ -915,7 +897,7 @@ namespace Microsoft.FSharp.Control subSource.Token, Some subSource use resultCell = new ResultCell>() - queueAsync + QueueAsync token (fun res -> resultCell.RegisterResult(AsyncResult.Ok(res),reuseThread=true)) (fun edi -> resultCell.RegisterResult(AsyncResult.Error(edi),reuseThread=true)) @@ -940,19 +922,20 @@ namespace Microsoft.FSharp.Control res.Commit() [] - let private RunSynchronouslyInCurrentThread (token:CancellationToken,computation) = + let RunSynchronouslyInCurrentThread (token:CancellationToken,computation) = use resultCell = new ResultCell>() let trampolineHolder = TrampolineHolder() trampolineHolder.Execute (fun () -> - startA + let ctxt = + CreateAsyncActivation token trampolineHolder (fun res -> resultCell.RegisterResult(AsyncResult.Ok(res),reuseThread=true)) (fun edi -> resultCell.RegisterResult(AsyncResult.Error(edi),reuseThread=true)) (fun exn -> resultCell.RegisterResult(AsyncResult.Canceled(exn),reuseThread=true)) - computation) + computation.Invoke ctxt) |> unfake let res = resultCell.TryWaitForResultSynchronously().Value @@ -977,8 +960,8 @@ namespace Microsoft.FSharp.Control | _ -> RunSynchronouslyInAnotherThread (token, computation, timeout) [] - let Start token computation = - queueAsync + let Start token (computation:Async) = + QueueAsync token (fun () -> FakeUnit) // nothing to do on success (fun edi -> edi.ThrowAny()) // raise exception in child @@ -987,11 +970,15 @@ namespace Microsoft.FSharp.Control |> unfake [] - let StartWithContinuations(token:CancellationToken, a:Async<'T>, cont, econt, ccont) : unit = - startAsync token (cont >> fake) (econt >> fake) (ccont >> fake) a |> ignore - + let StartWithContinuations cancellationToken (computation:Async<'T>) cont econt ccont = + let trampolineHolder = new TrampolineHolder() + trampolineHolder.Execute (fun () -> + let ctxt = CreateAsyncActivation cancellationToken trampolineHolder (cont >> fake) (econt >> fake) (ccont >> fake) + computation.Invoke ctxt) + |> unfake + [] - let StartAsTask token computation taskCreationOptions = + let StartAsTask cancellationToken (computation:Async<'T>) taskCreationOptions = let taskCreationOptions = defaultArg taskCreationOptions TaskCreationOptions.None let tcs = new TaskCompletionSource<_>(taskCreationOptions) @@ -999,8 +986,8 @@ namespace Microsoft.FSharp.Control // a) cancellation signal should always propagate to the computation // b) when the task IsCompleted -> nothing is running anymore let task = tcs.Task - queueAsync - token + QueueAsync + cancellationToken (fun r -> tcs.SetResult r |> fake) (fun edi -> tcs.SetException edi.SourceException |> fake) (fun _ -> tcs.SetCanceled() |> fake) @@ -1009,7 +996,7 @@ namespace Microsoft.FSharp.Control task // Helper to attach continuation to the given task. - // Should be invoked as a part of protectUserCodeAsAsync(withResync) call + // Should be invoked as a part of CreateUserCodeAsync(withResync) call let taskContinueWith (task : Task<'T>) ctxt useCcontForTaskCancellation = let continuation (completedTask: Task<_>) : unit = @@ -1106,7 +1093,7 @@ namespace Microsoft.FSharp.Control let cont v = aiar.SetResult (AsyncResult.Ok v) let econt v = aiar.SetResult (AsyncResult.Error v) let ccont v = aiar.SetResult (AsyncResult.Canceled v) - StartWithContinuations(aiar.Token, computation, cont, econt, ccont) + StartWithContinuations aiar.Token computation cont econt ccont aiar.CheckForNotSynchronous() (aiar :> IAsyncResult) @@ -1136,31 +1123,30 @@ namespace Microsoft.FSharp.Control type AsyncBuilder() = member __.Zero () = unitAsync - member __.Delay generator = delayA generator + member __.Delay generator = CreateDelayAsync generator - member inline __.Return value = resultA value + member inline __.Return value = CreateResultAsync value member inline __.ReturnFrom (computation:Async<_>) = computation - member inline __.Bind (computation, binder) = bindA true computation binder + member inline __.Bind (computation, binder) = CreateBindAsync true computation binder - member __.Using (resource, binder) = usingA resource binder + member __.Using (resource, binder) = CreateUsingAsync resource binder - member __.While (guard, computation) = whileA guard computation + member __.While (guard, computation) = CreateWhileAsync guard computation - member __.For (sequence, body) = forA sequence body + member __.For (sequence, body) = CreateForLoopAsync sequence body - member inline __.Combine (computation1, computation2) = sequentialA computation1 computation2 + member inline __.Combine (computation1, computation2) = CreateSequentialAsync computation1 computation2 - member inline __.TryFinally (computation, compensation) = tryFinallyA compensation computation + member inline __.TryFinally (computation, compensation) = CreateTryFinallyAsync compensation computation - member __.TryWith (computation, catchHandler) = tryWithExnA catchHandler computation + member __.TryWith (computation, catchHandler) = CreateTryWithAsync catchHandler computation - module AsyncImpl = + [] + module AsyncBuilderImpl = let async = AsyncBuilder() - open AsyncImpl - [] [] type Async = @@ -1184,8 +1170,8 @@ namespace Microsoft.FSharp.Control if Thread.CurrentThread.Equals(thread) && underCurrentThreadStack then contToTailCall <- Some(fun () -> cont x) else if Trampoline.ThisThreadHasTrampoline then - let syncCtxt = getSyncContext() - postOrQueue syncCtxt aux.trampolineHolder (fun () -> cont x) |> unfake + let syncCtxt = SynchronizationContext.Current + aux.trampolineHolder.PostOrQueue syncCtxt (fun () -> cont x) |> unfake else aux.trampolineHolder.Execute (fun () -> cont x ) |> unfake try @@ -1299,7 +1285,7 @@ namespace Microsoft.FSharp.Control finishTask(Interlocked.Decrement count) tasks |> Array.iteri (fun i p -> - queueAsync + QueueAsync innerCTS.Token // on success, record the result (fun res -> recordSuccess i res) @@ -1356,7 +1342,7 @@ namespace Microsoft.FSharp.Control FakeUnit for c in computations do - queueAsync innerCts.Token scont econt ccont c |> unfake + QueueAsync innerCts.Token scont econt ccont c |> unfake FakeUnit)) @@ -1364,14 +1350,14 @@ namespace Microsoft.FSharp.Control /// StartWithContinuations, except the exception continuation is given an ExceptionDispatchInfo static member StartWithContinuationsUsingDispatchInfo(computation:Async<'T>, continuation, exceptionContinuation, cancellationContinuation, ?cancellationToken) : unit = - let token = defaultArg cancellationToken defaultCancellationTokenSource.Token - AsyncPrimitives.StartWithContinuations(token, computation, continuation, exceptionContinuation, cancellationContinuation) + let cancellationToken = defaultArg cancellationToken defaultCancellationTokenSource.Token + AsyncPrimitives.StartWithContinuations cancellationToken computation continuation exceptionContinuation cancellationContinuation static member StartWithContinuations(computation:Async<'T>, continuation, exceptionContinuation, cancellationContinuation, ?cancellationToken) : unit = Async.StartWithContinuationsUsingDispatchInfo(computation, continuation, (fun edi -> exceptionContinuation (edi.GetAssociatedSourceException())), cancellationContinuation, ?cancellationToken=cancellationToken) static member StartImmediateAsTask (computation : Async<'T>, ?cancellationToken ) : Task<'T>= - let token = defaultArg cancellationToken defaultCancellationTokenSource.Token + let cancellationToken = defaultArg cancellationToken defaultCancellationTokenSource.Token let ts = new TaskCompletionSource<'T>() let task = ts.Task Async.StartWithContinuations( @@ -1379,15 +1365,15 @@ namespace Microsoft.FSharp.Control (fun (k) -> ts.SetResult(k)), (fun exn -> ts.SetException(exn)), (fun _ -> ts.SetCanceled()), - token) + cancellationToken) task static member StartImmediate(computation:Async, ?cancellationToken) : unit = - let token = defaultArg cancellationToken defaultCancellationTokenSource.Token - AsyncPrimitives.StartWithContinuations(token, computation, id, (fun edi -> edi.ThrowAny()), ignore) + let cancellationToken = defaultArg cancellationToken defaultCancellationTokenSource.Token + AsyncPrimitives.StartWithContinuations cancellationToken computation id (fun edi -> edi.ThrowAny()) ignore static member Sleep(millisecondsDueTime) : Async = - protectUserCodeAsAsyncWithResync (fun ctxt -> + CreateDelimitedUserCodeAsync (fun ctxt -> let aux = ctxt.aux let timer = ref (None : Timer option) let savedCont = ctxt.cont @@ -1449,7 +1435,7 @@ namespace Microsoft.FSharp.Control #endif async.Return ok) else - protectUserCodeAsAsyncWithResync(fun ctxt -> + CreateDelimitedUserCodeAsync(fun ctxt -> let aux = ctxt.aux let rwh = ref (None : RegisteredWaitHandle option) let latch = Latch() @@ -1664,11 +1650,11 @@ namespace Microsoft.FSharp.Control // Note: ok to use "NoDirectTimeout" here because no timeout parameter to this method return! Async.AwaitAndBindResult_NoDirectCancelOrTimeout(resultCell) } - static member Ignore (computation: Async<'T>) = ignoreA computation + static member Ignore (computation: Async<'T>) = CreateIgnoreAsync computation - static member SwitchToNewThread() = switchToNewThread() + static member SwitchToNewThread() = CreateSwitchToNewThreadAsync() - static member SwitchToThreadPool() = switchToThreadPool() + static member SwitchToThreadPool() = CreateSwitchToThreadPoolAsync() static member StartChild (computation:Async<'T>,?millisecondsTimeout) = async { @@ -1682,7 +1668,7 @@ namespace Microsoft.FSharp.Control | null -> () | otherwise -> otherwise.Cancel()), null) - do queueAsync + do QueueAsync innerCTS.Token // since innerCTS is not ever Disposed, can call reg.Dispose() without a safety Latch (fun res -> ctsRef := null; reg.Dispose(); resultCell.RegisterResult (Ok res, reuseThread=true)) @@ -1700,7 +1686,7 @@ namespace Microsoft.FSharp.Control do! Async.SwitchToThreadPool() | syncCtxt -> // post the continuation to the synchronization context - return! switchTo syncCtxt } + return! CreateSwitchToAsync syncCtxt } static member OnCancel interruption = async { let! cancellationToken = cancellationTokenAsync @@ -1720,13 +1706,13 @@ namespace Microsoft.FSharp.Control if latch.Enter() then registration.Dispose() } } static member TryCancelled (computation: Async<'T>,compensation) = - whenCancelledA compensation computation + CreateWhenCancelledAsync compensation computation static member AwaitTask (task:Task<'T>) : Async<'T> = - protectUserCodeAsAsyncWithResync (fun ctxt -> taskContinueWith task ctxt false) + CreateDelimitedUserCodeAsync (fun ctxt -> taskContinueWith task ctxt false) static member AwaitTask (task:Task) : Async = - protectUserCodeAsAsyncWithResync (fun ctxt -> taskContinueWithUnit task ctxt false) + CreateDelimitedUserCodeAsync (fun ctxt -> taskContinueWithUnit task ctxt false) module CommonExtensions = @@ -1737,8 +1723,8 @@ namespace Microsoft.FSharp.Control let offset = defaultArg offset 0 let count = defaultArg count buffer.Length #if FX_NO_BEGINEND_READWRITE - // use combo protectUserCodeAsAsyncWithResync + taskContinueWith instead of AwaitTask so we can pass cancellation token to the ReadAsync task - protectUserCodeAsAsyncWithResync (fun ctxt -> taskContinueWith (stream.ReadAsync(buffer, offset, count, ctxt.aux.token)) ctxt false) + // use combo CreateDelimitedUserCodeAsync + taskContinueWith instead of AwaitTask so we can pass cancellation token to the ReadAsync task + CreateDelimitedUserCodeAsync (fun ctxt -> taskContinueWith (stream.ReadAsync(buffer, offset, count, ctxt.aux.token)) ctxt false) #else Async.FromBeginEnd (buffer,offset,count,stream.BeginRead,stream.EndRead) #endif @@ -1759,8 +1745,8 @@ namespace Microsoft.FSharp.Control let offset = defaultArg offset 0 let count = defaultArg count buffer.Length #if FX_NO_BEGINEND_READWRITE - // use combo protectUserCodeAsAsyncWithResync + taskContinueWithUnit instead of AwaitTask so we can pass cancellation token to the WriteAsync task - protectUserCodeAsAsyncWithResync (fun ctxt -> taskContinueWithUnit (stream.WriteAsync(buffer, offset, count, ctxt.aux.token)) ctxt false) + // use combo CreateDelimitedUserCodeAsync + taskContinueWithUnit instead of AwaitTask so we can pass cancellation token to the WriteAsync task + CreateDelimitedUserCodeAsync (fun ctxt -> taskContinueWithUnit (stream.WriteAsync(buffer, offset, count, ctxt.aux.token)) ctxt false) #else Async.FromBeginEnd (buffer,offset,count,stream.BeginWrite,stream.EndWrite) #endif @@ -1786,11 +1772,11 @@ namespace Microsoft.FSharp.Control let canceled = ref false // WebException with Status = WebExceptionStatus.RequestCanceled can be raised in other situations except cancellation, use flag to filter out false positives - // Use tryWithDispatchInfoA to allow propagation of ExceptionDispatchInfo + // Use CreateTryWithDispatchInfoAsync to allow propagation of ExceptionDispatchInfo Async.FromBeginEnd(beginAction=req.BeginGetResponse, endAction = req.EndGetResponse, cancelAction = fun() -> canceled := true; req.Abort()) - |> tryWithDispatchInfoA (fun edi -> + |> CreateTryWithDispatchInfoAsync (fun edi -> match edi.SourceException with | :? System.Net.WebException as webExn when webExn.Status = System.Net.WebExceptionStatus.RequestCanceled && !canceled -> @@ -1876,7 +1862,7 @@ namespace Microsoft.FSharp.Control // cancellation token and will register a cancelled result if cancellation occurs. // Note: It is ok to use "NoDirectTimeout" here because there is no specific timeout log to this routine. let! result = resultCell.AwaitResult_NoDirectCancelOrTimeout - return! asyncResultToAsync result + return! CreateAsyncResultAsync result } let timeout msec cancellationToken = From cb5106b84fb9d22683c410352e564fdc9008578a Mon Sep 17 00:00:00 2001 From: Don Syme Date: Thu, 10 May 2018 14:41:45 +0100 Subject: [PATCH 21/39] Further cleanup in control.fs --- src/fsharp/FSharp.Core/control.fs | 290 ++++++++++++++---------------- 1 file changed, 132 insertions(+), 158 deletions(-) diff --git a/src/fsharp/FSharp.Core/control.fs b/src/fsharp/FSharp.Core/control.fs index b5be4a0005d..270219ebb8b 100644 --- a/src/fsharp/FSharp.Core/control.fs +++ b/src/fsharp/FSharp.Core/control.fs @@ -73,6 +73,7 @@ namespace Microsoft.FSharp.Control type LinkedSubSource(cancellationToken : CancellationToken) = let failureCTS = new CancellationTokenSource() + let linkedCTS = CancellationTokenSource.CreateLinkedTokenSource(cancellationToken, failureCTS.Token) member this.Token = linkedCTS.Token @@ -84,9 +85,7 @@ namespace Microsoft.FSharp.Control interface IDisposable with member this.Dispose() = this.Dispose() - /// Global mutable state used to associate Exception - [] module ExceptionDispatchInfoHelpers = @@ -119,7 +118,6 @@ namespace Microsoft.FSharp.Control type AsyncReturn = | FakeUnit - type cont<'T> = ('T -> AsyncReturn) type econt = (ExceptionDispatchInfo -> AsyncReturn) type ccont = (OperationCanceledException -> AsyncReturn) @@ -127,6 +125,8 @@ namespace Microsoft.FSharp.Control [] type Trampoline() = + let unfake FakeUnit = () + [] static let bindLimitBeforeHijack = 300 @@ -140,8 +140,6 @@ namespace Microsoft.FSharp.Control let mutable storedCont = None let mutable bindCount = 0 - static let unfake FakeUnit = () - /// Use this trampoline on the synchronous stack if none exists, and execute /// the given function. The function might write its continuation into the trampoline. member __.Execute (firstAction : unit -> AsyncReturn) = @@ -186,22 +184,20 @@ namespace Microsoft.FSharp.Control static let unfake FakeUnit = () - // Preallocate a context-switching callback delegate. - // This should be the only call to SynchronizationContext.Post in this library. We must always install a trampoline. + // Preallocate this delegate and keep it in the trampoline holder. let sendOrPostCallback = SendOrPostCallback (fun o -> let f = unbox<(unit -> AsyncReturn)> o this.Execute f |> unfake) - // Preallocate a ctxt-switching callback delegate. - // This should be the only call to QueueUserWorkItem in this library. We must always install a trampoline. + // Preallocate this delegate and keep it in the trampoline holder. let waitCallbackForQueueWorkItemWithTrampoline = WaitCallback (fun o -> let f = unbox<(unit -> AsyncReturn)> o this.Execute f |> unfake) #if !FX_NO_PARAMETERIZED_THREAD_START - // This should be the only call to Thread.Start in this library. We must always install a trampoline. + // Preallocate this delegate and keep it in the trampoline holder. let threadStartCallbackForStartThreadWithTrampoline = ParameterizedThreadStart (fun o -> let f = unbox<(unit -> AsyncReturn)> o @@ -216,6 +212,11 @@ namespace Microsoft.FSharp.Control if not (ThreadPool.QueueUserWorkItem(waitCallbackForQueueWorkItemWithTrampoline, f |> box)) then failwith "failed to queue user work item" FakeUnit + + member this.PostOrQueue (syncCtxt : SynchronizationContext) f = + match syncCtxt with + | null -> this.QueueWorkItem f + | _ -> this.Post syncCtxt f #if FX_NO_PARAMETERIZED_THREAD_START // This should be the only call to Thread.Start in this library. We must always install a trampoline. @@ -298,6 +299,14 @@ namespace Microsoft.FSharp.Control let mutable i = 0 member this.Enter() = Interlocked.CompareExchange(&i, 1, 0) = 0 + [] + [] + type Once() = + let latch = Latch() + member this.Do f = + if latch.Enter() then + f() + [] type AsyncResult<'T> = | Ok of 'T @@ -311,13 +320,6 @@ namespace Microsoft.FSharp.Control | AsyncResult.Canceled exn -> raise exn module AsyncPrimitives = - // To consider: augment with more exception traceability information - // To consider: add the ability to suspend running ps in debug mode - // To consider: add the ability to trace running ps in debug mode - open System - open System.Threading - open System.IO - open Microsoft.FSharp.Core let fake () = FakeUnit let unfake FakeUnit = () @@ -381,34 +383,16 @@ namespace Microsoft.FSharp.Control let edi = ExceptionDispatchInfo.RestoreOrCapture(exn) ctxt.CallExceptionContinuation edi - /// Make an initial ctxt and execute the async computation. - let startA cancellationToken trampolineHolder cont econt ccont computation = - let ctxt = { cont = cont; aux = { token = cancellationToken; econt = econt; ccont = ccont; trampolineHolder = trampolineHolder } } - computation.Invoke ctxt + /// Make an initial asyc activation. + [] + let CreateAsyncActivation cancellationToken trampolineHolder cont econt ccont = + { cont = cont; aux = { token = cancellationToken; econt = econt; ccont = ccont; trampolineHolder = trampolineHolder } } -#if FX_NO_PARAMETERIZED_THREAD_START - // Preallocate the delegate - // This should be the only call to QueueUserWorkItem in this library. We must always install a trampoline. - let waitCallbackForQueueWorkItemWithTrampoline(trampolineHolder : TrampolineHolder) = - WaitCallback(fun o -> - let f = unbox o : unit -> AsyncReturn - trampolineHolder.Execute f |> unfake) -#else - - // Statically preallocate the delegate - let threadStartCallbackForStartThreadWithTrampoline = - ParameterizedThreadStart (fun o -> - let (trampolineHolder,f) = unbox o : TrampolineHolder * (unit -> AsyncReturn) - trampolineHolder.Execute f |> unfake) -#endif - - let startAsync cancellationToken cont econt ccont p = + let QueueAsync cancellationToken cont econt ccont computation = let trampolineHolder = new TrampolineHolder() - trampolineHolder.Execute (fun () -> startA cancellationToken trampolineHolder cont econt ccont p) - - let queueAsync cancellationToken cont econt ccont p = - let trampolineHolder = new TrampolineHolder() - trampolineHolder.QueueWorkItem (fun () -> startA cancellationToken trampolineHolder cont econt ccont p) + trampolineHolder.QueueWorkItem (fun () -> + let ctxt = CreateAsyncActivation cancellationToken trampolineHolder cont econt ccont + computation.Invoke ctxt) /// Build a primitive without any exception or resync protection let MakeAsync body = { Invoke = body } @@ -437,10 +421,10 @@ namespace Microsoft.FSharp.Control // When run, ensures that any exceptions raised by the immediate execution of "f" are // sent to the exception continuation. // - let protectUserCodeAsAsync f = + let CreateUserCodeAsync f = MakeAsync (fun ctxt -> ProtectUserCode ctxt f) - let asyncResultToAsync res = + let CreateAsyncResultAsync res = MakeAsync (fun ctxt -> match res with | AsyncResult.Ok r -> ctxt.cont r @@ -448,7 +432,7 @@ namespace Microsoft.FSharp.Control | AsyncResult.Canceled oce -> ctxt.aux.ccont oce) // Generate async computation which calls its continuation with the given result - let resultA x = + let CreateReturnAsync x = MakeAsync (fun ctxt -> if ctxt.IsCancellationRequested then ctxt.OnCancellation () @@ -458,7 +442,7 @@ namespace Microsoft.FSharp.Control // The primitive bind operation. Generate a process that runs the first process, takes // its result, applies f and then runs the new process produced. Hijack if necessary and // run 'f' with exception protection - let bindA p1 f = + let CreateBindAsync p1 f = MakeAsync (fun ctxt -> if ctxt.IsCancellationRequested then ctxt.OnCancellation () @@ -478,8 +462,9 @@ namespace Microsoft.FSharp.Control p1.Invoke ctxt) - // callA = "bindA (return x) f" - let callA f x = + // Call the given function with exception protection, but first + // check for cancellation. + let CreateCallAsync f x = MakeAsync (fun ctxt -> if ctxt.aux.token.IsCancellationRequested then ctxt.OnCancellation () @@ -487,14 +472,16 @@ namespace Microsoft.FSharp.Control protectUserCodeIncludingHijackCheck ctxt.aux.trampolineHolder f x ctxt.aux.econt (fun p2 -> p2.Invoke ctxt) ) - // delayPrim = "bindA (return ()) f" - let delayA f = callA f () + let CreateDelayAsync f = CreateCallAsync f () + + let CreateSequentialAsync p1 p2 = + CreateBindAsync p1 (fun () -> p2) // Call p but augment the normal, exception and cancel continuations with a call to finallyFunction. // If the finallyFunction raises an exception then call the original exception continuation // with the new exception. If exception is raised after a cancellation, exception is ignored // and cancel continuation is called. - let tryFinallyA finallyFunction p = + let CreateTryFinallyAsync finallyFunction computation = MakeAsync (fun ctxt -> if ctxt.aux.token.IsCancellationRequested then ctxt.OnCancellation () @@ -509,26 +496,26 @@ namespace Microsoft.FSharp.Control // The cancellation continuation runs the finallyFunction and then runs the previous cancellation continuation. // If an exception is thrown we continue with the previous cancellation continuation (the exception is lost) let ccont cexn = protectUserCodeIncludingHijackCheck trampolineHolder finallyFunction () (fun _ -> ctxt.aux.ccont cexn) (fun () -> ctxt.aux.ccont cexn) - p.Invoke { ctxt with cont = cont; aux = { ctxt.aux with econt = econt; ccont = ccont } }) + computation.Invoke { ctxt with cont = cont; aux = { ctxt.aux with econt = econt; ccont = ccont } }) // Re-route the exception continuation to call to catchFunction. If catchFunction or the new process fail // then call the original exception continuation with the failure. - let tryWithDispatchInfoA catchFunction computation = + let CreateTryWithDispatchInfoAsync catchFunction computation = MakeAsync (fun ctxt -> if ctxt.aux.token.IsCancellationRequested then ctxt.OnCancellation () else let econt (edi: ExceptionDispatchInfo) = - let ecomputation = callA catchFunction edi + let ecomputation = CreateCallAsync catchFunction edi ecomputation.Invoke ctxt let newCtxt = { ctxt with aux = { ctxt.aux with econt = econt } } computation.Invoke newCtxt) - let tryWithExnA catchFunction computation = - computation |> tryWithDispatchInfoA (fun edi -> catchFunction (edi.GetAssociatedSourceException())) + let CreateTryWithAsync catchFunction computation = + computation |> CreateTryWithDispatchInfoAsync (fun edi -> catchFunction (edi.GetAssociatedSourceException())) /// Call the finallyFunction if the computation results in a cancellation - let whenCancelledA (finallyFunction : OperationCanceledException -> unit) computation = + let CreateWhenCancelledAsync (finallyFunction : OperationCanceledException -> unit) computation = MakeAsync (fun ctxt -> let aux = ctxt.aux let ccont exn = protectUserCodeIncludingHijackCheck aux.trampolineHolder finallyFunction exn (fun _ -> aux.ccont exn) (fun _ -> aux.ccont exn) @@ -541,57 +528,47 @@ namespace Microsoft.FSharp.Control /// A single pre-allocated computation that returns a unit result let unitAsync = - resultA() + CreateReturnAsync() /// Implement use/Dispose - let usingA (resource:'T :> IDisposable) (computation:'T -> Async<'a>) : Async<'a> = + let CreateUsingAsync (resource:'T :> IDisposable) (computation:'T -> Async<'a>) : Async<'a> = let mutable x = 0 let disposeFunction _ = if Interlocked.CompareExchange(&x, 1, 0) = 0 then Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicFunctions.Dispose resource - tryFinallyA disposeFunction (callA computation resource) |> whenCancelledA disposeFunction + CreateTryFinallyAsync disposeFunction (CreateCallAsync computation resource) |> CreateWhenCancelledAsync disposeFunction - let ignoreA computation = - bindA computation (fun _ -> unitAsync) + let CreateIgnoreAsync computation = + CreateBindAsync computation (fun _ -> unitAsync) /// Implement the while loop construct of async commputation expressions - let rec whileA guardFunc computation = + let rec CreateWhileAsync guardFunc computation = if guardFunc() then - bindA computation (fun () -> whileA guardFunc computation) + CreateBindAsync computation (fun () -> CreateWhileAsync guardFunc computation) else unitAsync /// Implement the for loop construct of async commputation expressions - let rec forA (source: seq<_>) computation = - usingA (source.GetEnumerator()) (fun ie -> - whileA + let rec CreateForLoopAsync (source: seq<_>) computation = + CreateUsingAsync (source.GetEnumerator()) (fun ie -> + CreateWhileAsync (fun () -> ie.MoveNext()) - (delayA (fun () -> computation ie.Current))) - - let sequentialA p1 p2 = - bindA p1 (fun () -> p2) - - let switchTo (syncCtxt: SynchronizationContext) = - protectUserCodeAsAsync (fun ctxt -> - ctxt.aux.trampolineHolder.Post syncCtxt (fun () -> ctxt.cont ())) + (CreateDelayAsync (fun () -> computation ie.Current))) - let switchToNewThread() = - protectUserCodeAsAsync (fun ctxt -> - ctxt.aux.trampolineHolder.StartThread (fun () -> ctxt.cont ())) + let CreateSwitchToAsync (syncCtxt: SynchronizationContext) = + CreateUserCodeAsync (fun ctxt -> + ctxt.aux.trampolineHolder.Post syncCtxt ctxt.cont) - let switchToThreadPool() = - protectUserCodeAsAsync (fun ctxt -> - ctxt.aux.trampolineHolder.QueueWorkItem (fun () -> ctxt.cont ())) + let CreateSwitchToNewThreadAsync() = + CreateUserCodeAsync (fun ctxt -> + ctxt.aux.trampolineHolder.StartThread ctxt.cont) - let getSyncContext () = SynchronizationContext.Current - - let postOrQueue (syncCtxt : SynchronizationContext) (trampolineHolder:TrampolineHolder) f = - match syncCtxt with - | null -> trampolineHolder.QueueWorkItem f - | _ -> trampolineHolder.Post syncCtxt f + let CreateSwitchToThreadPoolAsync() = + CreateUserCodeAsync (fun ctxt -> + ctxt.aux.trampolineHolder.QueueWorkItem ctxt.cont) let delimitSyncContext ctxt = - match getSyncContext () with + match SynchronizationContext.Current with | null -> ctxt | syncCtxt -> let aux = ctxt.aux @@ -604,24 +581,16 @@ namespace Microsoft.FSharp.Control } // When run, ensures that each of the continuations of the process are run in the same synchronization context. - let protectUserCodeAsAsyncWithResync f = - protectUserCodeAsAsync (fun ctxt -> + let CreateDelimitedUserCodeAsync f = + CreateUserCodeAsync (fun ctxt -> let ctxtWithSync = delimitSyncContext ctxt f ctxtWithSync) - [] - [] - type Once() = - let latch = Latch() - member this.Do f = - if latch.Enter() then - f() - [] [] type SuspendedAsync<'T>(ctxt : AsyncActivation<'T>) = - let syncCtxt = getSyncContext () + let syncCtxt = SynchronizationContext.Current let thread = match syncCtxt with @@ -642,10 +611,10 @@ namespace Microsoft.FSharp.Control | _ when Object.Equals(syncCtxt, currentSyncCtxt) && thread.Equals(Thread.CurrentThread) -> executeImmediately () | _ -> - postOrQueue syncCtxt trampolineHolder action + trampolineHolder.PostOrQueue syncCtxt action member __.ContinueWithPostOrQueue res = - postOrQueue syncCtxt trampolineHolder (fun () -> ctxt.cont res) + trampolineHolder.PostOrQueue syncCtxt (fun () -> ctxt.cont res) /// A utility type to provide a synchronization point between an asynchronous computation /// and callers waiting on the result of that computation. @@ -807,7 +776,7 @@ namespace Microsoft.FSharp.Control System.Delegate.CreateDelegate(typeof<'Delegate>, obj, invokeMeth) :?> 'Delegate /// Run the asynchronous workflow and wait for its result. - let private RunSynchronouslyInAnotherThread (token:CancellationToken,computation,timeout) = + let RunSynchronouslyInAnotherThread (token:CancellationToken,computation,timeout) = let token,innerCTS = // If timeout is provided, we govern the async by our own CTS, to cancel // when execution times out. Otherwise, the user-supplied token governs the async. @@ -818,7 +787,7 @@ namespace Microsoft.FSharp.Control subSource.Token, Some subSource use resultCell = new ResultCell>() - queueAsync + QueueAsync token (fun res -> resultCell.RegisterResult(AsyncResult.Ok(res),reuseThread=true)) (fun edi -> resultCell.RegisterResult(AsyncResult.Error(edi),reuseThread=true)) @@ -842,30 +811,31 @@ namespace Microsoft.FSharp.Control | None -> () res.Commit() - let private RunSynchronouslyInCurrentThread (token:CancellationToken,computation) = + let RunSynchronouslyInCurrentThread (token:CancellationToken,computation) = use resultCell = new ResultCell>() let trampolineHolder = TrampolineHolder() trampolineHolder.Execute (fun () -> - startA + let ctxt = + CreateAsyncActivation token trampolineHolder (fun res -> resultCell.RegisterResult(AsyncResult.Ok(res),reuseThread=true)) (fun edi -> resultCell.RegisterResult(AsyncResult.Error(edi),reuseThread=true)) (fun exn -> resultCell.RegisterResult(AsyncResult.Canceled(exn),reuseThread=true)) - computation) + computation.Invoke ctxt) |> unfake let res = resultCell.TryWaitForResultSynchronously().Value res.Commit() - let RunSynchronously (token:CancellationToken,computation,timeout) = + let RunSynchronously cancellationToken (computation: Async<'T>) timeout = // Reuse the current ThreadPool thread if possible. Unfortunately // Thread.IsThreadPoolThread isn't available on all profiles so // we approximate it by testing synchronization context for null. match SynchronizationContext.Current, timeout with - | null, None -> RunSynchronouslyInCurrentThread (token, computation) + | null, None -> RunSynchronouslyInCurrentThread (cancellationToken, computation) // When the timeout is given we need a dedicated thread // which cancels the computation. // Performing the cancellation in the ThreadPool eg. by using @@ -875,10 +845,10 @@ namespace Microsoft.FSharp.Control // // And so when the timeout is given we always use the current thread // for the cancellation and run the computation in another thread. - | _ -> RunSynchronouslyInAnotherThread (token, computation, timeout) + | _ -> RunSynchronouslyInAnotherThread (cancellationToken, computation, timeout) let Start token computation = - queueAsync + QueueAsync token (fun () -> FakeUnit) // nothing to do on success (fun edi -> edi.ThrowAny()) // raise exception in child @@ -886,8 +856,12 @@ namespace Microsoft.FSharp.Control computation |> unfake - let StartWithContinuations(token:CancellationToken, a:Async<'T>, cont, econt, ccont) : unit = - startAsync token (cont >> fake) (econt >> fake) (ccont >> fake) a |> ignore + let StartWithContinuations cancellationToken (computation:Async<'T>) cont econt ccont = + let trampolineHolder = new TrampolineHolder() + trampolineHolder.Execute (fun () -> + let ctxt = CreateAsyncActivation cancellationToken trampolineHolder (cont >> fake) (econt >> fake) (ccont >> fake) + computation.Invoke ctxt) + |> unfake let StartAsTask token computation taskCreationOptions = let taskCreationOptions = defaultArg taskCreationOptions TaskCreationOptions.None @@ -897,7 +871,7 @@ namespace Microsoft.FSharp.Control // a) cancellation signal should always propagate to the computation // b) when the task IsCompleted -> nothing is running anymore let task = tcs.Task - queueAsync + QueueAsync token (fun r -> tcs.SetResult r |> fake) (fun edi -> tcs.SetException edi.SourceException |> fake) @@ -907,11 +881,11 @@ namespace Microsoft.FSharp.Control task // Helper to attach continuation to the given task. - // Should be invoked as a part of protectUserCodeAsAsync(withResync) call + // Should be invoked as a part of CreateUserCodeAsync(withResync) call let taskContinueWith (task : Task<'T>) ctxt useCcontForTaskCancellation = let continuation (completedTask: Task<_>) : unit = - ctxt.aux.trampolineHolder.Execute ((fun () -> + ctxt.aux.trampolineHolder.Execute (fun () -> if completedTask.IsCanceled then if useCcontForTaskCancellation then ctxt.OnCancellation () @@ -922,14 +896,14 @@ namespace Microsoft.FSharp.Control let edi = MayLoseStackTrace(completedTask.Exception) ctxt.CallExceptionContinuation edi else - ctxt.cont completedTask.Result)) |> unfake + ctxt.cont completedTask.Result) |> unfake task.ContinueWith(Action>(continuation)) |> ignore |> fake let taskContinueWithUnit (task: Task) ctxt useCcontForTaskCancellation = let continuation (completedTask: Task) : unit = - ctxt.aux.trampolineHolder.Execute ((fun () -> + ctxt.aux.trampolineHolder.Execute (fun () -> if completedTask.IsCanceled then if useCcontForTaskCancellation then ctxt.OnCancellation () @@ -940,7 +914,7 @@ namespace Microsoft.FSharp.Control let edi = MayLoseStackTrace(completedTask.Exception) ctxt.CallExceptionContinuation edi else - ctxt.cont ())) |> unfake + ctxt.cont ()) |> unfake task.ContinueWith(Action(continuation)) |> ignore |> fake @@ -1003,7 +977,7 @@ namespace Microsoft.FSharp.Control let cont v = aiar.SetResult (AsyncResult.Ok v) let econt v = aiar.SetResult (AsyncResult.Error v) let ccont v = aiar.SetResult (AsyncResult.Canceled v) - StartWithContinuations(aiar.Token, computation, cont, econt, ccont) + StartWithContinuations aiar.Token computation cont econt ccont aiar.CheckForNotSynchronous() (aiar :> IAsyncResult) @@ -1033,25 +1007,25 @@ namespace Microsoft.FSharp.Control type AsyncBuilder() = member __.Zero () = unitAsync - member __.Delay generator = delayA generator + member __.Delay generator = CreateDelayAsync generator - member __.Return value = resultA(value) + member __.Return value = CreateReturnAsync value member __.ReturnFrom (computation: Async<_>) = computation - member __.Bind (computation, binder) = bindA computation binder + member __.Bind (computation, binder) = CreateBindAsync computation binder - member __.Using (resource, binder) = usingA resource binder + member __.Using (resource, binder) = CreateUsingAsync resource binder - member __.While (guard, computation) = whileA guard computation + member __.While (guard, computation) = CreateWhileAsync guard computation - member __.For (sequence, body) = forA sequence body + member __.For (sequence, body) = CreateForLoopAsync sequence body - member __.Combine (computation1, computation2) = sequentialA computation1 computation2 + member __.Combine (computation1, computation2) = CreateSequentialAsync computation1 computation2 - member __.TryFinally (computation, compensation) = tryFinallyA compensation computation + member __.TryFinally (computation, compensation) = CreateTryFinallyAsync compensation computation - member __.TryWith (computation, catchHandler) = tryWithExnA catchHandler computation + member __.TryWith (computation, catchHandler) = CreateTryWithAsync catchHandler computation module AsyncImpl = let async = AsyncBuilder() @@ -1081,8 +1055,8 @@ namespace Microsoft.FSharp.Control if Thread.CurrentThread.Equals(thread) && underCurrentThreadStack then contToTailCall <- Some(fun () -> cont x) else if Trampoline.ThisThreadHasTrampoline then - let syncCtxt = getSyncContext() - postOrQueue syncCtxt aux.trampolineHolder (fun () -> cont x) |> unfake + let syncCtxt = SynchronizationContext.Current + aux.trampolineHolder.PostOrQueue syncCtxt (fun () -> cont x) |> unfake else aux.trampolineHolder.Execute (fun () -> cont x ) |> unfake try @@ -1119,12 +1093,12 @@ namespace Microsoft.FSharp.Control computation.Invoke ctxt) static member RunSynchronously (computation: Async<'T>,?timeout,?cancellationToken:CancellationToken) = - let timeout,token = + let timeout, cancellationToken = match cancellationToken with | None -> timeout,defaultCancellationTokenSource.Token | Some token when not token.CanBeCanceled -> timeout, token | Some token -> None, token - AsyncPrimitives.RunSynchronously(token, computation, timeout) + AsyncPrimitives.RunSynchronously cancellationToken computation timeout static member Start (computation, ?cancellationToken) = let cancellationToken = defaultArg cancellationToken defaultCancellationTokenSource.Token @@ -1195,7 +1169,7 @@ namespace Microsoft.FSharp.Control finishTask(Interlocked.Decrement count) tasks |> Array.iteri (fun i p -> - queueAsync + QueueAsync innerCTS.Token // on success, record the result (fun res -> recordSuccess i res) @@ -1252,7 +1226,7 @@ namespace Microsoft.FSharp.Control FakeUnit for c in computations do - queueAsync innerCts.Token scont econt ccont c |> unfake + QueueAsync innerCts.Token scont econt ccont c |> unfake FakeUnit)) @@ -1260,14 +1234,14 @@ namespace Microsoft.FSharp.Control /// StartWithContinuations, except the exception continuation is given an ExceptionDispatchInfo static member StartWithContinuationsUsingDispatchInfo(computation:Async<'T>, continuation, exceptionContinuation, cancellationContinuation, ?cancellationToken) : unit = - let token = defaultArg cancellationToken defaultCancellationTokenSource.Token - AsyncPrimitives.StartWithContinuations(token, computation, continuation, exceptionContinuation, cancellationContinuation) + let cancellationToken = defaultArg cancellationToken defaultCancellationTokenSource.Token + AsyncPrimitives.StartWithContinuations cancellationToken computation continuation exceptionContinuation cancellationContinuation static member StartWithContinuations(computation:Async<'T>, continuation, exceptionContinuation, cancellationContinuation, ?cancellationToken) : unit = Async.StartWithContinuationsUsingDispatchInfo(computation, continuation, (fun edi -> exceptionContinuation (edi.GetAssociatedSourceException())), cancellationContinuation, ?cancellationToken=cancellationToken) static member StartImmediateAsTask (computation : Async<'T>, ?cancellationToken ) : Task<'T>= - let token = defaultArg cancellationToken defaultCancellationTokenSource.Token + let cancellationToken = defaultArg cancellationToken defaultCancellationTokenSource.Token let ts = new TaskCompletionSource<'T>() let task = ts.Task Async.StartWithContinuations( @@ -1275,15 +1249,15 @@ namespace Microsoft.FSharp.Control (fun (k) -> ts.SetResult(k)), (fun exn -> ts.SetException(exn)), (fun _ -> ts.SetCanceled()), - token) + cancellationToken) task static member StartImmediate(computation:Async, ?cancellationToken) : unit = - let token = defaultArg cancellationToken defaultCancellationTokenSource.Token - AsyncPrimitives.StartWithContinuations(token, computation, id, (fun edi -> edi.ThrowAny()), ignore) + let cancellationToken = defaultArg cancellationToken defaultCancellationTokenSource.Token + AsyncPrimitives.StartWithContinuations cancellationToken computation id (fun edi -> edi.ThrowAny()) ignore static member Sleep(millisecondsDueTime) : Async = - protectUserCodeAsAsyncWithResync (fun ctxt -> + CreateDelimitedUserCodeAsync (fun ctxt -> let aux = ctxt.aux let timer = ref (None : Timer option) let savedCont = ctxt.cont @@ -1345,7 +1319,7 @@ namespace Microsoft.FSharp.Control #endif async.Return ok) else - protectUserCodeAsAsyncWithResync(fun ctxt -> + CreateDelimitedUserCodeAsync(fun ctxt -> let aux = ctxt.aux let rwh = ref (None : RegisteredWaitHandle option) let latch = Latch() @@ -1560,11 +1534,11 @@ namespace Microsoft.FSharp.Control // Note: ok to use "NoDirectTimeout" here because no timeout parameter to this method return! Async.AwaitAndBindResult_NoDirectCancelOrTimeout(resultCell) } - static member Ignore (computation: Async<'T>) = ignoreA computation + static member Ignore (computation: Async<'T>) = CreateIgnoreAsync computation - static member SwitchToNewThread() = switchToNewThread() + static member SwitchToNewThread() = CreateSwitchToNewThreadAsync() - static member SwitchToThreadPool() = switchToThreadPool() + static member SwitchToThreadPool() = CreateSwitchToThreadPoolAsync() static member StartChild (computation:Async<'T>,?millisecondsTimeout) = async { @@ -1578,7 +1552,7 @@ namespace Microsoft.FSharp.Control | null -> () | otherwise -> otherwise.Cancel()), null) - do queueAsync + do QueueAsync innerCTS.Token // since innerCTS is not ever Disposed, can call reg.Dispose() without a safety Latch (fun res -> ctsRef := null; reg.Dispose(); resultCell.RegisterResult (Ok res, reuseThread=true)) @@ -1596,7 +1570,7 @@ namespace Microsoft.FSharp.Control do! Async.SwitchToThreadPool() | syncCtxt -> // post the continuation to the synchronization context - return! switchTo syncCtxt } + return! CreateSwitchToAsync syncCtxt } static member OnCancel interruption = async { let! cancellationToken = cancellationTokenAsync @@ -1616,13 +1590,13 @@ namespace Microsoft.FSharp.Control if latch.Enter() then registration.Dispose() } } static member TryCancelled (computation: Async<'T>,compensation) = - whenCancelledA compensation computation + CreateWhenCancelledAsync compensation computation static member AwaitTask (task:Task<'T>) : Async<'T> = - protectUserCodeAsAsyncWithResync (fun ctxt -> taskContinueWith task ctxt false) + CreateDelimitedUserCodeAsync (fun ctxt -> taskContinueWith task ctxt false) static member AwaitTask (task:Task) : Async = - protectUserCodeAsAsyncWithResync (fun ctxt -> taskContinueWithUnit task ctxt false) + CreateDelimitedUserCodeAsync (fun ctxt -> taskContinueWithUnit task ctxt false) module CommonExtensions = @@ -1633,8 +1607,8 @@ namespace Microsoft.FSharp.Control let offset = defaultArg offset 0 let count = defaultArg count buffer.Length #if FX_NO_BEGINEND_READWRITE - // use combo protectUserCodeAsAsyncWithResync + taskContinueWith instead of AwaitTask so we can pass cancellation token to the ReadAsync task - protectUserCodeAsAsyncWithResync (fun ctxt -> taskContinueWith (stream.ReadAsync(buffer, offset, count, ctxt.aux.token)) ctxt false) + // use combo CreateDelimitedUserCodeAsync + taskContinueWith instead of AwaitTask so we can pass cancellation token to the ReadAsync task + CreateDelimitedUserCodeAsync (fun ctxt -> taskContinueWith (stream.ReadAsync(buffer, offset, count, ctxt.aux.token)) ctxt false) #else Async.FromBeginEnd (buffer,offset,count,stream.BeginRead,stream.EndRead) #endif @@ -1655,8 +1629,8 @@ namespace Microsoft.FSharp.Control let offset = defaultArg offset 0 let count = defaultArg count buffer.Length #if FX_NO_BEGINEND_READWRITE - // use combo protectUserCodeAsAsyncWithResync + taskContinueWithUnit instead of AwaitTask so we can pass cancellation token to the WriteAsync task - protectUserCodeAsAsyncWithResync (fun ctxt -> taskContinueWithUnit (stream.WriteAsync(buffer, offset, count, ctxt.aux.token)) ctxt false) + // use combo CreateDelimitedUserCodeAsync + taskContinueWithUnit instead of AwaitTask so we can pass cancellation token to the WriteAsync task + CreateDelimitedUserCodeAsync (fun ctxt -> taskContinueWithUnit (stream.WriteAsync(buffer, offset, count, ctxt.aux.token)) ctxt false) #else Async.FromBeginEnd (buffer,offset,count,stream.BeginWrite,stream.EndWrite) #endif @@ -1682,11 +1656,11 @@ namespace Microsoft.FSharp.Control let canceled = ref false // WebException with Status = WebExceptionStatus.RequestCanceled can be raised in other situations except cancellation, use flag to filter out false positives - // Use tryWithDispatchInfoA to allow propagation of ExceptionDispatchInfo + // Use CreateTryWithDispatchInfoAsync to allow propagation of ExceptionDispatchInfo Async.FromBeginEnd(beginAction=req.BeginGetResponse, endAction = req.EndGetResponse, cancelAction = fun() -> canceled := true; req.Abort()) - |> tryWithDispatchInfoA (fun edi -> + |> CreateTryWithDispatchInfoAsync (fun edi -> match edi.SourceException with | :? System.Net.WebException as webExn when webExn.Status = System.Net.WebExceptionStatus.RequestCanceled && !canceled -> @@ -1772,7 +1746,7 @@ namespace Microsoft.FSharp.Control // cancellation token and will register a cancelled result if cancellation occurs. // Note: It is ok to use "NoDirectTimeout" here because there is no specific timeout log to this routine. let! result = resultCell.AwaitResult_NoDirectCancelOrTimeout - return! asyncResultToAsync result + return! CreateAsyncResultAsync result } let timeout msec cancellationToken = From cccb41a70a7f19e664073b22496fec33a1ad2312 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Fri, 11 May 2018 01:20:51 +0100 Subject: [PATCH 22/39] add tests and add filtering TryWith, plus other cleanup --- src/fsharp/FSharp.Core/control.fs | 402 ++++++++++---------- src/fsharp/FSharp.Core/control.fsi | 49 ++- tests/fsharp/TypeProviderTests.fs | 2 + tests/fsharp/core/asyncStackTraces/test.fsx | 169 ++++++++ tests/fsharp/tests.fs | 12 + 5 files changed, 428 insertions(+), 206 deletions(-) create mode 100644 tests/fsharp/core/asyncStackTraces/test.fsx diff --git a/src/fsharp/FSharp.Core/control.fs b/src/fsharp/FSharp.Core/control.fs index 43617db728c..246917bf8c0 100644 --- a/src/fsharp/FSharp.Core/control.fs +++ b/src/fsharp/FSharp.Core/control.fs @@ -211,42 +211,52 @@ namespace Microsoft.FSharp.Control static let unfake FakeUnit = () // Preallocate this delegate and keep it in the trampoline holder. - let sendOrPostCallback = + let sendOrPostCallbackWithTrampoline = SendOrPostCallback (fun o -> let f = unbox<(unit -> AsyncReturn)> o - this.Execute f |> unfake) + this.ExecuteWithTrampoline f |> unfake) // Preallocate this delegate and keep it in the trampoline holder. let waitCallbackForQueueWorkItemWithTrampoline = WaitCallback (fun o -> let f = unbox<(unit -> AsyncReturn)> o - this.Execute f |> unfake) + this.ExecuteWithTrampoline f |> unfake) #if !FX_NO_PARAMETERIZED_THREAD_START // Preallocate this delegate and keep it in the trampoline holder. let threadStartCallbackForStartThreadWithTrampoline = ParameterizedThreadStart (fun o -> let f = unbox<(unit -> AsyncReturn)> o - this.Execute f |> unfake) + this.ExecuteWithTrampoline f |> unfake) #endif - member this.Post (syncCtxt: SynchronizationContext) (f : unit -> AsyncReturn) = - syncCtxt.Post (sendOrPostCallback, state=(f |> box)) + member __.Trampoline = + assert not (isNull trampoline) + trampoline + + /// Execute an async computation after installing a trampoline on its synchronous stack. + [] + member __.ExecuteWithTrampoline firstAction = + trampoline <- new Trampoline() + trampoline.Execute firstAction + + member this.PostWithTrampoline (syncCtxt: SynchronizationContext) (f : unit -> AsyncReturn) = + syncCtxt.Post (sendOrPostCallbackWithTrampoline, state=(f |> box)) FakeUnit - member this.QueueWorkItem (f: unit -> AsyncReturn) = + member this.QueueWorkItemWithTrampoline (f: unit -> AsyncReturn) = if not (ThreadPool.QueueUserWorkItem(waitCallbackForQueueWorkItemWithTrampoline, f |> box)) then failwith "failed to queue user work item" FakeUnit - member this.PostOrQueue (syncCtxt : SynchronizationContext) f = + member this.PostOrQueueWithTrampoline (syncCtxt : SynchronizationContext) f = match syncCtxt with - | null -> this.QueueWorkItem f - | _ -> this.Post syncCtxt f + | null -> this.QueueWorkItemWithTrampoline f + | _ -> this.PostWithTrampoline syncCtxt f #if FX_NO_PARAMETERIZED_THREAD_START // This should be the only call to Thread.Start in this library. We must always install a trampoline. - member this.StartThread (f : unit -> AsyncReturn) = + member this.StartThreadWithTrampoline (f : unit -> AsyncReturn) = #if FX_NO_THREAD this.QueueWorkItem(f) #else @@ -256,27 +266,11 @@ namespace Microsoft.FSharp.Control #else // This should be the only call to Thread.Start in this library. We must always install a trampoline. - member __.StartThread (f : unit -> AsyncReturn) = + member __.StartThreadWithTrampoline (f : unit -> AsyncReturn) = (new Thread(threadStartCallbackForStartThreadWithTrampoline,IsBackground=true)).Start(f|>box) FakeUnit #endif - /// Execute an async computation after installing a trampoline on its synchronous stack. - [] - member __.Execute firstAction = - trampoline <- new Trampoline() - trampoline.Execute firstAction - - member __.Trampoline = trampoline - - /// Call a continuation, but first check if an async computation should trampoline on its synchronous stack. - member inline __.HijackCheck (cont : 'T -> AsyncReturn) res = - if trampoline.IncrementBindCount() then - trampoline.Set (fun () -> cont res) - else - // NOTE: this must be a tailcall - cont res - /// Save the exception continuation during propagation of an exception, or prior to raising an exception member __.SaveExceptionContinuation(econt) = trampoline.SaveExceptionContinuation econt @@ -307,7 +301,13 @@ namespace Microsoft.FSharp.Control if ctxt.IsCancellationRequested then ctxt.OnCancellation () else - ctxt.aux.trampolineHolder.HijackCheck ctxt.cont result + // Hijack check + let trampoline = ctxt.aux.trampolineHolder.Trampoline + if trampoline.IncrementBindCount() then + trampoline.Set (fun () -> ctxt.cont result) + else + // NOTE: this must be a tailcall + ctxt.cont result /// Call the exception continuation directly member ctxt.CallExceptionContinuation edi = @@ -317,6 +317,14 @@ namespace Microsoft.FSharp.Control member ctxt.SaveExceptionContinuation() = ctxt.aux.trampolineHolder.SaveExceptionContinuation ctxt.aux.econt + member ctxt.HijackCheckThenCall cont arg = + let trampoline = ctxt.aux.trampolineHolder.Trampoline + if trampoline.IncrementBindCount() then + trampoline.Set (fun () -> cont arg) + else + // NOTE: this must be a tailcall + cont arg + [] [] type Async<'T> = @@ -364,57 +372,73 @@ namespace Microsoft.FSharp.Control /// Apply userCode to x and call either the continuation or exception continuation depending what happens [] - let ProtectUserCodePlusHijackCheck (ctxt: AsyncActivation<_>) userCode x : AsyncReturn = - // This is deliberately written in a allocation-free style, except when the trampoline is taken - let mutable res = Unchecked.defaultof<_> + let ProtectUserCodePlusHijackCheck (ctxt: AsyncActivation<_>) userCode arg : AsyncReturn = + let mutable result = Unchecked.defaultof<_> let mutable ok = false try - res <- userCode x + result <- userCode arg ok <- true finally if not ok then ctxt.SaveExceptionContinuation() if ok then - ctxt.aux.trampolineHolder.HijackCheck ctxt.cont res + ctxt.HijackCheckThenCall ctxt.cont result else FakeUnit - /// Apply userCode to x and call either the continuation or exception continuation depending what happens + /// Apply 'userCode' to 'arg' and invoke the resulting computation. [] - let ProtectUserCodePlusHijackCheckThenBind (ctxt: AsyncActivation<_>) userCode x : AsyncReturn = - // This is deliberately written in a allocation-free style, except when the trampoline is taken - let mutable res = Unchecked.defaultof<_> + let ProtectUserCodePlusHijackCheckThenInvoke (ctxt: AsyncActivation<_>) userCode arg : AsyncReturn = + let mutable result = Unchecked.defaultof<_> let mutable ok = false try - res <- userCode x + result <- userCode arg ok <- true finally if not ok then ctxt.SaveExceptionContinuation() if ok then - let trampoline = ctxt.aux.trampolineHolder.Trampoline - if trampoline.IncrementBindCount() then - trampoline.Set (fun () -> res.Invoke ctxt) - else - // NOTE: this must be a tailcall - res.Invoke ctxt + ctxt.HijackCheckThenCall result.Invoke ctxt + else + FakeUnit + + /// Apply 'catchFilter' to 'arg'. If the result is 'Some' invoke the resulting computation. If the result is 'None' + /// then send 'result1' to the exception continuation. + [] + let ProtectUserCodePlusHijackCheckThenTryWithFilterFunctionInvoke (ctxt: AsyncActivation<_>) catchFilter (edi: ExceptionDispatchInfo) : AsyncReturn = + let mutable resOpt = Unchecked.defaultof<_> + let mutable ok = false + + try + resOpt <- catchFilter (edi.GetAssociatedSourceException()) + ok <- true + finally + if not ok then + ctxt.SaveExceptionContinuation() + + if ok then + match resOpt with + | None -> + ctxt.HijackCheckThenCall ctxt.aux.econt edi + | Some res -> + ctxt.HijackCheckThenCall res.Invoke ctxt else FakeUnit - /// Apply userCode to x and call either the continuation or exception continuation depending what happens. + /// Apply userCode to x and invoke the resulting computation. /// Does not do a hijack check. [] - let ProtectUserCodeThenBind (ctxt: AsyncActivation<_>) userCode x : AsyncReturn = + let ProtectUserCodeThenInvoke (ctxt: AsyncActivation<_>) userCode result1 = // This is deliberately written in a allocation-free style let mutable res = Unchecked.defaultof<_> let mutable ok = false try - res <- userCode x + res <- userCode result1 ok <- true finally if not ok then @@ -445,13 +469,6 @@ namespace Microsoft.FSharp.Control let CreateAsyncActivation cancellationToken trampolineHolder cont econt ccont = { cont = cont; aux = { token = cancellationToken; econt = econt; ccont = ccont; trampolineHolder = trampolineHolder } } - [] - let QueueAsync cancellationToken cont econt ccont computation = - let trampolineHolder = new TrampolineHolder() - trampolineHolder.QueueWorkItem (fun () -> - let ctxt = CreateAsyncActivation cancellationToken trampolineHolder cont econt ccont - computation.Invoke ctxt) - /// Build a primitive without any exception or resync protection let MakeAsync body = { Invoke = body } @@ -464,50 +481,20 @@ namespace Microsoft.FSharp.Control [] // Note: direct calls to this function end up in user assemblies via inlining - let rec Bind keepStack (ctxt: AsyncActivation<_>) part1 part2 = + // Note "Bind ctxt (MakeAsync (fun ctxt -> E)) part2" == "Call ctxt E + let rec Bind (ctxt: AsyncActivation<_>) part1 part2 = // Cancellation check if ctxt.IsCancellationRequested then ctxt.OnCancellation () else // Hijack check let trampoline = ctxt.aux.trampolineHolder.Trampoline - if trampoline.IncrementBindCount() then - trampoline.Set(fun () -> Bind keepStack ctxt part1 part2) - - // In debug code, keep a stack frame for the synchronous invocation of part1, but drop it for part2 - elif keepStack then - - let latch = Latch() - - let mutable savedResult1 = Unchecked.defaultof<_> - - let ctxtPart1ThenPart2 = - let cont result1 = - savedResult1 <- result1 - if latch.Enter() then - FakeUnit - else - ProtectUserCodeThenBind ctxt part2 result1 - { cont=cont; aux = ctxt.aux } - - let result2 = part1.Invoke ctxtPart1ThenPart2 - - if latch.Enter() then - // We acquired the latch before the continuation was called. - // This indicates the body is being run async, or an exception or - // cancellation happened. - result2 - else - // The body continuation acquired the latch. - // This indicates the body should be run sync using the saved result. - // - // NOTE: this must be a tailcall to drop the part1 frame off the stack. - ProtectUserCodeThenBind ctxt part2 savedResult1 - + trampoline.Set(fun () -> Bind ctxt part1 part2) else - let cont a = ProtectUserCodeThenBind ctxt part2 a - let ctxtPart1ThenPart2 = { cont=cont; aux = ctxt.aux } + let ctxtPart1ThenPart2 = + let cont result1 = ProtectUserCodeThenInvoke ctxt part2 result1 + { cont=cont; aux = ctxt.aux } part1.Invoke ctxtPart1ThenPart2 [] @@ -518,13 +505,19 @@ namespace Microsoft.FSharp.Control if ctxt.IsCancellationRequested then ctxt.OnCancellation () else - ProtectUserCodePlusHijackCheckThenBind ctxt part2 result1 + ProtectUserCodePlusHijackCheckThenInvoke ctxt part2 result1 - let inline CallDelay ctxt generator = - Call ctxt () generator + /// Execute the with-filter part of a try-with-filer but first check for trampoline and cancellation. + // + // Note: direct calls to this function end up in user assemblies via inlining + let CallTryWithFilterFunction (ctxt: AsyncActivation<'T>) result1 (part2: Exception -> Async<'T> option) = + if ctxt.IsCancellationRequested then + ctxt.OnCancellation () + else + ProtectUserCodePlusHijackCheckThenTryWithFilterFunctionInvoke ctxt part2 result1 [] - let TryFinally (ctxt: AsyncActivation<'T>) finallyFunction computation = + let TryFinally (ctxt: AsyncActivation<'T>) computation finallyFunction = if ctxt.IsCancellationRequested then ctxt.OnCancellation () else @@ -545,9 +538,20 @@ namespace Microsoft.FSharp.Control ProtectUserCodePlusHijackCheck ctxt finallyFunction () computation.Invoke { ctxt with cont = cont; aux = { ctxt.aux with econt = econt; ccont = ccont } } + // Re-route the exception continuation to call to catchFunction. If catchFunction or the new process fail + // then call the original exception continuation with the failure. + [] + let TryWith (ctxt: AsyncActivation<'T>) computation catchFunction = + if ctxt.IsCancellationRequested then + ctxt.OnCancellation () + else + let econt (edi: ExceptionDispatchInfo) = CallTryWithFilterFunction ctxt edi catchFunction + let newCtxt = { ctxt with aux = { ctxt.aux with econt = econt } } + computation.Invoke newCtxt + /// When run, ensures that any exceptions raised by the immediate execution of "f" are /// sent to the exception continuation. - let CreateUserCodeAsync f = + let CreateProtectedAsync f = MakeAsync (fun ctxt -> ProtectUserCode ctxt f) let CreateAsyncResultAsync res = @@ -565,9 +569,9 @@ namespace Microsoft.FSharp.Control // The primitive bind operation. Generate a process that runs the first process, takes // its result, applies f and then runs the new process produced. Hijack if necessary and // run 'f' with exception protection - let inline CreateBindAsync keepStack part1 part2 = + let inline CreateBindAsync part1 part2 = // Note: this code ends up in user assemblies via inlining - MakeAsync (fun ctxt -> Bind keepStack ctxt part1 part2) + MakeAsync (fun ctxt -> Bind ctxt part1 part2) // Call the given function with exception protection, but first // check for cancellation. @@ -577,33 +581,29 @@ namespace Microsoft.FSharp.Control let inline CreateDelayAsync computation = // Note: this code ends up in user assemblies via inlining - MakeAsync (fun ctxt -> CallDelay ctxt computation) + MakeAsync (fun ctxt -> Call ctxt () computation) /// Implements the sequencing construct of async computation expressions let inline CreateSequentialAsync part1 part2 = // Note: this code ends up in user assemblies via inlining - CreateBindAsync false part1 (fun () -> part2) + CreateBindAsync part1 (fun () -> part2) // Call p but augment the normal, exception and cancel continuations with a call to finallyFunction. // If the finallyFunction raises an exception then call the original exception continuation // with the new exception. If exception is raised after a cancellation, exception is ignored // and cancel continuation is called. let inline CreateTryFinallyAsync finallyFunction computation = - MakeAsync (fun ctxt -> TryFinally ctxt finallyFunction computation) + MakeAsync (fun ctxt -> TryFinally ctxt computation finallyFunction) // Re-route the exception continuation to call to catchFunction. If catchFunction or the new process fail // then call the original exception continuation with the failure. - let CreateTryWithDispatchInfoAsync catchFunction computation = - MakeAsync (fun ctxt -> - if ctxt.IsCancellationRequested then - ctxt.OnCancellation () - else - let econt (edi: ExceptionDispatchInfo) = Call ctxt edi catchFunction - let newCtxt = { ctxt with aux = { ctxt.aux with econt = econt } } - computation.Invoke newCtxt) + let inline CreateTryWithFilterAsync catchFunction computation = + MakeAsync (fun ctxt -> TryWith ctxt computation (fun edi -> catchFunction edi)) - let CreateTryWithAsync catchFunction computation = - computation |> CreateTryWithDispatchInfoAsync (fun edi -> catchFunction (edi.GetAssociatedSourceException())) + // Re-route the exception continuation to call to catchFunction. If catchFunction or the new process fail + // then call the original exception continuation with the failure. + let inline CreateTryWithAsync catchFunction computation = + CreateTryWithFilterAsync (fun exn -> Some (catchFunction exn)) computation /// Call the finallyFunction if the computation results in a cancellation let CreateWhenCancelledAsync (finallyFunction : OperationCanceledException -> unit) computation = @@ -632,13 +632,13 @@ namespace Microsoft.FSharp.Control CreateTryFinallyAsync disposeFunction (CreateCallAsync computation resource) |> CreateWhenCancelledAsync disposeFunction let inline CreateIgnoreAsync computation = - CreateBindAsync false computation (fun _ -> unitAsync) + CreateBindAsync computation (fun _ -> unitAsync) /// Implement the while loop construct of async computation expressions let CreateWhileAsync guardFunc computation = let mutable whileAsync = Unchecked.defaultof<_> if guardFunc() then - whileAsync <- CreateBindAsync false computation (fun () -> if guardFunc() then whileAsync else unitAsync) + whileAsync <- CreateBindAsync computation (fun () -> if guardFunc() then whileAsync else unitAsync) whileAsync else unitAsync @@ -651,16 +651,16 @@ namespace Microsoft.FSharp.Control (CreateDelayAsync (fun () -> computation ie.Current))) let CreateSwitchToAsync (syncCtxt: SynchronizationContext) = - CreateUserCodeAsync (fun ctxt -> - ctxt.aux.trampolineHolder.Post syncCtxt (fun () -> ctxt.cont ())) + CreateProtectedAsync (fun ctxt -> + ctxt.aux.trampolineHolder.PostWithTrampoline syncCtxt (fun () -> ctxt.cont ())) let CreateSwitchToNewThreadAsync() = - CreateUserCodeAsync (fun ctxt -> - ctxt.aux.trampolineHolder.StartThread (fun () -> ctxt.cont ())) + CreateProtectedAsync (fun ctxt -> + ctxt.aux.trampolineHolder.StartThreadWithTrampoline (fun () -> ctxt.cont ())) let CreateSwitchToThreadPoolAsync() = - CreateUserCodeAsync (fun ctxt -> - ctxt.aux.trampolineHolder.QueueWorkItem (fun () -> ctxt.cont ())) + CreateProtectedAsync (fun ctxt -> + ctxt.aux.trampolineHolder.QueueWorkItemWithTrampoline (fun () -> ctxt.cont ())) let delimitSyncContext ctxt = match SynchronizationContext.Current with @@ -669,15 +669,15 @@ namespace Microsoft.FSharp.Control let aux = ctxt.aux let trampolineHolder = aux.trampolineHolder { ctxt with - cont = (fun x -> trampolineHolder.Post syncCtxt (fun () -> ctxt.cont x)) + cont = (fun x -> trampolineHolder.PostWithTrampoline syncCtxt (fun () -> ctxt.cont x)) aux = { aux with - econt = (fun x -> trampolineHolder.Post syncCtxt (fun () -> aux.econt x)) - ccont = (fun x -> trampolineHolder.Post syncCtxt (fun () -> aux.ccont x)) } + econt = (fun x -> trampolineHolder.PostWithTrampoline syncCtxt (fun () -> aux.econt x)) + ccont = (fun x -> trampolineHolder.PostWithTrampoline syncCtxt (fun () -> aux.ccont x)) } } // When run, ensures that each of the continuations of the process are run in the same synchronization context. let CreateDelimitedUserCodeAsync f = - CreateUserCodeAsync (fun ctxt -> + CreateProtectedAsync (fun ctxt -> let ctxtWithSync = delimitSyncContext ctxt f ctxtWithSync) @@ -696,7 +696,7 @@ namespace Microsoft.FSharp.Control member __.ContinueImmediate res = let action () = ctxt.cont res - let inline executeImmediately () = trampolineHolder.Execute action + let inline executeImmediately () = trampolineHolder.ExecuteWithTrampoline action let currentSyncCtxt = SynchronizationContext.Current match syncCtxt, currentSyncCtxt with | null, null -> @@ -706,10 +706,10 @@ namespace Microsoft.FSharp.Control | _ when Object.Equals(syncCtxt, currentSyncCtxt) && thread.Equals(Thread.CurrentThread) -> executeImmediately () | _ -> - trampolineHolder.PostOrQueue syncCtxt action + trampolineHolder.PostOrQueueWithTrampoline syncCtxt action member __.ContinueWithPostOrQueue res = - trampolineHolder.PostOrQueue syncCtxt (fun () -> ctxt.cont res) + trampolineHolder.PostOrQueueWithTrampoline syncCtxt (fun () -> ctxt.cont res) /// A utility type to provide a synchronization point between an asynchronous computation /// and callers waiting on the result of that computation. @@ -761,7 +761,7 @@ namespace Microsoft.FSharp.Control resEvent <- null) interface IDisposable with - member x.Dispose() = x.Close() // ; System.GC.SuppressFinalize(x) + member x.Dispose() = x.Close() member x.GrabResult() = match result with @@ -794,14 +794,14 @@ namespace Microsoft.FSharp.Control // Run the action outside the lock match grabbedConts with - | [] -> FakeUnit - | [cont] -> - if reuseThread then - cont.ContinueImmediate(res) - else - cont.ContinueWithPostOrQueue(res) - | otherwise -> - otherwise |> List.iter (fun cont -> cont.ContinueWithPostOrQueue(res) |> unfake) |> fake + | [] -> FakeUnit + | [cont] -> + if reuseThread then + cont.ContinueImmediate(res) + else + cont.ContinueWithPostOrQueue(res) + | otherwise -> + otherwise |> List.iter (fun cont -> cont.ContinueWithPostOrQueue(res) |> unfake) |> fake member x.ResultAvailable = result.IsSome @@ -813,20 +813,20 @@ namespace Microsoft.FSharp.Control // Check if a result is available synchronously let resOpt = match result with - | Some _ -> result - | None -> - lock syncRoot (fun () -> - match result with - | Some _ -> - result - | None -> - // Otherwise save the continuation and call it in RegisterResult - savedConts <- (SuspendedAsync<_>(ctxt))::savedConts - None - ) + | Some _ -> result + | None -> + lock syncRoot (fun () -> + match result with + | Some _ -> + result + | None -> + // Otherwise save the continuation and call it in RegisterResult + savedConts <- (SuspendedAsync<_>(ctxt))::savedConts + None + ) match resOpt with - | Some res -> ctxt.cont res - | None -> FakeUnit + | Some res -> ctxt.cont res + | None -> FakeUnit ) member x.TryWaitForResultSynchronously (?timeout) : 'T option = @@ -870,6 +870,13 @@ namespace Microsoft.FSharp.Control let invokeMeth = (typeof>).GetMethod("Invoke", BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.Instance) System.Delegate.CreateDelegate(typeof<'Delegate>, obj, invokeMeth) :?> 'Delegate + [] + let QueueAsync cancellationToken cont econt ccont computation = + let trampolineHolder = new TrampolineHolder() + trampolineHolder.QueueWorkItemWithTrampoline (fun () -> + let ctxt = CreateAsyncActivation cancellationToken trampolineHolder cont econt ccont + computation.Invoke ctxt) + /// Run the asynchronous workflow and wait for its result. [] let RunSynchronouslyInAnotherThread (token:CancellationToken,computation,timeout) = @@ -903,25 +910,24 @@ namespace Microsoft.FSharp.Control raise (System.TimeoutException()) | Some res -> match innerCTS with - | Some subSource -> subSource.Dispose() - | None -> () + | Some subSource -> subSource.Dispose() + | None -> () res.Commit() [] - let RunSynchronouslyInCurrentThread (token:CancellationToken,computation) = + let RunSynchronouslyInCurrentThread (cancellationToken:CancellationToken,computation) = use resultCell = new ResultCell>() - let trampolineHolder = TrampolineHolder() + let trampolineHolder = new TrampolineHolder() - trampolineHolder.Execute - (fun () -> - let ctxt = - CreateAsyncActivation - token + trampolineHolder.ExecuteWithTrampoline (fun () -> + let ctxt = + CreateAsyncActivation + cancellationToken trampolineHolder (fun res -> resultCell.RegisterResult(AsyncResult.Ok(res),reuseThread=true)) (fun edi -> resultCell.RegisterResult(AsyncResult.Error(edi),reuseThread=true)) (fun exn -> resultCell.RegisterResult(AsyncResult.Canceled(exn),reuseThread=true)) - computation.Invoke ctxt) + computation.Invoke ctxt) |> unfake let res = resultCell.TryWaitForResultSynchronously().Value @@ -946,9 +952,9 @@ namespace Microsoft.FSharp.Control | _ -> RunSynchronouslyInAnotherThread (cancellationToken, computation, timeout) [] - let Start token (computation:Async) = + let Start cancellationToken (computation:Async) = QueueAsync - token + cancellationToken (fun () -> FakeUnit) // nothing to do on success (fun edi -> edi.ThrowAny()) // raise exception in child (fun _ -> FakeUnit) // ignore cancellation in child @@ -958,7 +964,7 @@ namespace Microsoft.FSharp.Control [] let StartWithContinuations cancellationToken (computation:Async<'T>) cont econt ccont = let trampolineHolder = new TrampolineHolder() - trampolineHolder.Execute (fun () -> + trampolineHolder.ExecuteWithTrampoline (fun () -> let ctxt = CreateAsyncActivation cancellationToken trampolineHolder (cont >> fake) (econt >> fake) (ccont >> fake) computation.Invoke ctxt) |> unfake @@ -982,11 +988,10 @@ namespace Microsoft.FSharp.Control task // Helper to attach continuation to the given task. - // Should be invoked as a part of CreateUserCodeAsync(withResync) call let taskContinueWith (task : Task<'T>) ctxt useCcontForTaskCancellation = let continuation (completedTask: Task<_>) : unit = - ctxt.aux.trampolineHolder.Execute (fun () -> + ctxt.aux.trampolineHolder.ExecuteWithTrampoline (fun () -> if completedTask.IsCanceled then if useCcontForTaskCancellation then ctxt.OnCancellation () @@ -1005,7 +1010,7 @@ namespace Microsoft.FSharp.Control let taskContinueWithUnit (task: Task) ctxt useCcontForTaskCancellation = let continuation (completedTask: Task) : unit = - ctxt.aux.trampolineHolder.Execute (fun () -> + ctxt.aux.trampolineHolder.ExecuteWithTrampoline (fun () -> if completedTask.IsCanceled then if useCcontForTaskCancellation then ctxt.OnCancellation () @@ -1115,7 +1120,7 @@ namespace Microsoft.FSharp.Control member inline __.ReturnFrom (computation:Async<_>) = computation - member inline __.Bind (computation, binder) = CreateBindAsync true computation binder + member inline __.Bind (computation, binder) = CreateBindAsync computation binder member __.Using (resource, binder) = CreateUsingAsync resource binder @@ -1127,7 +1132,9 @@ namespace Microsoft.FSharp.Control member inline __.TryFinally (computation, compensation) = CreateTryFinallyAsync compensation computation - member __.TryWith (computation, catchHandler) = CreateTryWithAsync catchHandler computation + member inline __.TryWith (computation, catchHandler) = CreateTryWithAsync catchHandler computation + + // member inline __.TryWithFilter (computation, catchHandler) = CreateTryWithFilterAsync catchHandler computation [] module AsyncBuilderImpl = @@ -1157,9 +1164,9 @@ namespace Microsoft.FSharp.Control contToTailCall <- Some(fun () -> cont x) else if Trampoline.ThisThreadHasTrampoline then let syncCtxt = SynchronizationContext.Current - aux.trampolineHolder.PostOrQueue syncCtxt (fun () -> cont x) |> unfake + aux.trampolineHolder.PostOrQueueWithTrampoline syncCtxt (fun () -> cont x) |> unfake else - aux.trampolineHolder.Execute (fun () -> cont x ) |> unfake + aux.trampolineHolder.ExecuteWithTrampoline (fun () -> cont x ) |> unfake try callback (once ctxt.cont, (fun exn -> once aux.econt (MayLoseStackTrace(exn))), once aux.ccont) with exn -> @@ -1243,9 +1250,9 @@ namespace Microsoft.FSharp.Control if (remaining = 0) then innerCTS.Dispose() match (!firstExn) with - | None -> trampolineHolder.Execute (fun () -> ctxtWithSync.cont results) - | Some (Choice1Of2 exn) -> trampolineHolder.Execute (fun () -> aux.econt exn) - | Some (Choice2Of2 cexn) -> trampolineHolder.Execute (fun () -> aux.ccont cexn) + | None -> trampolineHolder.ExecuteWithTrampoline (fun () -> ctxtWithSync.cont results) + | Some (Choice1Of2 exn) -> trampolineHolder.ExecuteWithTrampoline (fun () -> aux.econt exn) + | Some (Choice2Of2 cexn) -> trampolineHolder.ExecuteWithTrampoline (fun () -> aux.ccont cexn) else FakeUnit @@ -1305,25 +1312,25 @@ namespace Microsoft.FSharp.Control match result with | Some _ -> if Interlocked.Increment exnCount = 1 then - innerCts.Cancel(); trampolineHolder.Execute (fun () -> ctxtWithSync.cont result) + innerCts.Cancel(); trampolineHolder.ExecuteWithTrampoline (fun () -> ctxtWithSync.cont result) else FakeUnit | None -> if Interlocked.Increment noneCount = computations.Length then - innerCts.Cancel(); trampolineHolder.Execute (fun () -> ctxtWithSync.cont None) + innerCts.Cancel(); trampolineHolder.ExecuteWithTrampoline (fun () -> ctxtWithSync.cont None) else FakeUnit let econt (exn : ExceptionDispatchInfo) = if Interlocked.Increment exnCount = 1 then - innerCts.Cancel(); trampolineHolder.Execute (fun () -> ctxtWithSync.aux.econt exn) + innerCts.Cancel(); trampolineHolder.ExecuteWithTrampoline (fun () -> ctxtWithSync.aux.econt exn) else FakeUnit let ccont (exn : OperationCanceledException) = if Interlocked.Increment exnCount = 1 then - innerCts.Cancel(); trampolineHolder.Execute (fun () -> ctxtWithSync.aux.ccont exn) + innerCts.Cancel(); trampolineHolder.ExecuteWithTrampoline (fun () -> ctxtWithSync.aux.ccont exn) else FakeUnit @@ -1372,7 +1379,7 @@ namespace Microsoft.FSharp.Control match !timer with | None -> () | Some t -> t.Dispose() - aux.trampolineHolder.Execute (fun () -> savedCCont(new OperationCanceledException(aux.token))) |> unfake + aux.trampolineHolder.ExecuteWithTrampoline (fun () -> savedCCont(new OperationCanceledException(aux.token))) |> unfake ), null) let mutable edi = null @@ -1392,7 +1399,7 @@ namespace Microsoft.FSharp.Control | None -> () | Some t -> t.Dispose() // Now we're done, so call the continuation - aux.trampolineHolder.Execute (fun () -> savedCont()) |> unfake), + aux.trampolineHolder.ExecuteWithTrampoline (fun () -> savedCont()) |> unfake), null, dueTime=millisecondsDueTime, period = -1) |> Some with exn -> if latch.Enter() then @@ -1448,7 +1455,7 @@ namespace Microsoft.FSharp.Control lock rwh (fun () -> rwh.Value.Value.Unregister(null) |> ignore) rwh := None registration.Dispose() - aux.trampolineHolder.Execute (fun () -> savedCont (not timeOut)) |> unfake), + aux.trampolineHolder.ExecuteWithTrampoline (fun () -> savedCont (not timeOut)) |> unfake), state=null, millisecondsTimeOutInterval=millisecondsTimeout, executeOnlyOnce=true)); @@ -1549,9 +1556,9 @@ namespace Microsoft.FSharp.Control // The callback has been activated, so ensure cancellation is not possible // beyond this point. match cancelAction with - | Some _ -> + | Some _ -> registration.Dispose() - | None -> + | None -> once.Do(fun () -> registration.Dispose()) // Run the endAction and collect its result. @@ -1651,8 +1658,8 @@ namespace Microsoft.FSharp.Control let reg = cancellationToken.Register( (fun _ -> match !ctsRef with - | null -> () - | otherwise -> otherwise.Cancel()), + | null -> () + | otherwise -> otherwise.Cancel()), null) do QueueAsync innerCTS.Token @@ -1758,18 +1765,18 @@ namespace Microsoft.FSharp.Control let canceled = ref false // WebException with Status = WebExceptionStatus.RequestCanceled can be raised in other situations except cancellation, use flag to filter out false positives - // Use CreateTryWithDispatchInfoAsync to allow propagation of ExceptionDispatchInfo + // Use CreateTryWithFilterAsync to allow propagation of exception without losing stack Async.FromBeginEnd(beginAction=req.BeginGetResponse, endAction = req.EndGetResponse, cancelAction = fun() -> canceled := true; req.Abort()) - |> CreateTryWithDispatchInfoAsync (fun edi -> - match edi.SourceException with + |> CreateTryWithFilterAsync (fun exn -> + match exn with | :? System.Net.WebException as webExn when webExn.Status = System.Net.WebExceptionStatus.RequestCanceled && !canceled -> - Async.BindResult(AsyncResult.Canceled (OperationCanceledException webExn.Message)) + Some (Async.BindResult(AsyncResult.Canceled (OperationCanceledException webExn.Message))) | _ -> - edi.ThrowAny()) + None) #if !FX_NO_WEB_CLIENT @@ -1992,7 +1999,7 @@ namespace Microsoft.FSharp.Control | Some (action, trampolineHolder) -> savedCont <- None - trampolineHolder.QueueWorkItem(fun () -> action true) |> unfake) + trampolineHolder.QueueWorkItemWithTrampoline(fun () -> action true) |> unfake) member x.TryScan ((f: 'Msg -> (Async<'T>) option), timeout) : Async<'T option> = let rec scan timeoutAsync (timeoutCts:CancellationTokenSource) = @@ -2029,25 +2036,26 @@ namespace Microsoft.FSharp.Control } let rec scanNoTimeout () = async { match x.ScanArrivals(f) with - | None -> let! ok = waitOne(Timeout.Infinite) - if ok then - return! scanNoTimeout() - else - return (failwith "Timed out with infinite timeout??") - | Some resP -> + | None -> + let! ok = waitOne(Timeout.Infinite) + if ok then + return! scanNoTimeout() + else + return (failwith "Timed out with infinite timeout??") + | Some resP -> let! res = resP return Some res } // Look in the inbox first async { match x.ScanInbox(f,0) with - | None when timeout < 0 -> return! scanNoTimeout() - | None -> + | None when timeout < 0 -> return! scanNoTimeout() + | None -> let! cancellationToken = Async.CancellationToken let timeoutCts = CancellationTokenSource.CreateLinkedTokenSource(cancellationToken, CancellationToken.None) let timeoutAsync = AsyncHelpers.timeout timeout timeoutCts.Token return! scan timeoutAsync timeoutCts - | Some resP -> + | Some resP -> let! res = resP return Some res diff --git a/src/fsharp/FSharp.Core/control.fsi b/src/fsharp/FSharp.Core/control.fsi index 386ca9f8ead..72156b04ec5 100644 --- a/src/fsharp/FSharp.Core/control.fsi +++ b/src/fsharp/FSharp.Core/control.fsi @@ -451,20 +451,48 @@ namespace Microsoft.FSharp.Control /// Entry points for generated code module AsyncPrimitives = - /// Calls to this member are emitted in compiled code + /// The F# compiler emits calls to this function to implement F# async expressions. + /// + /// The body of the async computation. + /// + /// The async computation. val MakeAsync: body:(AsyncActivation<'T> -> AsyncReturn) -> Async<'T> - /// Calls to this member are emitted in compiled code + /// The F# compiler emits calls to this function to implement constructs for F# async expressions. + /// + /// The async activation. + /// The result of the first part of the computation. + /// A function returning the second part of the computation. + /// + /// Nothing. val Call: ctxt:AsyncActivation<'T> -> result1:'U -> part2:('U -> Async<'T>) -> AsyncReturn - // /// Calls to this member are emitted in compiled code - // val CallDelay: ctxt:AsyncActivation<'T> -> generator:(unit -> Async<'T>) -> AsyncReturn + /// The F# compiler emits calls to this function to implement the let! construct for F# async expressions. + /// + /// The async activation. + /// The first part of the computation. + /// A function returning the second part of the computation. + /// + /// Nothing. + val Bind: ctxt:AsyncActivation<'T> -> part1:Async<'U> -> part2:('U -> Async<'T>) -> AsyncReturn - /// Calls to this member are emitted in compiled code - val Bind: keepStack: bool -> ctxt:AsyncActivation<'T> -> part1:Async<'U> -> part2:('U -> Async<'T>) -> AsyncReturn + /// The F# compiler emits calls to this function to implement the try/finally construct for F# async expressions. + /// + /// The async activation. + /// The computation to protect. + /// The finally code. + /// + /// Nothing. + val TryFinally: ctxt:AsyncActivation<'T> -> computation: Async<'T> -> finallyFunction: (unit -> unit) -> AsyncReturn - /// Calls to this member are emitted in compiled code - val TryFinally: ctxt:AsyncActivation<'T> -> finallyFunction: (unit -> unit) -> computation: Async<'T> -> AsyncReturn + /// The F# compiler emits calls to this function to implement the try/with construct for F# async expressions. + /// + /// The async activation. + /// The computation to protect. + /// The exception filter. + /// + /// Nothing. + val TryWith: ctxt:AsyncActivation<'T> -> computation: Async<'T> -> catchFunction: (Exception -> Async<'T> option) -> AsyncReturn [] [] @@ -592,11 +620,14 @@ namespace Microsoft.FSharp.Control /// /// The existence of this method permits the use of try/with in the /// async { ... } computation expression syntax. + /// /// The input computation. /// The function to run when computation throws an exception. /// An asynchronous computation that executes computation and calls catchHandler if an /// exception is thrown. - member TryWith : computation:Async<'T> * catchHandler:(exn -> Async<'T>) -> Async<'T> + member inline TryWith : computation:Async<'T> * catchHandler:(exn -> Async<'T>) -> Async<'T> + + // member inline TryWithFilter : computation:Async<'T> * catchHandler:(exn -> Async<'T> option) -> Async<'T> /// Generate an object used to build asynchronous computations using F# computation expressions. The value /// 'async' is a pre-defined instance of this type. diff --git a/tests/fsharp/TypeProviderTests.fs b/tests/fsharp/TypeProviderTests.fs index 00633234ea3..3055e5c192f 100644 --- a/tests/fsharp/TypeProviderTests.fs +++ b/tests/fsharp/TypeProviderTests.fs @@ -30,6 +30,7 @@ let FSI_BASIC = FSI_FILE let FSIANYCPU_BASIC = FSIANYCPU_FILE #endif +(* [] let diamondAssembly () = let cfg = testConfig "typeProviders/diamondAssembly" @@ -356,3 +357,4 @@ let wedgeAssembly () = peverify cfg "test3.exe" exec cfg ("." ++ "test3.exe") "" +*) diff --git a/tests/fsharp/core/asyncStackTraces/test.fsx b/tests/fsharp/core/asyncStackTraces/test.fsx new file mode 100644 index 00000000000..46719564d48 --- /dev/null +++ b/tests/fsharp/core/asyncStackTraces/test.fsx @@ -0,0 +1,169 @@ + +// Tests that async stack traces contain certain method names + +// See https://github.com/Microsoft/visualfsharp/pull/4867 + +// The focus of the tests is on the synchronous parts of async execution, and on exceptions. + +let mutable failures = [] +let syncObj = new obj() +let report_failure s = + stderr.WriteLine " NO"; + lock syncObj (fun () -> + failures <- s :: failures; + printfn "FAILURE: %s failed" s + ) + +let test s b = stderr.Write(s:string); if b then stderr.WriteLine " OK" else report_failure s + +let checkQuiet s x1 x2 = + if x1 <> x2 then + (test s false; + printfn "expected: %A, got %A" x2 x1) + +let check s x1 x2 = + if x1 = x2 then test s true + else (test s false; printfn "expected: %A, got %A" x2 x1) + + +let rec async_syncLoopViaTailCallFail(n) = async { + if n > 10 then + let! res = failwith "fail" + return res + else + return! async_syncLoopViaTailCallFail(n+1) +} + +let rec async_syncLoopViaNonTailCallFail(n) = async { + if n > 10 then + let! res = failwith "fail" + return Unchecked.defaultof<_> + else + let! n2 = async_syncLoopViaNonTailCallFail(n+1) + return n2 +} + +let rec async_syncWhileLoopFail() = async { + let mutable n = 0 + while true do + if n > 10 then + let! res = failwith "fail" + return res + else + n <- n + 1 +} + +let rec async_syncTryFinallyFail() = async { + try + failwith "fail" + finally + () +} + +// Raising an exception counts as an "asynchronous action" which wipes out the stack. +// +// This is because of a limitation in the .NET exception mechanism where stack traces are only populated +// up to the point where they are caught, so we need to catch them in the trampoline handler to get a good stack. +// +// This means that re-raising that exception (e.g. in a failed pattern match for a try-with) +// or throwing an exception from the "with" handler will not get a good stack. +// There is not yet any good workaround for this. +// +//let rec async_syncTryWithFail() = async { +// try +// failwith "fail" +// with _ -> () +//} + +let rec async_syncPreAsyncSleepFail() = async { + let! x = failwith "fail" // failure is in synchronous part of code + do! Async.Sleep 10 + return Unchecked.defaultof<_> +} + +let rec async_syncFail() = async { + failwith "fail" +} + +let asyncCheckEnvironmentStackTracesBottom() = async { + let stack = System.Diagnostics.StackTrace(true).ToString() + //test "vwerv0re0reer: stack = %s", stack); + test "clncw09ew09c1" (stack.Contains("asyncCheckEnvironmentStackTracesBottom")) + test "clncw09ew09c2" (stack.Contains(string (int __LINE__ - 3))) + test "clncw09ew09d3" (stack.Contains("asyncCheckEnvironmentStackTracesMid")) + test "clncw09ew09e4" (stack.Contains("asyncCheckEnvironmentStackTracesTop")) + return 1 +} + +let asyncCheckEnvironmentStackTracesMid() = async { + let! res = asyncCheckEnvironmentStackTracesBottom() + let stack = System.Diagnostics.StackTrace(true).ToString() + test "clncw09ew09d2" (stack.Contains("asyncCheckEnvironmentStackTracesMid")) + test "clncw09ew09c" (stack.Contains(string (int __LINE__ - 2))) + test "clncw09ew09e2" (stack.Contains("asyncCheckEnvironmentStackTracesTop")) + return res +} + +let asyncCheckEnvironmentStackTracesTop() = async { + let! res = asyncCheckEnvironmentStackTracesMid() + let stack = System.Diagnostics.StackTrace(true).ToString() + test "clncw09ew09f" (stack.Contains("asyncCheckEnvironmentStackTracesTop")) + test "clncw09ew09c" (stack.Contains(string (int __LINE__ - 2))) + + do! Async.Sleep 10 + let stack = System.Diagnostics.StackTrace(true).ToString() + test "clncw09ew09f" (stack.Contains("asyncCheckEnvironmentStackTracesTop")) + test "clncw09ew09c" (stack.Contains(string (int __LINE__ - 2))) + +} + +let asyncMid(f) = async { + + let! res = f() + () +} +let asyncTop2(f) = async { + + let! res = asyncMid(f) + return () +} + +let asyncTop3(f) = async { + + do! Async.Sleep 10 + let! res = asyncMid(f) + return () +} + + + +asyncCheckEnvironmentStackTracesTop() |> Async.RunSynchronously + +let testCasesThatRaiseExceptions = + [ ("async_syncFail", async_syncFail) + ("async_syncLoopViaTailCallFail", (fun () -> async_syncLoopViaTailCallFail(0))) + ("async_syncLoopViaNonTailCallFail", (fun () -> async_syncLoopViaNonTailCallFail(0))) + ("async_syncWhileLoopFail", async_syncWhileLoopFail) + ("async_syncTryFinallyFail", async_syncTryFinallyFail) + ("async_syncPreAsyncSleepFail", async_syncPreAsyncSleepFail) ] + +for (asyncTopName, asyncTop) in [("asyncTop2", asyncTop2); ("asyncTop3", asyncTop3) ] do + for functionName, asyncFunction in testCasesThatRaiseExceptions do + try + asyncTop(asyncFunction) |> Async.RunSynchronously |> ignore + failwith "should have raised exception" + with e -> + let stack = e.StackTrace + test (sprintf "case %s: clncw09ew09m1" functionName) (stack.Contains(functionName)) + test (sprintf "case %s: clncw09ew09n2" functionName) (stack.Contains("asyncMid")) + test (sprintf "case %s: clncw09ew09n3" functionName) (stack.Contains(asyncTopName)) + +let aa = + if not failures.IsEmpty then + stdout.WriteLine "Test Failed" + exit 1 + else + stdout.WriteLine "Test Passed" + System.IO.File.WriteAllText("test.ok","ok") + exit 0 + diff --git a/tests/fsharp/tests.fs b/tests/fsharp/tests.fs index 15fcd5b8e65..465b71570bf 100644 --- a/tests/fsharp/tests.fs +++ b/tests/fsharp/tests.fs @@ -194,6 +194,18 @@ module CoreTests = [] let control () = singleTestBuildAndRun "core/control" FSC_BASIC + [] + let asyncStackTraces () = + let cfg = testConfig "core/asyncStackTraces" + + use testOkFile = fileguard cfg "test.ok" + + fsc cfg "%s -o:test.exe -g --tailcalls- --optimize-" cfg.fsc_flags ["test.fsx"] + + testOkFile.CheckExists() + + exec cfg ("." ++ "test.exe") "" + [] let ``control --tailcalls`` () = let cfg = testConfig "core/control" From e35a1018aa9028f58235816032479284d099271e Mon Sep 17 00:00:00 2001 From: Don Syme Date: Fri, 11 May 2018 02:03:37 +0100 Subject: [PATCH 23/39] integrate cleanup --- src/fsharp/FSharp.Core/control.fs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/fsharp/FSharp.Core/control.fs b/src/fsharp/FSharp.Core/control.fs index 55a3518ac2f..575af17e5bb 100644 --- a/src/fsharp/FSharp.Core/control.fs +++ b/src/fsharp/FSharp.Core/control.fs @@ -540,7 +540,7 @@ namespace Microsoft.FSharp.Control MakeAsync (fun ctxt -> match res with | AsyncResult.Ok r -> ctxt.cont r - | AsyncResult.Error edi -> ctxt.CallExceptionContinuation edi //ctxt.SaveExceptionContinuation(); edi.ThrowAny() + | AsyncResult.Error edi -> ctxt.CallExceptionContinuation edi | AsyncResult.Canceled oce -> ctxt.aux.ccont oce) // Generate async computation which calls its continuation with the given result @@ -634,15 +634,15 @@ namespace Microsoft.FSharp.Control let CreateSwitchToAsync (syncCtxt: SynchronizationContext) = CreateProtectedAsync (fun ctxt -> - ctxt.aux.trampolineHolder.PostWithTrampoline syncCtxt (fun () -> ctxt.cont ())) + ctxt.aux.trampolineHolder.PostWithTrampoline syncCtxt ctxt.cont) let CreateSwitchToNewThreadAsync() = CreateProtectedAsync (fun ctxt -> - ctxt.aux.trampolineHolder.StartThreadWithTrampoline (fun () -> ctxt.cont ())) + ctxt.aux.trampolineHolder.StartThreadWithTrampoline ctxt.cont) let CreateSwitchToThreadPoolAsync() = CreateProtectedAsync (fun ctxt -> - ctxt.aux.trampolineHolder.QueueWorkItemWithTrampoline (fun () -> ctxt.cont ())) + ctxt.aux.trampolineHolder.QueueWorkItemWithTrampoline ctxt.cont) let delimitSyncContext ctxt = match SynchronizationContext.Current with From f7123d6cdbc1fc4bbb26501dade92cbe7ea963f9 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Fri, 11 May 2018 02:53:11 +0100 Subject: [PATCH 24/39] fix tests --- tests/FSharp.Core.UnitTests/SurfaceArea.coreclr.fs | 5 +++-- tests/FSharp.Core.UnitTests/SurfaceArea.net40.fs | 5 +++-- tests/fsharp/tests.fs | 4 ++-- 3 files changed, 8 insertions(+), 6 deletions(-) diff --git a/tests/FSharp.Core.UnitTests/SurfaceArea.coreclr.fs b/tests/FSharp.Core.UnitTests/SurfaceArea.coreclr.fs index 655325c92d0..95b752fbf5d 100644 --- a/tests/FSharp.Core.UnitTests/SurfaceArea.coreclr.fs +++ b/tests/FSharp.Core.UnitTests/SurfaceArea.coreclr.fs @@ -577,9 +577,10 @@ Microsoft.FSharp.Control.AsyncActivation`1[T]: System.String ToString() Microsoft.FSharp.Control.AsyncActivation`1[T]: System.Type GetType() Microsoft.FSharp.Control.AsyncPrimitives: Boolean Equals(System.Object) Microsoft.FSharp.Control.AsyncPrimitives: Int32 GetHashCode() -Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.AsyncReturn Bind[T,TResult](Boolean, Microsoft.FSharp.Control.AsyncActivation`1[T], Microsoft.FSharp.Control.FSharpAsync`1[TResult], Microsoft.FSharp.Core.FSharpFunc`2[TResult,Microsoft.FSharp.Control.FSharpAsync`1[T]]) +Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.AsyncReturn Bind[T,TResult](Microsoft.FSharp.Control.AsyncActivation`1[T], Microsoft.FSharp.Control.FSharpAsync`1[TResult], Microsoft.FSharp.Core.FSharpFunc`2[TResult,Microsoft.FSharp.Control.FSharpAsync`1[T]]) Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.AsyncReturn Call[T,TResult](Microsoft.FSharp.Control.AsyncActivation`1[T], TResult, Microsoft.FSharp.Core.FSharpFunc`2[TResult,Microsoft.FSharp.Control.FSharpAsync`1[T]]) -Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.AsyncReturn TryFinally[T](Microsoft.FSharp.Control.AsyncActivation`1[T], Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit], Microsoft.FSharp.Control.FSharpAsync`1[T]) +Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.AsyncReturn TryFinally[T](Microsoft.FSharp.Control.AsyncActivation`1[T], Microsoft.FSharp.Control.FSharpAsync`1[T], Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit]) +Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.AsyncReturn TryWith[T](Microsoft.FSharp.Control.AsyncActivation`1[T], Microsoft.FSharp.Control.FSharpAsync`1[T], Microsoft.FSharp.Core.FSharpFunc`2[System.Exception,Microsoft.FSharp.Core.FSharpOption`1[Microsoft.FSharp.Control.FSharpAsync`1[T]]]) Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.FSharpAsync`1[T] MakeAsync[T](Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Control.AsyncActivation`1[T],Microsoft.FSharp.Control.AsyncReturn]) Microsoft.FSharp.Control.AsyncPrimitives: System.String ToString() Microsoft.FSharp.Control.AsyncPrimitives: System.Type GetType() diff --git a/tests/FSharp.Core.UnitTests/SurfaceArea.net40.fs b/tests/FSharp.Core.UnitTests/SurfaceArea.net40.fs index 5ed5827b6fb..3f4bc93be49 100644 --- a/tests/FSharp.Core.UnitTests/SurfaceArea.net40.fs +++ b/tests/FSharp.Core.UnitTests/SurfaceArea.net40.fs @@ -564,9 +564,10 @@ Microsoft.FSharp.Control.AsyncActivation`1[T]: System.String ToString() Microsoft.FSharp.Control.AsyncActivation`1[T]: System.Type GetType() Microsoft.FSharp.Control.AsyncPrimitives: Boolean Equals(System.Object) Microsoft.FSharp.Control.AsyncPrimitives: Int32 GetHashCode() -Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.AsyncReturn Bind[T,TResult](Boolean, Microsoft.FSharp.Control.AsyncActivation`1[T], Microsoft.FSharp.Control.FSharpAsync`1[TResult], Microsoft.FSharp.Core.FSharpFunc`2[TResult,Microsoft.FSharp.Control.FSharpAsync`1[T]]) +Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.AsyncReturn Bind[T,TResult](Microsoft.FSharp.Control.AsyncActivation`1[T], Microsoft.FSharp.Control.FSharpAsync`1[TResult], Microsoft.FSharp.Core.FSharpFunc`2[TResult,Microsoft.FSharp.Control.FSharpAsync`1[T]]) Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.AsyncReturn Call[T,TResult](Microsoft.FSharp.Control.AsyncActivation`1[T], TResult, Microsoft.FSharp.Core.FSharpFunc`2[TResult,Microsoft.FSharp.Control.FSharpAsync`1[T]]) -Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.AsyncReturn TryFinally[T](Microsoft.FSharp.Control.AsyncActivation`1[T], Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit], Microsoft.FSharp.Control.FSharpAsync`1[T]) +Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.AsyncReturn TryFinally[T](Microsoft.FSharp.Control.AsyncActivation`1[T], Microsoft.FSharp.Control.FSharpAsync`1[T], Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit]) +Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.AsyncReturn TryWith[T](Microsoft.FSharp.Control.AsyncActivation`1[T], Microsoft.FSharp.Control.FSharpAsync`1[T], Microsoft.FSharp.Core.FSharpFunc`2[System.Exception,Microsoft.FSharp.Core.FSharpOption`1[Microsoft.FSharp.Control.FSharpAsync`1[T]]]) Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.FSharpAsync`1[T] MakeAsync[T](Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Control.AsyncActivation`1[T],Microsoft.FSharp.Control.AsyncReturn]) Microsoft.FSharp.Control.AsyncPrimitives: System.String ToString() Microsoft.FSharp.Control.AsyncPrimitives: System.Type GetType() diff --git a/tests/fsharp/tests.fs b/tests/fsharp/tests.fs index 465b71570bf..1b009236ce1 100644 --- a/tests/fsharp/tests.fs +++ b/tests/fsharp/tests.fs @@ -202,10 +202,10 @@ module CoreTests = fsc cfg "%s -o:test.exe -g --tailcalls- --optimize-" cfg.fsc_flags ["test.fsx"] - testOkFile.CheckExists() - exec cfg ("." ++ "test.exe") "" + testOkFile.CheckExists() + [] let ``control --tailcalls`` () = let cfg = testConfig "core/control" From ef05de39f79eda9c15f8b8ce200531e5b28697d9 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Fri, 11 May 2018 03:37:34 +0100 Subject: [PATCH 25/39] test only runs on .net framework --- tests/fsharp/tests.fs | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/tests/fsharp/tests.fs b/tests/fsharp/tests.fs index 1b009236ce1..bddb9bbe594 100644 --- a/tests/fsharp/tests.fs +++ b/tests/fsharp/tests.fs @@ -170,9 +170,7 @@ module CoreTests = [] let ``attributes-FSI_BASIC`` () = singleTestBuildAndRun "core/attributes" FSI_BASIC -#endif -#if !FSHARP_SUITE_DRIVES_CORECLR_TESTS [] let byrefs () = @@ -189,10 +187,6 @@ module CoreTests = fsi cfg "" ["test.fsx"] testOkFile.CheckExists() -#endif - - [] - let control () = singleTestBuildAndRun "core/control" FSC_BASIC [] let asyncStackTraces () = @@ -206,6 +200,11 @@ module CoreTests = testOkFile.CheckExists() +#endif + + [] + let control () = singleTestBuildAndRun "core/control" FSC_BASIC + [] let ``control --tailcalls`` () = let cfg = testConfig "core/control" From d1a6a355b4379b63b16dc0868d7f03a6abc9e726 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Fri, 11 May 2018 13:52:34 +0100 Subject: [PATCH 26/39] slightly tweak primitives to be more suitable for later optimization --- src/fsharp/FSharp.Core/control.fs | 125 +++++++++--------- src/fsharp/FSharp.Core/control.fsi | 40 ++++-- .../SurfaceArea.coreclr.fs | 1 + .../SurfaceArea.net40.fs | 1 + 4 files changed, 93 insertions(+), 74 deletions(-) diff --git a/src/fsharp/FSharp.Core/control.fs b/src/fsharp/FSharp.Core/control.fs index 575af17e5bb..6ca57664f97 100644 --- a/src/fsharp/FSharp.Core/control.fs +++ b/src/fsharp/FSharp.Core/control.fs @@ -204,7 +204,7 @@ namespace Microsoft.FSharp.Control FakeUnit /// Save the exception continuation during propagation of an exception, or prior to raising an exception - member __.SaveExceptionContinuation (action: econt) = + member __.OnExceptionRaised (action: econt) = storedExnCont <- Some action type TrampolineHolder() as this = @@ -270,8 +270,8 @@ namespace Microsoft.FSharp.Control #endif /// Save the exception continuation during propagation of an exception, or prior to raising an exception - member __.SaveExceptionContinuation(econt) = - trampoline.SaveExceptionContinuation econt + member inline __.OnExceptionRaised(econt) = + trampoline.OnExceptionRaised econt /// Call a continuation, but first check if an async computation should trampoline on its synchronous stack. member inline __.HijackCheckThenCall (cont : 'T -> AsyncReturn) res = @@ -317,8 +317,8 @@ namespace Microsoft.FSharp.Control ctxt.aux.econt edi /// Save the exception continuation during propagation of an exception, or prior to raising an exception - member ctxt.SaveExceptionContinuation() = - ctxt.aux.trampolineHolder.SaveExceptionContinuation ctxt.aux.econt + member ctxt.OnExceptionRaised() = + ctxt.aux.trampolineHolder.OnExceptionRaised ctxt.aux.econt [] [] @@ -365,9 +365,17 @@ namespace Microsoft.FSharp.Control let mutable defaultCancellationTokenSource = new CancellationTokenSource() - /// Apply userCode to x and call either the continuation or exception continuation depending what happens + /// Primitive to invoke an async computation. + // + // Note: direct calls to this function may end up in user assemblies via inlining + [] + let Invoke (computation: Async<'T>) (ctxt: AsyncActivation<_>) : AsyncReturn = + ctxt.HijackCheckThenCall computation.Invoke ctxt + + /// Apply userCode to x. If no exception is raised then call the normal continuation. Used to implement + /// 'finally' and 'when cancelled'. [] - let ProtectUserCodePlusHijackCheck (ctxt: AsyncActivation<_>) userCode arg : AsyncReturn = + let CallThenContinue (ctxt: AsyncActivation<_>) userCode arg : AsyncReturn = let mutable result = Unchecked.defaultof<_> let mutable ok = false @@ -376,72 +384,73 @@ namespace Microsoft.FSharp.Control ok <- true finally if not ok then - ctxt.SaveExceptionContinuation() + ctxt.OnExceptionRaised() if ok then ctxt.HijackCheckThenCall ctxt.cont result else FakeUnit - /// Apply 'userCode' to 'arg' and invoke the resulting computation. + /// Apply 'part2' to 'result1' and invoke the resulting computation. + // + // Note: direct calls to this function end up in user assemblies via inlining [] - let ProtectUserCodePlusHijackCheckThenInvoke (ctxt: AsyncActivation<_>) userCode arg : AsyncReturn = + let CallThenInvoke (ctxt: AsyncActivation<_>) result1 part2 : AsyncReturn = let mutable result = Unchecked.defaultof<_> let mutable ok = false try - result <- userCode arg + result <- part2 result1 ok <- true finally if not ok then - ctxt.SaveExceptionContinuation() + ctxt.OnExceptionRaised() if ok then - ctxt.HijackCheckThenCall result.Invoke ctxt + Invoke result ctxt else FakeUnit - /// Apply 'catchFilter' to 'arg'. If the result is 'Some' invoke the resulting computation. If the result is 'None' - /// then send 'result1' to the exception continuation. + /// Like `CallThenInvoke` but does not do a hijack check for historical reasons (exact code compat) [] - let ProtectUserCodePlusHijackCheckThenTryWithFilterFunctionInvoke (ctxt: AsyncActivation<_>) catchFilter (edi: ExceptionDispatchInfo) : AsyncReturn = - let mutable resOpt = Unchecked.defaultof<_> + let CallThenInvokeNoHijackCheck (ctxt: AsyncActivation<_>) userCode result1 = + let mutable res = Unchecked.defaultof<_> let mutable ok = false try - resOpt <- catchFilter (edi.GetAssociatedSourceException()) + res <- userCode result1 ok <- true finally if not ok then - ctxt.SaveExceptionContinuation() + ctxt.OnExceptionRaised() if ok then - match resOpt with - | None -> - ctxt.HijackCheckThenCall ctxt.aux.econt edi - | Some res -> - ctxt.HijackCheckThenCall res.Invoke ctxt - else + res.Invoke ctxt + else FakeUnit - /// Apply userCode to x and invoke the resulting computation. - /// Does not do a hijack check. + /// Apply 'catchFilter' to 'arg'. If the result is 'Some' invoke the resulting computation. If the result is 'None' + /// then send 'result1' to the exception continuation. [] - let ProtectUserCodeThenInvoke (ctxt: AsyncActivation<_>) userCode result1 = - // This is deliberately written in a allocation-free style - let mutable res = Unchecked.defaultof<_> + let CallThenInvokeFilter (ctxt: AsyncActivation<_>) catchFilter (edi: ExceptionDispatchInfo) : AsyncReturn = + let mutable resOpt = Unchecked.defaultof<_> let mutable ok = false try - res <- userCode result1 + resOpt <- catchFilter (edi.GetAssociatedSourceException()) ok <- true finally if not ok then - ctxt.SaveExceptionContinuation() + ctxt.OnExceptionRaised() if ok then - res.Invoke ctxt - else FakeUnit + match resOpt with + | None -> + ctxt.HijackCheckThenCall ctxt.aux.econt edi + | Some res -> + Invoke res ctxt + else + FakeUnit /// Perform a cancellation check and ensure that any exceptions raised by /// the immediate execution of "userCode" are sent to the exception continuation. @@ -457,7 +466,7 @@ namespace Microsoft.FSharp.Control res finally if not ok then - ctxt.SaveExceptionContinuation() + ctxt.OnExceptionRaised() /// Make an initial asyc activation. [] @@ -469,25 +478,9 @@ namespace Microsoft.FSharp.Control [] // Note: direct calls to this function end up in user assemblies via inlining - let Bind (ctxt: AsyncActivation<_>) part1 part2 = - if ctxt.IsCancellationRequested then - ctxt.OnCancellation () - else - let ctxtPart1ThenPart2 = - let cont result1 = ProtectUserCodeThenInvoke ctxt part2 result1 - { cont=cont; aux = ctxt.aux } - - ctxt.HijackCheckThenCall part1.Invoke ctxtPart1ThenPart2 - - [] - /// Execute user code but first check for trampoline and cancellation. - // - // Note: direct calls to this function end up in user assemblies via inlining - let Call (ctxt: AsyncActivation<'T>) result1 (part2: 'U -> Async<'T>) = - if ctxt.IsCancellationRequested then - ctxt.OnCancellation () - else - ProtectUserCodePlusHijackCheckThenInvoke ctxt part2 result1 + let Bind (ctxt: AsyncActivation<'T>) (part2: 'U -> Async<'T>) : AsyncActivation<'U> = + let cont result1 = CallThenInvokeNoHijackCheck ctxt part2 result1 + { cont=cont; aux = ctxt.aux } /// Execute the with-filter part of a try-with-filer but first check for trampoline and cancellation. // @@ -496,7 +489,7 @@ namespace Microsoft.FSharp.Control if ctxt.IsCancellationRequested then ctxt.OnCancellation () else - ProtectUserCodePlusHijackCheckThenTryWithFilterFunctionInvoke ctxt part2 result1 + CallThenInvokeFilter ctxt part2 result1 [] let TryFinally (ctxt: AsyncActivation<'T>) computation finallyFunction = @@ -507,17 +500,17 @@ namespace Microsoft.FSharp.Control // If an exception is thrown we continue with the previous exception continuation. let cont b = let ctxt = { cont = (fun () -> ctxt.cont b); aux = ctxt.aux } - ProtectUserCodePlusHijackCheck ctxt finallyFunction () + CallThenContinue ctxt finallyFunction () // The new exception continuation runs the finallyFunction and then runs the previous exception continuation. // If an exception is thrown we continue with the previous exception continuation. let econt exn = let ctxt = { cont = (fun () -> ctxt.aux.econt exn); aux = ctxt.aux } - ProtectUserCodePlusHijackCheck ctxt finallyFunction () + CallThenContinue ctxt finallyFunction () // The cancellation continuation runs the finallyFunction and then runs the previous cancellation continuation. // If an exception is thrown we continue with the previous cancellation continuation (the exception is lost) let ccont cexn = let ctxt = { cont = (fun () -> ctxt.aux.ccont cexn); aux = { ctxt.aux with econt = (fun _ -> ctxt.aux.ccont cexn) } } - ProtectUserCodePlusHijackCheck ctxt finallyFunction () + CallThenContinue ctxt finallyFunction () computation.Invoke { ctxt with cont = cont; aux = { ctxt.aux with econt = econt; ccont = ccont } } // Re-route the exception continuation to call to catchFunction. If catchFunction or the new process fail @@ -553,17 +546,25 @@ namespace Microsoft.FSharp.Control // run 'f' with exception protection let inline CreateBindAsync part1 part2 = // Note: this code ends up in user assemblies via inlining - MakeAsync (fun ctxt -> Bind ctxt part1 part2) + MakeAsync (fun ctxt -> + if ctxt.IsCancellationRequested then + ctxt.OnCancellation () + else + Invoke part1 (Bind ctxt part2)) // Call the given function with exception protection, but first // check for cancellation. let inline CreateCallAsync part2 result1 = // Note: this code ends up in user assemblies via inlining - MakeAsync (fun ctxt -> Call ctxt result1 part2) + MakeAsync (fun ctxt -> + if ctxt.IsCancellationRequested then + ctxt.OnCancellation () + else + CallThenInvoke ctxt result1 part2) let inline CreateDelayAsync computation = // Note: this code ends up in user assemblies via inlining - MakeAsync (fun ctxt -> Call ctxt () computation) + CreateCallAsync computation () /// Implements the sequencing construct of async computation expressions let inline CreateSequentialAsync part1 part2 = @@ -593,7 +594,7 @@ namespace Microsoft.FSharp.Control let aux = ctxt.aux let ccont exn = let ctxt = { cont = (fun _ -> aux.ccont exn); aux = { aux with econt = (fun _ -> aux.ccont exn) } } - ProtectUserCodePlusHijackCheck ctxt finallyFunction exn + CallThenContinue ctxt finallyFunction exn let newCtxt = { ctxt with aux = { aux with ccont = ccont } } computation.Invoke newCtxt) diff --git a/src/fsharp/FSharp.Core/control.fsi b/src/fsharp/FSharp.Core/control.fsi index 72156b04ec5..b40f156f4c9 100644 --- a/src/fsharp/FSharp.Core/control.fsi +++ b/src/fsharp/FSharp.Core/control.fsi @@ -431,20 +431,29 @@ namespace Microsoft.FSharp.Control computation:Async<'T> * ?cancellationToken:CancellationToken-> Task<'T> - /// Opaque type for generated code + /// The F# compiler emits references to this type to implement F# async expressions. type AsyncReturn - /// Opaque type for generated code + /// The F# compiler emits references to this type to implement F# async expressions. [] type AsyncActivation<'T> = - /// Calls to this member are emitted in compiled code + /// The F# compiler emits calls to this function to implement F# async expressions. + /// + /// A value indicating asynchronous execution. member IsCancellationRequested: bool - /// Calls to this member are emitted in compiled code + /// The F# compiler emits calls to this function to implement F# async expressions. + /// + /// A value indicating asynchronous execution. member OnSuccess: 'T -> AsyncReturn - /// Calls to this member are emitted in compiled code + /// The F# compiler emits calls to this function to implement F# async expressions. + member OnExceptionRaised: unit -> unit + + /// The F# compiler emits calls to this function to implement F# async expressions. + /// + /// A value indicating asynchronous execution. member OnCancellation: unit -> AsyncReturn [] @@ -458,23 +467,30 @@ namespace Microsoft.FSharp.Control /// The async computation. val MakeAsync: body:(AsyncActivation<'T> -> AsyncReturn) -> Async<'T> + /// The F# compiler emits calls to this function to implement constructs for F# async expressions. + /// + /// The async computation. + /// The async activation. + /// + /// A value indicating asynchronous execution. + val Invoke: computation: Async<'T> -> ctxt:AsyncActivation<'T> -> AsyncReturn + /// The F# compiler emits calls to this function to implement constructs for F# async expressions. /// /// The async activation. /// The result of the first part of the computation. /// A function returning the second part of the computation. /// - /// Nothing. - val Call: ctxt:AsyncActivation<'T> -> result1:'U -> part2:('U -> Async<'T>) -> AsyncReturn + /// A value indicating asynchronous execution. + val CallThenInvoke: ctxt:AsyncActivation<'T> -> result1:'U -> part2:('U -> Async<'T>) -> AsyncReturn /// The F# compiler emits calls to this function to implement the let! construct for F# async expressions. /// /// The async activation. - /// The first part of the computation. /// A function returning the second part of the computation. /// - /// Nothing. - val Bind: ctxt:AsyncActivation<'T> -> part1:Async<'U> -> part2:('U -> Async<'T>) -> AsyncReturn + /// An async activation suitable for running part1 of the asynchronous execution. + val Bind: ctxt:AsyncActivation<'T> -> part2:('U -> Async<'T>) -> AsyncActivation<'U> /// The F# compiler emits calls to this function to implement the try/finally construct for F# async expressions. /// @@ -482,7 +498,7 @@ namespace Microsoft.FSharp.Control /// The computation to protect. /// The finally code. /// - /// Nothing. + /// A value indicating asynchronous execution. val TryFinally: ctxt:AsyncActivation<'T> -> computation: Async<'T> -> finallyFunction: (unit -> unit) -> AsyncReturn /// The F# compiler emits calls to this function to implement the try/with construct for F# async expressions. @@ -491,7 +507,7 @@ namespace Microsoft.FSharp.Control /// The computation to protect. /// The exception filter. /// - /// Nothing. + /// A value indicating asynchronous execution. val TryWith: ctxt:AsyncActivation<'T> -> computation: Async<'T> -> catchFunction: (Exception -> Async<'T> option) -> AsyncReturn [] diff --git a/tests/FSharp.Core.UnitTests/SurfaceArea.coreclr.fs b/tests/FSharp.Core.UnitTests/SurfaceArea.coreclr.fs index 95b752fbf5d..216037d6f95 100644 --- a/tests/FSharp.Core.UnitTests/SurfaceArea.coreclr.fs +++ b/tests/FSharp.Core.UnitTests/SurfaceArea.coreclr.fs @@ -572,6 +572,7 @@ Microsoft.FSharp.Control.AsyncActivation`1[T]: Boolean IsCancellationRequested Microsoft.FSharp.Control.AsyncActivation`1[T]: Boolean get_IsCancellationRequested() Microsoft.FSharp.Control.AsyncActivation`1[T]: Int32 GetHashCode() Microsoft.FSharp.Control.AsyncActivation`1[T]: Microsoft.FSharp.Control.AsyncReturn OnCancellation() +Microsoft.FSharp.Control.AsyncActivation`1[T]: Microsoft.FSharp.Control.AsyncReturn OnExceptionRaised() Microsoft.FSharp.Control.AsyncActivation`1[T]: Microsoft.FSharp.Control.AsyncReturn OnSuccess(T) Microsoft.FSharp.Control.AsyncActivation`1[T]: System.String ToString() Microsoft.FSharp.Control.AsyncActivation`1[T]: System.Type GetType() diff --git a/tests/FSharp.Core.UnitTests/SurfaceArea.net40.fs b/tests/FSharp.Core.UnitTests/SurfaceArea.net40.fs index 3f4bc93be49..6f90a950658 100644 --- a/tests/FSharp.Core.UnitTests/SurfaceArea.net40.fs +++ b/tests/FSharp.Core.UnitTests/SurfaceArea.net40.fs @@ -559,6 +559,7 @@ Microsoft.FSharp.Control.AsyncActivation`1[T]: Boolean IsCancellationRequested Microsoft.FSharp.Control.AsyncActivation`1[T]: Boolean get_IsCancellationRequested() Microsoft.FSharp.Control.AsyncActivation`1[T]: Int32 GetHashCode() Microsoft.FSharp.Control.AsyncActivation`1[T]: Microsoft.FSharp.Control.AsyncReturn OnCancellation() +Microsoft.FSharp.Control.AsyncActivation`1[T]: Microsoft.FSharp.Control.AsyncReturn OnExceptionRaised() Microsoft.FSharp.Control.AsyncActivation`1[T]: Microsoft.FSharp.Control.AsyncReturn OnSuccess(T) Microsoft.FSharp.Control.AsyncActivation`1[T]: System.String ToString() Microsoft.FSharp.Control.AsyncActivation`1[T]: System.Type GetType() From 6b2a28f67d1346740b9047aa29c17eedf59d3781 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Fri, 11 May 2018 13:55:32 +0100 Subject: [PATCH 27/39] slightly tweak primitives to be more suitable for later optimization --- src/fsharp/FSharp.Core/control.fs | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/src/fsharp/FSharp.Core/control.fs b/src/fsharp/FSharp.Core/control.fs index 6ca57664f97..d3a4a117dbb 100644 --- a/src/fsharp/FSharp.Core/control.fs +++ b/src/fsharp/FSharp.Core/control.fs @@ -452,10 +452,11 @@ namespace Microsoft.FSharp.Control else FakeUnit + /// Internal way of making an async from code, for exact code compat. /// Perform a cancellation check and ensure that any exceptions raised by /// the immediate execution of "userCode" are sent to the exception continuation. [] - let ProtectUserCode (ctxt: AsyncActivation<_>) userCode = + let ProtectedCode (ctxt: AsyncActivation<_>) userCode = if ctxt.IsCancellationRequested then ctxt.OnCancellation () else @@ -524,11 +525,13 @@ namespace Microsoft.FSharp.Control let newCtxt = { ctxt with aux = { ctxt.aux with econt = econt } } computation.Invoke newCtxt + /// Internal way of making an async from code, for exact code compat. /// When run, ensures that any exceptions raised by the immediate execution of "f" are /// sent to the exception continuation. let CreateProtectedAsync f = - MakeAsync (fun ctxt -> ProtectUserCode ctxt f) + MakeAsync (fun ctxt -> ProtectedCode ctxt f) + /// Internal way of making an async from result, for exact code compat. let CreateAsyncResultAsync res = MakeAsync (fun ctxt -> match res with @@ -1219,7 +1222,7 @@ namespace Microsoft.FSharp.Control // must not be in a 'protect' if we call cont explicitly; if cont throws, it should unwind the stack, preserving Dev10 behavior ctxt.cont [| |] else - ProtectUserCode ctxt (fun ctxt -> + ProtectedCode ctxt (fun ctxt -> let ctxtWithSync = delimitSyncContext ctxt // manually resync let aux = ctxtWithSync.aux let count = ref tasks.Length @@ -1283,7 +1286,7 @@ namespace Microsoft.FSharp.Control | Choice2Of2 edi -> ctxt.CallExceptionContinuation edi | Choice1Of2 [||] -> ctxt.cont None | Choice1Of2 computations -> - ProtectUserCode ctxt (fun ctxt -> + ProtectedCode ctxt (fun ctxt -> let ctxtWithSync = delimitSyncContext ctxt let aux = ctxtWithSync.aux let noneCount = ref 0 From e27b21d17e5a175a8203b7d1694cf300e9600581 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Fri, 11 May 2018 15:10:11 +0100 Subject: [PATCH 28/39] update baselines --- src/fsharp/FSharp.Core/control.fs | 90 ++- .../SurfaceArea.coreclr.fs | 7 +- .../SurfaceArea.net40.fs | 7 +- .../AsyncExpressionSteppingTest1.il.bsl | 12 +- .../AsyncExpressionSteppingTest2.il.bsl | 12 +- .../AsyncExpressionSteppingTest3.il.bsl | 70 +- .../AsyncExpressionSteppingTest4.il.bsl | 173 ++++- .../AsyncExpressionSteppingTest5.il.bsl | 164 ++++- .../AsyncExpressionSteppingTest6.il.bsl | 600 ++++++++++++++---- 9 files changed, 892 insertions(+), 243 deletions(-) diff --git a/src/fsharp/FSharp.Core/control.fs b/src/fsharp/FSharp.Core/control.fs index d3a4a117dbb..a6590a2bc14 100644 --- a/src/fsharp/FSharp.Core/control.fs +++ b/src/fsharp/FSharp.Core/control.fs @@ -127,7 +127,7 @@ namespace Microsoft.FSharp.Control [] type Trampoline() = - let unfake FakeUnit = () + let unfake (_ : AsyncReturn) = () [] static let bindLimitBeforeHijack = 300 @@ -186,7 +186,7 @@ namespace Microsoft.FSharp.Control finally if thisIsTopTrampoline then Trampoline.thisThreadHasTrampoline <- false - FakeUnit + Unchecked.defaultof /// Increment the counter estimating the size of the synchronous stack and /// return true if time to jump on trampoline. @@ -201,7 +201,7 @@ namespace Microsoft.FSharp.Control bindCount <- 0 storedCont <- Some action | _ -> failwith "Internal error: attempting to install continuation twice" - FakeUnit + Unchecked.defaultof /// Save the exception continuation during propagation of an exception, or prior to raising an exception member __.OnExceptionRaised (action: econt) = @@ -210,7 +210,7 @@ namespace Microsoft.FSharp.Control type TrampolineHolder() as this = let mutable trampoline = null - static let unfake FakeUnit = () + static let unfake (_: AsyncReturn) = () // Preallocate this delegate and keep it in the trampoline holder. let sendOrPostCallbackWithTrampoline = @@ -240,12 +240,12 @@ namespace Microsoft.FSharp.Control member this.PostWithTrampoline (syncCtxt: SynchronizationContext) (f : unit -> AsyncReturn) = syncCtxt.Post (sendOrPostCallbackWithTrampoline, state=(f |> box)) - FakeUnit + Unchecked.defaultof member this.QueueWorkItemWithTrampoline (f: unit -> AsyncReturn) = if not (ThreadPool.QueueUserWorkItem(waitCallbackForQueueWorkItemWithTrampoline, f |> box)) then failwith "failed to queue user work item" - FakeUnit + Unchecked.defaultof member this.PostOrQueueWithTrampoline (syncCtxt : SynchronizationContext) f = match syncCtxt with @@ -259,14 +259,14 @@ namespace Microsoft.FSharp.Control this.QueueWorkItemWithTrampoline(f) #else (new Thread((fun _ -> this.Execute f |> unfake), IsBackground=true)).Start() - FakeUnit + Unchecked.defaultof #endif #else // This should be the only call to Thread.Start in this library. We must always install a trampoline. member __.StartThreadWithTrampoline (f : unit -> AsyncReturn) = (new Thread(threadStartCallbackForStartThreadWithTrampoline,IsBackground=true)).Start(f|>box) - FakeUnit + Unchecked.defaultof #endif /// Save the exception continuation during propagation of an exception, or prior to raising an exception @@ -360,8 +360,8 @@ namespace Microsoft.FSharp.Control module AsyncPrimitives = - let fake () = FakeUnit - let unfake FakeUnit = () + let fake () = Unchecked.defaultof + let unfake (_: AsyncReturn) = () let mutable defaultCancellationTokenSource = new CancellationTokenSource() @@ -389,7 +389,7 @@ namespace Microsoft.FSharp.Control if ok then ctxt.HijackCheckThenCall ctxt.cont result else - FakeUnit + Unchecked.defaultof /// Apply 'part2' to 'result1' and invoke the resulting computation. // @@ -409,7 +409,7 @@ namespace Microsoft.FSharp.Control if ok then Invoke result ctxt else - FakeUnit + Unchecked.defaultof /// Like `CallThenInvoke` but does not do a hijack check for historical reasons (exact code compat) [] @@ -427,7 +427,7 @@ namespace Microsoft.FSharp.Control if ok then res.Invoke ctxt else - FakeUnit + Unchecked.defaultof /// Apply 'catchFilter' to 'arg'. If the result is 'Some' invoke the resulting computation. If the result is 'None' /// then send 'result1' to the exception continuation. @@ -450,7 +450,7 @@ namespace Microsoft.FSharp.Control | Some res -> Invoke res ctxt else - FakeUnit + Unchecked.defaultof /// Internal way of making an async from code, for exact code compat. /// Perform a cancellation check and ensure that any exceptions raised by @@ -780,7 +780,7 @@ namespace Microsoft.FSharp.Control // Run the action outside the lock match grabbedConts with - | [] -> FakeUnit + | [] -> Unchecked.defaultof | [cont] -> if reuseThread then cont.ContinueImmediate(res) @@ -812,7 +812,7 @@ namespace Microsoft.FSharp.Control ) match resOpt with | Some res -> ctxt.cont res - | None -> FakeUnit + | None -> Unchecked.defaultof ) member x.TryWaitForResultSynchronously (?timeout) : 'T option = @@ -941,9 +941,9 @@ namespace Microsoft.FSharp.Control let Start cancellationToken (computation:Async) = QueueAsync cancellationToken - (fun () -> FakeUnit) // nothing to do on success + (fun () -> Unchecked.defaultof) // nothing to do on success (fun edi -> edi.ThrowAny()) // raise exception in child - (fun _ -> FakeUnit) // ignore cancellation in child + (fun _ -> Unchecked.defaultof) // ignore cancellation in child computation |> unfake @@ -1164,7 +1164,7 @@ namespace Microsoft.FSharp.Control match contToTailCall with | Some k -> k() - | _ -> FakeUnit) + | _ -> Unchecked.defaultof) static member DefaultCancellationToken = defaultCancellationTokenSource.Token @@ -1240,7 +1240,7 @@ namespace Microsoft.FSharp.Control | Some (Choice1Of2 exn) -> trampolineHolder.ExecuteWithTrampoline (fun () -> aux.econt exn) | Some (Choice2Of2 cexn) -> trampolineHolder.ExecuteWithTrampoline (fun () -> aux.ccont cexn) else - FakeUnit + Unchecked.defaultof // recordSuccess and recordFailure between them decrement count to 0 and // as soon as 0 is reached dispose innerCancellationSource @@ -1274,7 +1274,7 @@ namespace Microsoft.FSharp.Control (fun cexn -> recordFailure (Choice2Of2 cexn)) p |> unfake); - FakeUnit)) + Unchecked.defaultof)) static member Choice(computations : Async<'T option> seq) : Async<'T option> = MakeAsync (fun ctxt -> @@ -1300,30 +1300,30 @@ namespace Microsoft.FSharp.Control if Interlocked.Increment exnCount = 1 then innerCts.Cancel(); trampolineHolder.ExecuteWithTrampoline (fun () -> ctxtWithSync.cont result) else - FakeUnit + Unchecked.defaultof | None -> if Interlocked.Increment noneCount = computations.Length then innerCts.Cancel(); trampolineHolder.ExecuteWithTrampoline (fun () -> ctxtWithSync.cont None) else - FakeUnit + Unchecked.defaultof let econt (exn : ExceptionDispatchInfo) = if Interlocked.Increment exnCount = 1 then innerCts.Cancel(); trampolineHolder.ExecuteWithTrampoline (fun () -> ctxtWithSync.aux.econt exn) else - FakeUnit + Unchecked.defaultof let ccont (exn : OperationCanceledException) = if Interlocked.Increment exnCount = 1 then innerCts.Cancel(); trampolineHolder.ExecuteWithTrampoline (fun () -> ctxtWithSync.aux.ccont exn) else - FakeUnit + Unchecked.defaultof for c in computations do QueueAsync innerCts.Token scont econt ccont c |> unfake - FakeUnit)) + Unchecked.defaultof)) type Async with @@ -1393,7 +1393,7 @@ namespace Microsoft.FSharp.Control match edi with | null -> - FakeUnit + Unchecked.defaultof | _ -> aux.econt edi ) @@ -1445,13 +1445,13 @@ namespace Microsoft.FSharp.Control state=null, millisecondsTimeOutInterval=millisecondsTimeout, executeOnlyOnce=true)); - FakeUnit) + Unchecked.defaultof) with _ -> if latch.Enter() then registration.Dispose() reraise() // reraise exception only if we successfully enter the latch (no other continuations were called) else - FakeUnit + Unchecked.defaultof ) static member AwaitIAsyncResult(iar: IAsyncResult, ?millisecondsTimeout): Async = @@ -1844,21 +1844,19 @@ namespace Microsoft.FSharp.Control return! CreateAsyncResultAsync result } - let timeout msec cancellationToken = - if msec < 0 then - MakeAsync (fun _ -> FakeUnit) // "block" forever - else - let resultCell = new ResultCell<_>() - Async.StartWithContinuations( - computation=Async.Sleep(msec), - continuation=(fun () -> resultCell.RegisterResult((), reuseThread = false) |> unfake), - exceptionContinuation=ignore, - cancellationContinuation=ignore, - cancellationToken = cancellationToken) - // Note: It is ok to use "NoDirectCancel" here because the started computations use the same - // cancellation token and will register a cancelled result if cancellation occurs. - // Note: It is ok to use "NoDirectTimeout" here because the child compuation above looks after the timeout. - resultCell.AwaitResult_NoDirectCancelOrTimeout + let timeoutAsync msec cancellationToken = + assert (msec >= 0) + let resultCell = new ResultCell<_>() + Async.StartWithContinuations( + computation=Async.Sleep(msec), + continuation=(fun () -> resultCell.RegisterResult((), reuseThread = false) |> unfake), + exceptionContinuation=ignore, + cancellationContinuation=ignore, + cancellationToken = cancellationToken) + // Note: It is ok to use "NoDirectCancel" here because the started computations use the same + // cancellation token and will register a cancelled result if cancellation occurs. + // Note: It is ok to use "NoDirectTimeout" here because the child compuation above looks after the timeout. + resultCell.AwaitResult_NoDirectCancelOrTimeout [] [] @@ -1899,7 +1897,7 @@ namespace Microsoft.FSharp.Control else false) if descheduled then - FakeUnit + Unchecked.defaultof else // If we didn't deschedule then run the continuation immediately ctxt.cont true @@ -2048,7 +2046,7 @@ namespace Microsoft.FSharp.Control | None -> let! cancellationToken = Async.CancellationToken let timeoutCts = CancellationTokenSource.CreateLinkedTokenSource(cancellationToken, CancellationToken.None) - let timeoutAsync = AsyncHelpers.timeout timeout timeoutCts.Token + let timeoutAsync = AsyncHelpers.timeoutAsync timeout timeoutCts.Token return! scan timeoutAsync timeoutCts | Some resP -> let! res = resP diff --git a/tests/FSharp.Core.UnitTests/SurfaceArea.coreclr.fs b/tests/FSharp.Core.UnitTests/SurfaceArea.coreclr.fs index 216037d6f95..56e4f998248 100644 --- a/tests/FSharp.Core.UnitTests/SurfaceArea.coreclr.fs +++ b/tests/FSharp.Core.UnitTests/SurfaceArea.coreclr.fs @@ -572,14 +572,15 @@ Microsoft.FSharp.Control.AsyncActivation`1[T]: Boolean IsCancellationRequested Microsoft.FSharp.Control.AsyncActivation`1[T]: Boolean get_IsCancellationRequested() Microsoft.FSharp.Control.AsyncActivation`1[T]: Int32 GetHashCode() Microsoft.FSharp.Control.AsyncActivation`1[T]: Microsoft.FSharp.Control.AsyncReturn OnCancellation() -Microsoft.FSharp.Control.AsyncActivation`1[T]: Microsoft.FSharp.Control.AsyncReturn OnExceptionRaised() +Microsoft.FSharp.Control.AsyncActivation`1[T]: Void OnExceptionRaised() Microsoft.FSharp.Control.AsyncActivation`1[T]: Microsoft.FSharp.Control.AsyncReturn OnSuccess(T) Microsoft.FSharp.Control.AsyncActivation`1[T]: System.String ToString() Microsoft.FSharp.Control.AsyncActivation`1[T]: System.Type GetType() Microsoft.FSharp.Control.AsyncPrimitives: Boolean Equals(System.Object) Microsoft.FSharp.Control.AsyncPrimitives: Int32 GetHashCode() -Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.AsyncReturn Bind[T,TResult](Microsoft.FSharp.Control.AsyncActivation`1[T], Microsoft.FSharp.Control.FSharpAsync`1[TResult], Microsoft.FSharp.Core.FSharpFunc`2[TResult,Microsoft.FSharp.Control.FSharpAsync`1[T]]) -Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.AsyncReturn Call[T,TResult](Microsoft.FSharp.Control.AsyncActivation`1[T], TResult, Microsoft.FSharp.Core.FSharpFunc`2[TResult,Microsoft.FSharp.Control.FSharpAsync`1[T]]) +Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.AsyncActivation`1[TResult] Bind[T,TResult](Microsoft.FSharp.Control.AsyncActivation`1[T], Microsoft.FSharp.Core.FSharpFunc`2[TResult,Microsoft.FSharp.Control.FSharpAsync`1[T]]) +Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.AsyncReturn CallThenInvoke[T,TResult](Microsoft.FSharp.Control.AsyncActivation`1[T], TResult, Microsoft.FSharp.Core.FSharpFunc`2[TResult,Microsoft.FSharp.Control.FSharpAsync`1[T]]) +Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.AsyncReturn Invoke[T](Microsoft.FSharp.Control.FSharpAsync`1[T], Microsoft.FSharp.Control.AsyncActivation`1[T]) Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.AsyncReturn TryFinally[T](Microsoft.FSharp.Control.AsyncActivation`1[T], Microsoft.FSharp.Control.FSharpAsync`1[T], Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit]) Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.AsyncReturn TryWith[T](Microsoft.FSharp.Control.AsyncActivation`1[T], Microsoft.FSharp.Control.FSharpAsync`1[T], Microsoft.FSharp.Core.FSharpFunc`2[System.Exception,Microsoft.FSharp.Core.FSharpOption`1[Microsoft.FSharp.Control.FSharpAsync`1[T]]]) Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.FSharpAsync`1[T] MakeAsync[T](Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Control.AsyncActivation`1[T],Microsoft.FSharp.Control.AsyncReturn]) diff --git a/tests/FSharp.Core.UnitTests/SurfaceArea.net40.fs b/tests/FSharp.Core.UnitTests/SurfaceArea.net40.fs index 6f90a950658..09731fb3267 100644 --- a/tests/FSharp.Core.UnitTests/SurfaceArea.net40.fs +++ b/tests/FSharp.Core.UnitTests/SurfaceArea.net40.fs @@ -559,14 +559,15 @@ Microsoft.FSharp.Control.AsyncActivation`1[T]: Boolean IsCancellationRequested Microsoft.FSharp.Control.AsyncActivation`1[T]: Boolean get_IsCancellationRequested() Microsoft.FSharp.Control.AsyncActivation`1[T]: Int32 GetHashCode() Microsoft.FSharp.Control.AsyncActivation`1[T]: Microsoft.FSharp.Control.AsyncReturn OnCancellation() -Microsoft.FSharp.Control.AsyncActivation`1[T]: Microsoft.FSharp.Control.AsyncReturn OnExceptionRaised() +Microsoft.FSharp.Control.AsyncActivation`1[T]: Void OnExceptionRaised() Microsoft.FSharp.Control.AsyncActivation`1[T]: Microsoft.FSharp.Control.AsyncReturn OnSuccess(T) Microsoft.FSharp.Control.AsyncActivation`1[T]: System.String ToString() Microsoft.FSharp.Control.AsyncActivation`1[T]: System.Type GetType() Microsoft.FSharp.Control.AsyncPrimitives: Boolean Equals(System.Object) Microsoft.FSharp.Control.AsyncPrimitives: Int32 GetHashCode() -Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.AsyncReturn Bind[T,TResult](Microsoft.FSharp.Control.AsyncActivation`1[T], Microsoft.FSharp.Control.FSharpAsync`1[TResult], Microsoft.FSharp.Core.FSharpFunc`2[TResult,Microsoft.FSharp.Control.FSharpAsync`1[T]]) -Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.AsyncReturn Call[T,TResult](Microsoft.FSharp.Control.AsyncActivation`1[T], TResult, Microsoft.FSharp.Core.FSharpFunc`2[TResult,Microsoft.FSharp.Control.FSharpAsync`1[T]]) +Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.AsyncActivation`1[TResult] Bind[T,TResult](Microsoft.FSharp.Control.AsyncActivation`1[T], Microsoft.FSharp.Core.FSharpFunc`2[TResult,Microsoft.FSharp.Control.FSharpAsync`1[T]]) +Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.AsyncReturn CallThenInvoke[T,TResult](Microsoft.FSharp.Control.AsyncActivation`1[T], TResult, Microsoft.FSharp.Core.FSharpFunc`2[TResult,Microsoft.FSharp.Control.FSharpAsync`1[T]]) +Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.AsyncReturn Invoke[T](Microsoft.FSharp.Control.FSharpAsync`1[T], Microsoft.FSharp.Control.AsyncActivation`1[T]) Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.AsyncReturn TryFinally[T](Microsoft.FSharp.Control.AsyncActivation`1[T], Microsoft.FSharp.Control.FSharpAsync`1[T], Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit]) Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.AsyncReturn TryWith[T](Microsoft.FSharp.Control.AsyncActivation`1[T], Microsoft.FSharp.Control.FSharpAsync`1[T], Microsoft.FSharp.Core.FSharpFunc`2[System.Exception,Microsoft.FSharp.Core.FSharpOption`1[Microsoft.FSharp.Control.FSharpAsync`1[T]]]) Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.FSharpAsync`1[T] MakeAsync[T](Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Control.AsyncActivation`1[T],Microsoft.FSharp.Control.AsyncReturn]) diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/AsyncExpressionStepping/AsyncExpressionSteppingTest1.il.bsl b/tests/fsharpqa/Source/CodeGen/EmittedIL/AsyncExpressionStepping/AsyncExpressionSteppingTest1.il.bsl index ec794be06a1..574b6e6b939 100644 --- a/tests/fsharpqa/Source/CodeGen/EmittedIL/AsyncExpressionStepping/AsyncExpressionSteppingTest1.il.bsl +++ b/tests/fsharpqa/Source/CodeGen/EmittedIL/AsyncExpressionStepping/AsyncExpressionSteppingTest1.il.bsl @@ -13,7 +13,7 @@ .assembly extern FSharp.Core { .publickeytoken = (B0 3F 5F 7F 11 D5 0A 3A ) // .?_....: - .ver 4:4:1:0 + .ver 4:4:3:0 } .assembly AsyncExpressionSteppingTest1 { @@ -29,20 +29,20 @@ } .mresource public FSharpSignatureData.AsyncExpressionSteppingTest1 { - // Offset: 0x00000000 Length: 0x0000024A + // Offset: 0x00000000 Length: 0x0000026C } .mresource public FSharpOptimizationData.AsyncExpressionSteppingTest1 { - // Offset: 0x00000250 Length: 0x000000B1 + // Offset: 0x00000270 Length: 0x000000B1 } .module AsyncExpressionSteppingTest1.dll -// MVID: {5A1F62A7-6394-B5D4-A745-0383A7621F5A} +// MVID: {5AF59393-6394-B5D4-A745-03839393F55A} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x05190000 +// Image base: 0x05030000 // =============== CLASS MEMBERS DECLARATION =================== @@ -83,7 +83,7 @@ // Code size 62 (0x3e) .maxstack 8 .language '{AB4F38C9-B6E6-43BA-BE3B-58080B2CCCE3}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}' - .line 6,6 : 17,32 'C:\\visualfsharp\\tests\\fsharpqa\\Source\\CodeGen\\EmittedIL\\AsyncExpressionStepping\\AsyncExpressionSteppingTest1.fs' + .line 6,6 : 17,32 'C:\\GitHub\\dsyme\\visualfsharp\\tests\\fsharpqa\\Source\\CodeGen\\EmittedIL\\AsyncExpressionStepping\\AsyncExpressionSteppingTest1.fs' IL_0000: ldstr "hello" IL_0005: newobj instance void class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`5::.ctor(string) IL_000a: call !!0 [FSharp.Core]Microsoft.FSharp.Core.ExtraTopLevelOperators::PrintFormatLine(class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`4) diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/AsyncExpressionStepping/AsyncExpressionSteppingTest2.il.bsl b/tests/fsharpqa/Source/CodeGen/EmittedIL/AsyncExpressionStepping/AsyncExpressionSteppingTest2.il.bsl index 6a87f0671a8..aba8526ee98 100644 --- a/tests/fsharpqa/Source/CodeGen/EmittedIL/AsyncExpressionStepping/AsyncExpressionSteppingTest2.il.bsl +++ b/tests/fsharpqa/Source/CodeGen/EmittedIL/AsyncExpressionStepping/AsyncExpressionSteppingTest2.il.bsl @@ -13,7 +13,7 @@ .assembly extern FSharp.Core { .publickeytoken = (B0 3F 5F 7F 11 D5 0A 3A ) // .?_....: - .ver 4:4:1:0 + .ver 4:4:3:0 } .assembly AsyncExpressionSteppingTest2 { @@ -29,20 +29,20 @@ } .mresource public FSharpSignatureData.AsyncExpressionSteppingTest2 { - // Offset: 0x00000000 Length: 0x0000024A + // Offset: 0x00000000 Length: 0x0000026C } .mresource public FSharpOptimizationData.AsyncExpressionSteppingTest2 { - // Offset: 0x00000250 Length: 0x000000B1 + // Offset: 0x00000270 Length: 0x000000B1 } .module AsyncExpressionSteppingTest2.dll -// MVID: {5A1F62A7-6394-D499-A745-0383A7621F5A} +// MVID: {5AF59393-6394-D499-A745-03839393F55A} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x00F10000 +// Image base: 0x04A80000 // =============== CLASS MEMBERS DECLARATION =================== @@ -80,7 +80,7 @@ // Code size 15 (0xf) .maxstack 8 .language '{AB4F38C9-B6E6-43BA-BE3B-58080B2CCCE3}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}' - .line 6,6 : 23,29 'C:\\visualfsharp\\tests\\fsharpqa\\Source\\CodeGen\\EmittedIL\\AsyncExpressionStepping\\AsyncExpressionSteppingTest2.fs' + .line 6,6 : 23,29 'C:\\GitHub\\dsyme\\visualfsharp\\tests\\fsharpqa\\Source\\CodeGen\\EmittedIL\\AsyncExpressionStepping\\AsyncExpressionSteppingTest2.fs' IL_0000: ldarg.0 IL_0001: ldfld class [FSharp.Core]Microsoft.FSharp.Core.FSharpRef`1 AsyncExpressionSteppingTest2/AsyncExpressionSteppingTest2/'f2@6-1'::x IL_0006: call !!0 [FSharp.Core]Microsoft.FSharp.Core.Operators::op_Dereference(class [FSharp.Core]Microsoft.FSharp.Core.FSharpRef`1) diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/AsyncExpressionStepping/AsyncExpressionSteppingTest3.il.bsl b/tests/fsharpqa/Source/CodeGen/EmittedIL/AsyncExpressionStepping/AsyncExpressionSteppingTest3.il.bsl index 83b7070f112..ae5efc2bbfd 100644 --- a/tests/fsharpqa/Source/CodeGen/EmittedIL/AsyncExpressionStepping/AsyncExpressionSteppingTest3.il.bsl +++ b/tests/fsharpqa/Source/CodeGen/EmittedIL/AsyncExpressionStepping/AsyncExpressionSteppingTest3.il.bsl @@ -13,7 +13,7 @@ .assembly extern FSharp.Core { .publickeytoken = (B0 3F 5F 7F 11 D5 0A 3A ) // .?_....: - .ver 4:4:1:0 + .ver 4:4:3:0 } .assembly AsyncExpressionSteppingTest3 { @@ -29,20 +29,20 @@ } .mresource public FSharpSignatureData.AsyncExpressionSteppingTest3 { - // Offset: 0x00000000 Length: 0x00000255 + // Offset: 0x00000000 Length: 0x00000277 } .mresource public FSharpOptimizationData.AsyncExpressionSteppingTest3 { - // Offset: 0x00000260 Length: 0x000000B1 + // Offset: 0x00000280 Length: 0x000000B1 } .module AsyncExpressionSteppingTest3.dll -// MVID: {5A1F62A7-6394-F35E-A745-0383A7621F5A} +// MVID: {5AF59393-6394-F35E-A745-03839393F55A} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x01210000 +// Image base: 0x031B0000 // =============== CLASS MEMBERS DECLARATION =================== @@ -55,6 +55,45 @@ extends [mscorlib]System.Object { .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 07 00 00 00 00 00 ) + .class auto ansi serializable sealed nested assembly beforefieldinit 'f3@10-1' + extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn> + { + .field public int32 'value' + .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + .method assembly specialname rtspecialname + instance void .ctor(int32 'value') cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 14 (0xe) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: call instance void class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>::.ctor() + IL_0006: ldarg.0 + IL_0007: ldarg.1 + IL_0008: stfld int32 AsyncExpressionSteppingTest3/AsyncExpressionSteppingTest3/'f3@10-1'::'value' + IL_000d: ret + } // end of method 'f3@10-1'::.ctor + + .method public strict virtual instance class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn + Invoke(class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1 ctxt) cil managed + { + // Code size 15 (0xf) + .maxstack 8 + .language '{AB4F38C9-B6E6-43BA-BE3B-58080B2CCCE3}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}' + .line 10,10 : 17,25 'C:\\GitHub\\dsyme\\visualfsharp\\tests\\fsharpqa\\Source\\CodeGen\\EmittedIL\\AsyncExpressionStepping\\AsyncExpressionSteppingTest3.fs' + IL_0000: ldarg.1 + IL_0001: ldarg.0 + IL_0002: ldfld int32 AsyncExpressionSteppingTest3/AsyncExpressionSteppingTest3/'f3@10-1'::'value' + IL_0007: tail. + IL_0009: callvirt instance class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1::OnSuccess(!0) + IL_000e: ret + } // end of method 'f3@10-1'::Invoke + + } // end of class 'f3@10-1' + .class auto ansi serializable sealed nested assembly beforefieldinit f3@5 extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2> { @@ -80,13 +119,14 @@ .method public strict virtual instance class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 Invoke(class [FSharp.Core]Microsoft.FSharp.Core.Unit unitVar) cil managed { - // Code size 57 (0x39) + // Code size 67 (0x43) .maxstack 6 .locals init ([0] class [FSharp.Core]Microsoft.FSharp.Core.FSharpRef`1 x, [1] class [FSharp.Core]Microsoft.FSharp.Core.FSharpRef`1 y, - [2] int32 z) - .language '{AB4F38C9-B6E6-43BA-BE3B-58080B2CCCE3}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}' - .line 5,5 : 17,30 'C:\\visualfsharp\\tests\\fsharpqa\\Source\\CodeGen\\EmittedIL\\AsyncExpressionStepping\\AsyncExpressionSteppingTest3.fs' + [2] int32 z, + [3] class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder V_3, + [4] int32 V_4) + .line 5,5 : 17,30 '' IL_0000: ldc.i4.0 IL_0001: call class [FSharp.Core]Microsoft.FSharp.Core.FSharpRef`1 [FSharp.Core]Microsoft.FSharp.Core.Operators::Ref(!!0) IL_0006: stloc.0 @@ -112,10 +152,14 @@ .line 10,10 : 17,25 '' IL_002a: ldarg.0 IL_002b: ldfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder AsyncExpressionSteppingTest3/AsyncExpressionSteppingTest3/f3@5::builder@ - IL_0030: ldloc.2 - IL_0031: tail. - IL_0033: callvirt instance class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder::Return(!!0) - IL_0038: ret + IL_0030: stloc.3 + IL_0031: ldloc.2 + IL_0032: stloc.s V_4 + IL_0034: ldloc.s V_4 + IL_0036: newobj instance void AsyncExpressionSteppingTest3/AsyncExpressionSteppingTest3/'f3@10-1'::.ctor(int32) + IL_003b: tail. + IL_003d: call class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::MakeAsync(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>) + IL_0042: ret } // end of method f3@5::Invoke } // end of class f3@5 diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/AsyncExpressionStepping/AsyncExpressionSteppingTest4.il.bsl b/tests/fsharpqa/Source/CodeGen/EmittedIL/AsyncExpressionStepping/AsyncExpressionSteppingTest4.il.bsl index 02e29ae2280..3c27376ba30 100644 --- a/tests/fsharpqa/Source/CodeGen/EmittedIL/AsyncExpressionStepping/AsyncExpressionSteppingTest4.il.bsl +++ b/tests/fsharpqa/Source/CodeGen/EmittedIL/AsyncExpressionStepping/AsyncExpressionSteppingTest4.il.bsl @@ -13,7 +13,7 @@ .assembly extern FSharp.Core { .publickeytoken = (B0 3F 5F 7F 11 D5 0A 3A ) // .?_....: - .ver 4:4:1:0 + .ver 4:4:3:0 } .assembly AsyncExpressionSteppingTest4 { @@ -29,20 +29,20 @@ } .mresource public FSharpSignatureData.AsyncExpressionSteppingTest4 { - // Offset: 0x00000000 Length: 0x00000255 + // Offset: 0x00000000 Length: 0x00000277 } .mresource public FSharpOptimizationData.AsyncExpressionSteppingTest4 { - // Offset: 0x00000260 Length: 0x000000B1 + // Offset: 0x00000280 Length: 0x000000B1 } .module AsyncExpressionSteppingTest4.dll -// MVID: {5A1F62A7-6394-6D4B-A745-0383A7621F5A} +// MVID: {5AF59393-6394-6D4B-A745-03839393F55A} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x038C0000 +// Image base: 0x03370000 // =============== CLASS MEMBERS DECLARATION =================== @@ -55,6 +55,45 @@ extends [mscorlib]System.Object { .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 07 00 00 00 00 00 ) + .class auto ansi serializable sealed nested assembly beforefieldinit 'f4@10-2' + extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn> + { + .field public int32 'value' + .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + .method assembly specialname rtspecialname + instance void .ctor(int32 'value') cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 14 (0xe) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: call instance void class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>::.ctor() + IL_0006: ldarg.0 + IL_0007: ldarg.1 + IL_0008: stfld int32 AsyncExpressionSteppingTest4/AsyncExpressionSteppingTest4/'f4@10-2'::'value' + IL_000d: ret + } // end of method 'f4@10-2'::.ctor + + .method public strict virtual instance class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn + Invoke(class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1 ctxt) cil managed + { + // Code size 15 (0xf) + .maxstack 8 + .language '{AB4F38C9-B6E6-43BA-BE3B-58080B2CCCE3}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}' + .line 10,10 : 21,29 'C:\\GitHub\\dsyme\\visualfsharp\\tests\\fsharpqa\\Source\\CodeGen\\EmittedIL\\AsyncExpressionStepping\\AsyncExpressionSteppingTest4.fs' + IL_0000: ldarg.1 + IL_0001: ldarg.0 + IL_0002: ldfld int32 AsyncExpressionSteppingTest4/AsyncExpressionSteppingTest4/'f4@10-2'::'value' + IL_0007: tail. + IL_0009: callvirt instance class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1::OnSuccess(!0) + IL_000e: ret + } // end of method 'f4@10-2'::Invoke + + } // end of class 'f4@10-2' + .class auto ansi serializable sealed nested assembly beforefieldinit 'f4@7-1' extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2> { @@ -85,12 +124,13 @@ .method public strict virtual instance class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 Invoke(class [FSharp.Core]Microsoft.FSharp.Core.Unit unitVar) cil managed { - // Code size 48 (0x30) + // Code size 56 (0x38) .maxstack 6 .locals init ([0] class [FSharp.Core]Microsoft.FSharp.Core.FSharpRef`1 y, - [1] int32 z) - .language '{AB4F38C9-B6E6-43BA-BE3B-58080B2CCCE3}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}' - .line 7,7 : 21,34 'C:\\visualfsharp\\tests\\fsharpqa\\Source\\CodeGen\\EmittedIL\\AsyncExpressionStepping\\AsyncExpressionSteppingTest4.fs' + [1] int32 z, + [2] class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder V_2, + [3] int32 V_3) + .line 7,7 : 21,34 '' IL_0000: ldc.i4.0 IL_0001: call class [FSharp.Core]Microsoft.FSharp.Core.FSharpRef`1 [FSharp.Core]Microsoft.FSharp.Core.Operators::Ref(!!0) IL_0006: stloc.0 @@ -109,15 +149,19 @@ .line 10,10 : 21,29 '' IL_0021: ldarg.0 IL_0022: ldfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder AsyncExpressionSteppingTest4/AsyncExpressionSteppingTest4/'f4@7-1'::builder@ - IL_0027: ldloc.1 - IL_0028: tail. - IL_002a: callvirt instance class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder::Return(!!0) - IL_002f: ret + IL_0027: stloc.2 + IL_0028: ldloc.1 + IL_0029: stloc.3 + IL_002a: ldloc.3 + IL_002b: newobj instance void AsyncExpressionSteppingTest4/AsyncExpressionSteppingTest4/'f4@10-2'::.ctor(int32) + IL_0030: tail. + IL_0032: call class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::MakeAsync(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>) + IL_0037: ret } // end of method 'f4@7-1'::Invoke } // end of class 'f4@7-1' - .class auto ansi serializable sealed nested assembly beforefieldinit 'f4@12-2' + .class auto ansi serializable sealed nested assembly beforefieldinit 'f4@12-3' extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2 { .field public class [FSharp.Core]Microsoft.FSharp.Core.FSharpRef`1 x @@ -132,9 +176,9 @@ IL_0001: call instance void class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::.ctor() IL_0006: ldarg.0 IL_0007: ldarg.1 - IL_0008: stfld class [FSharp.Core]Microsoft.FSharp.Core.FSharpRef`1 AsyncExpressionSteppingTest4/AsyncExpressionSteppingTest4/'f4@12-2'::x + IL_0008: stfld class [FSharp.Core]Microsoft.FSharp.Core.FSharpRef`1 AsyncExpressionSteppingTest4/AsyncExpressionSteppingTest4/'f4@12-3'::x IL_000d: ret - } // end of method 'f4@12-2'::.ctor + } // end of method 'f4@12-3'::.ctor .method public strict virtual instance class [FSharp.Core]Microsoft.FSharp.Core.Unit Invoke(class [FSharp.Core]Microsoft.FSharp.Core.Unit unitVar) cil managed @@ -143,7 +187,7 @@ .maxstack 8 .line 12,12 : 20,26 '' IL_0000: ldarg.0 - IL_0001: ldfld class [FSharp.Core]Microsoft.FSharp.Core.FSharpRef`1 AsyncExpressionSteppingTest4/AsyncExpressionSteppingTest4/'f4@12-2'::x + IL_0001: ldfld class [FSharp.Core]Microsoft.FSharp.Core.FSharpRef`1 AsyncExpressionSteppingTest4/AsyncExpressionSteppingTest4/'f4@12-3'::x IL_0006: call void [FSharp.Core]Microsoft.FSharp.Core.Operators::Increment(class [FSharp.Core]Microsoft.FSharp.Core.FSharpRef`1) IL_000b: nop .line 13,13 : 20,34 '' @@ -152,9 +196,59 @@ IL_0016: tail. IL_0018: call !!0 [FSharp.Core]Microsoft.FSharp.Core.ExtraTopLevelOperators::PrintFormatLine(class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`4) IL_001d: ret - } // end of method 'f4@12-2'::Invoke + } // end of method 'f4@12-3'::Invoke - } // end of class 'f4@12-2' + } // end of class 'f4@12-3' + + .class auto ansi serializable sealed nested assembly beforefieldinit 'f4@6-4' + extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn> + { + .field public class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 computation + .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + .field public class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2 compensation + .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + .method assembly specialname rtspecialname + instance void .ctor(class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 computation, + class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2 compensation) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 21 (0x15) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: call instance void class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>::.ctor() + IL_0006: ldarg.0 + IL_0007: ldarg.1 + IL_0008: stfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 AsyncExpressionSteppingTest4/AsyncExpressionSteppingTest4/'f4@6-4'::computation + IL_000d: ldarg.0 + IL_000e: ldarg.2 + IL_000f: stfld class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2 AsyncExpressionSteppingTest4/AsyncExpressionSteppingTest4/'f4@6-4'::compensation + IL_0014: ret + } // end of method 'f4@6-4'::.ctor + + .method public strict virtual instance class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn + Invoke(class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1 ctxt) cil managed + { + // Code size 21 (0x15) + .maxstack 8 + .line 6,6 : 17,20 '' + IL_0000: ldarg.1 + IL_0001: ldarg.0 + IL_0002: ldfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 AsyncExpressionSteppingTest4/AsyncExpressionSteppingTest4/'f4@6-4'::computation + IL_0007: ldarg.0 + IL_0008: ldfld class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2 AsyncExpressionSteppingTest4/AsyncExpressionSteppingTest4/'f4@6-4'::compensation + IL_000d: tail. + IL_000f: call class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::TryFinally(class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1, + class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1, + class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2) + IL_0014: ret + } // end of method 'f4@6-4'::Invoke + + } // end of class 'f4@6-4' .class auto ansi serializable sealed nested assembly beforefieldinit f4@5 extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2> @@ -181,9 +275,12 @@ .method public strict virtual instance class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 Invoke(class [FSharp.Core]Microsoft.FSharp.Core.Unit unitVar) cil managed { - // Code size 50 (0x32) - .maxstack 8 - .locals init ([0] class [FSharp.Core]Microsoft.FSharp.Core.FSharpRef`1 x) + // Code size 60 (0x3c) + .maxstack 7 + .locals init ([0] class [FSharp.Core]Microsoft.FSharp.Core.FSharpRef`1 x, + [1] class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder V_1, + [2] class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 V_2, + [3] class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2 V_3) .line 5,5 : 17,30 '' IL_0000: ldc.i4.0 IL_0001: call class [FSharp.Core]Microsoft.FSharp.Core.FSharpRef`1 [FSharp.Core]Microsoft.FSharp.Core.Operators::Ref(!!0) @@ -191,20 +288,26 @@ .line 6,6 : 17,20 '' IL_0007: ldarg.0 IL_0008: ldfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder AsyncExpressionSteppingTest4/AsyncExpressionSteppingTest4/f4@5::builder@ - IL_000d: ldarg.0 - IL_000e: ldfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder AsyncExpressionSteppingTest4/AsyncExpressionSteppingTest4/f4@5::builder@ - IL_0013: ldarg.0 - IL_0014: ldfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder AsyncExpressionSteppingTest4/AsyncExpressionSteppingTest4/f4@5::builder@ - IL_0019: ldloc.0 - IL_001a: newobj instance void AsyncExpressionSteppingTest4/AsyncExpressionSteppingTest4/'f4@7-1'::.ctor(class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder, + IL_000d: stloc.1 + IL_000e: ldarg.0 + IL_000f: ldfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder AsyncExpressionSteppingTest4/AsyncExpressionSteppingTest4/f4@5::builder@ + IL_0014: ldarg.0 + IL_0015: ldfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder AsyncExpressionSteppingTest4/AsyncExpressionSteppingTest4/f4@5::builder@ + IL_001a: ldloc.0 + IL_001b: newobj instance void AsyncExpressionSteppingTest4/AsyncExpressionSteppingTest4/'f4@7-1'::.ctor(class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder, class [FSharp.Core]Microsoft.FSharp.Core.FSharpRef`1) - IL_001f: callvirt instance class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder::Delay(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>) - IL_0024: ldloc.0 - IL_0025: newobj instance void AsyncExpressionSteppingTest4/AsyncExpressionSteppingTest4/'f4@12-2'::.ctor(class [FSharp.Core]Microsoft.FSharp.Core.FSharpRef`1) - IL_002a: tail. - IL_002c: callvirt instance class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder::TryFinally(class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1, - class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2) - IL_0031: ret + IL_0020: callvirt instance class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder::Delay(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>) + IL_0025: stloc.2 + IL_0026: ldloc.0 + IL_0027: newobj instance void AsyncExpressionSteppingTest4/AsyncExpressionSteppingTest4/'f4@12-3'::.ctor(class [FSharp.Core]Microsoft.FSharp.Core.FSharpRef`1) + IL_002c: stloc.3 + IL_002d: ldloc.2 + IL_002e: ldloc.3 + IL_002f: newobj instance void AsyncExpressionSteppingTest4/AsyncExpressionSteppingTest4/'f4@6-4'::.ctor(class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1, + class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2) + IL_0034: tail. + IL_0036: call class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::MakeAsync(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>) + IL_003b: ret } // end of method f4@5::Invoke } // end of class f4@5 diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/AsyncExpressionStepping/AsyncExpressionSteppingTest5.il.bsl b/tests/fsharpqa/Source/CodeGen/EmittedIL/AsyncExpressionStepping/AsyncExpressionSteppingTest5.il.bsl index 50407f757c2..39045c913f8 100644 --- a/tests/fsharpqa/Source/CodeGen/EmittedIL/AsyncExpressionStepping/AsyncExpressionSteppingTest5.il.bsl +++ b/tests/fsharpqa/Source/CodeGen/EmittedIL/AsyncExpressionStepping/AsyncExpressionSteppingTest5.il.bsl @@ -13,7 +13,7 @@ .assembly extern FSharp.Core { .publickeytoken = (B0 3F 5F 7F 11 D5 0A 3A ) // .?_....: - .ver 4:4:1:0 + .ver 4:4:3:0 } .assembly AsyncExpressionSteppingTest5 { @@ -29,20 +29,20 @@ } .mresource public FSharpSignatureData.AsyncExpressionSteppingTest5 { - // Offset: 0x00000000 Length: 0x00000296 + // Offset: 0x00000000 Length: 0x000002B8 } .mresource public FSharpOptimizationData.AsyncExpressionSteppingTest5 { - // Offset: 0x000002A0 Length: 0x000000BE + // Offset: 0x000002C0 Length: 0x000000BE } .module AsyncExpressionSteppingTest5.dll -// MVID: {5A1F62A7-6394-30E8-A745-0383A7621F5A} +// MVID: {5AF59393-6394-30E8-A745-03839393F55A} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x00C60000 +// Image base: 0x03590000 // =============== CLASS MEMBERS DECLARATION =================== @@ -84,7 +84,7 @@ .maxstack 5 .locals init ([0] int32 x) .language '{AB4F38C9-B6E6-43BA-BE3B-58080B2CCCE3}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}' - .line 6,6 : 17,31 'C:\\visualfsharp\\tests\\fsharpqa\\Source\\CodeGen\\EmittedIL\\AsyncExpressionStepping\\AsyncExpressionSteppingTest5.fs' + .line 6,6 : 17,31 'C:\\GitHub\\dsyme\\visualfsharp\\tests\\fsharpqa\\Source\\CodeGen\\EmittedIL\\AsyncExpressionStepping\\AsyncExpressionSteppingTest5.fs' IL_0000: ldarg.1 IL_0001: stloc.0 .line 7,7 : 20,35 '' @@ -198,6 +198,107 @@ } // end of class 'f7@9-2' + .class auto ansi serializable sealed nested assembly beforefieldinit 'f7@6-4' + extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2> + { + .field public class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 computation2 + .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + .method assembly specialname rtspecialname + instance void .ctor(class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 computation2) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 14 (0xe) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: call instance void class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>::.ctor() + IL_0006: ldarg.0 + IL_0007: ldarg.1 + IL_0008: stfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 AsyncExpressionSteppingTest5/AsyncExpressionSteppingTest5/'f7@6-4'::computation2 + IL_000d: ret + } // end of method 'f7@6-4'::.ctor + + .method public strict virtual instance class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 + Invoke(class [FSharp.Core]Microsoft.FSharp.Core.Unit unitVar0) cil managed + { + // Code size 7 (0x7) + .maxstack 8 + .line 6,6 : 17,31 '' + IL_0000: ldarg.0 + IL_0001: ldfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 AsyncExpressionSteppingTest5/AsyncExpressionSteppingTest5/'f7@6-4'::computation2 + IL_0006: ret + } // end of method 'f7@6-4'::Invoke + + } // end of class 'f7@6-4' + + .class auto ansi serializable sealed nested assembly beforefieldinit 'f7@6-5' + extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn> + { + .field public class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 computation1 + .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + .field public class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2> part2 + .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + .method assembly specialname rtspecialname + instance void .ctor(class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 computation1, + class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2> part2) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 21 (0x15) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: call instance void class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>::.ctor() + IL_0006: ldarg.0 + IL_0007: ldarg.1 + IL_0008: stfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 AsyncExpressionSteppingTest5/AsyncExpressionSteppingTest5/'f7@6-5'::computation1 + IL_000d: ldarg.0 + IL_000e: ldarg.2 + IL_000f: stfld class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2> AsyncExpressionSteppingTest5/AsyncExpressionSteppingTest5/'f7@6-5'::part2 + IL_0014: ret + } // end of method 'f7@6-5'::.ctor + + .method public strict virtual instance class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn + Invoke(class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1 ctxt) cil managed + { + // Code size 47 (0x2f) + .maxstack 8 + .line 100001,100001 : 0,0 '' + IL_0000: ldarg.1 + IL_0001: callvirt instance bool class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1::get_IsCancellationRequested() + IL_0006: brfalse.s IL_000a + + IL_0008: br.s IL_000c + + IL_000a: br.s IL_0015 + + .line 100001,100001 : 0,0 '' + IL_000c: ldarg.1 + IL_000d: tail. + IL_000f: callvirt instance class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1::OnCancellation() + IL_0014: ret + + .line 100001,100001 : 0,0 '' + IL_0015: ldarg.0 + IL_0016: ldfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 AsyncExpressionSteppingTest5/AsyncExpressionSteppingTest5/'f7@6-5'::computation1 + IL_001b: ldarg.1 + IL_001c: ldarg.0 + IL_001d: ldfld class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2> AsyncExpressionSteppingTest5/AsyncExpressionSteppingTest5/'f7@6-5'::part2 + IL_0022: call class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1 [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::Bind(class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1, + class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>) + IL_0027: tail. + IL_0029: call class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::Invoke(class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1, + class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1) + IL_002e: ret + } // end of method 'f7@6-5'::Invoke + + } // end of class 'f7@6-5' + .class auto ansi serializable sealed nested assembly beforefieldinit f7@6 extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2> { @@ -223,29 +324,42 @@ .method public strict virtual instance class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 Invoke(class [FSharp.Core]Microsoft.FSharp.Core.Unit unitVar) cil managed { - // Code size 63 (0x3f) - .maxstack 8 + // Code size 80 (0x50) + .maxstack 7 + .locals init ([0] class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder V_0, + [1] class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 V_1, + [2] class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 V_2, + [3] class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2> V_3) .line 6,6 : 17,31 '' IL_0000: ldarg.0 IL_0001: ldfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder AsyncExpressionSteppingTest5/AsyncExpressionSteppingTest5/f7@6::builder@ - IL_0006: ldarg.0 - IL_0007: ldfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder AsyncExpressionSteppingTest5/AsyncExpressionSteppingTest5/f7@6::builder@ - IL_000c: call class [FSharp.Core]Microsoft.FSharp.Collections.FSharpList`1 AsyncExpressionSteppingTest5/AsyncExpressionSteppingTest5::get_es() - IL_0011: ldarg.0 - IL_0012: ldfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder AsyncExpressionSteppingTest5/AsyncExpressionSteppingTest5/f7@6::builder@ - IL_0017: newobj instance void AsyncExpressionSteppingTest5/AsyncExpressionSteppingTest5/'f7@6-1'::.ctor(class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder) - IL_001c: callvirt instance class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder::For(class [mscorlib]System.Collections.Generic.IEnumerable`1, + IL_0006: stloc.0 + IL_0007: ldarg.0 + IL_0008: ldfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder AsyncExpressionSteppingTest5/AsyncExpressionSteppingTest5/f7@6::builder@ + IL_000d: call class [FSharp.Core]Microsoft.FSharp.Collections.FSharpList`1 AsyncExpressionSteppingTest5/AsyncExpressionSteppingTest5::get_es() + IL_0012: ldarg.0 + IL_0013: ldfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder AsyncExpressionSteppingTest5/AsyncExpressionSteppingTest5/f7@6::builder@ + IL_0018: newobj instance void AsyncExpressionSteppingTest5/AsyncExpressionSteppingTest5/'f7@6-1'::.ctor(class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder) + IL_001d: callvirt instance class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder::For(class [mscorlib]System.Collections.Generic.IEnumerable`1, class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>) - IL_0021: ldarg.0 - IL_0022: ldfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder AsyncExpressionSteppingTest5/AsyncExpressionSteppingTest5/f7@6::builder@ - IL_0027: ldarg.0 - IL_0028: ldfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder AsyncExpressionSteppingTest5/AsyncExpressionSteppingTest5/f7@6::builder@ - IL_002d: newobj instance void AsyncExpressionSteppingTest5/AsyncExpressionSteppingTest5/'f7@9-2'::.ctor(class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder) - IL_0032: callvirt instance class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder::Delay(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>) - IL_0037: tail. - IL_0039: callvirt instance class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder::Combine(class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1, - class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1) - IL_003e: ret + IL_0022: stloc.1 + IL_0023: ldarg.0 + IL_0024: ldfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder AsyncExpressionSteppingTest5/AsyncExpressionSteppingTest5/f7@6::builder@ + IL_0029: ldarg.0 + IL_002a: ldfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder AsyncExpressionSteppingTest5/AsyncExpressionSteppingTest5/f7@6::builder@ + IL_002f: newobj instance void AsyncExpressionSteppingTest5/AsyncExpressionSteppingTest5/'f7@9-2'::.ctor(class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder) + IL_0034: callvirt instance class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder::Delay(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>) + IL_0039: stloc.2 + IL_003a: ldloc.2 + IL_003b: newobj instance void AsyncExpressionSteppingTest5/AsyncExpressionSteppingTest5/'f7@6-4'::.ctor(class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1) + IL_0040: stloc.3 + IL_0041: ldloc.1 + IL_0042: ldloc.3 + IL_0043: newobj instance void AsyncExpressionSteppingTest5/AsyncExpressionSteppingTest5/'f7@6-5'::.ctor(class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1, + class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>) + IL_0048: tail. + IL_004a: call class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::MakeAsync(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>) + IL_004f: ret } // end of method f7@6::Invoke } // end of class f7@6 diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/AsyncExpressionStepping/AsyncExpressionSteppingTest6.il.bsl b/tests/fsharpqa/Source/CodeGen/EmittedIL/AsyncExpressionStepping/AsyncExpressionSteppingTest6.il.bsl index e027d172025..f12626bdcc8 100644 --- a/tests/fsharpqa/Source/CodeGen/EmittedIL/AsyncExpressionStepping/AsyncExpressionSteppingTest6.il.bsl +++ b/tests/fsharpqa/Source/CodeGen/EmittedIL/AsyncExpressionStepping/AsyncExpressionSteppingTest6.il.bsl @@ -13,7 +13,7 @@ .assembly extern FSharp.Core { .publickeytoken = (B0 3F 5F 7F 11 D5 0A 3A ) // .?_....: - .ver 4:4:1:0 + .ver 4:4:3:0 } .assembly AsyncExpressionSteppingTest6 { @@ -29,20 +29,20 @@ } .mresource public FSharpSignatureData.AsyncExpressionSteppingTest6 { - // Offset: 0x00000000 Length: 0x00000281 + // Offset: 0x00000000 Length: 0x000002A3 } .mresource public FSharpOptimizationData.AsyncExpressionSteppingTest6 { - // Offset: 0x00000288 Length: 0x000000BE + // Offset: 0x000002A8 Length: 0x000000BE } .module AsyncExpressionSteppingTest6.dll -// MVID: {5A1F62A7-6394-4FAD-A745-0383A7621F5A} +// MVID: {5AF59393-6394-4FAD-A745-03839393F55A} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x03740000 +// Image base: 0x030D0000 // =============== CLASS MEMBERS DECLARATION =================== @@ -55,6 +55,45 @@ extends [mscorlib]System.Object { .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 07 00 00 00 00 00 ) + .class auto ansi serializable sealed nested assembly beforefieldinit 'f2@10-4' + extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn> + { + .field public int32 'value' + .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + .method assembly specialname rtspecialname + instance void .ctor(int32 'value') cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 14 (0xe) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: call instance void class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>::.ctor() + IL_0006: ldarg.0 + IL_0007: ldarg.1 + IL_0008: stfld int32 AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f2@10-4'::'value' + IL_000d: ret + } // end of method 'f2@10-4'::.ctor + + .method public strict virtual instance class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn + Invoke(class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1 ctxt) cil managed + { + // Code size 15 (0xf) + .maxstack 8 + .language '{AB4F38C9-B6E6-43BA-BE3B-58080B2CCCE3}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}' + .line 10,10 : 17,25 'C:\\GitHub\\dsyme\\visualfsharp\\tests\\fsharpqa\\Source\\CodeGen\\EmittedIL\\AsyncExpressionStepping\\AsyncExpressionSteppingTest6.fs' + IL_0000: ldarg.1 + IL_0001: ldarg.0 + IL_0002: ldfld int32 AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f2@10-4'::'value' + IL_0007: tail. + IL_0009: callvirt instance class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1::OnSuccess(!0) + IL_000e: ret + } // end of method 'f2@10-4'::Invoke + + } // end of class 'f2@10-4' + .class auto ansi serializable sealed nested assembly beforefieldinit 'f2@5-3' extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2> { @@ -80,13 +119,14 @@ .method public strict virtual instance class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 Invoke(class [FSharp.Core]Microsoft.FSharp.Core.Unit unitVar) cil managed { - // Code size 57 (0x39) + // Code size 67 (0x43) .maxstack 6 .locals init ([0] class [FSharp.Core]Microsoft.FSharp.Core.FSharpRef`1 x, [1] class [FSharp.Core]Microsoft.FSharp.Core.FSharpRef`1 y, - [2] int32 z) - .language '{AB4F38C9-B6E6-43BA-BE3B-58080B2CCCE3}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}' - .line 5,5 : 17,30 'C:\\visualfsharp\\tests\\fsharpqa\\Source\\CodeGen\\EmittedIL\\AsyncExpressionStepping\\AsyncExpressionSteppingTest6.fs' + [2] int32 z, + [3] class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder V_3, + [4] int32 V_4) + .line 5,5 : 17,30 '' IL_0000: ldc.i4.0 IL_0001: call class [FSharp.Core]Microsoft.FSharp.Core.FSharpRef`1 [FSharp.Core]Microsoft.FSharp.Core.Operators::Ref(!!0) IL_0006: stloc.0 @@ -112,15 +152,57 @@ .line 10,10 : 17,25 '' IL_002a: ldarg.0 IL_002b: ldfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f2@5-3'::builder@ - IL_0030: ldloc.2 - IL_0031: tail. - IL_0033: callvirt instance class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder::Return(!!0) - IL_0038: ret + IL_0030: stloc.3 + IL_0031: ldloc.2 + IL_0032: stloc.s V_4 + IL_0034: ldloc.s V_4 + IL_0036: newobj instance void AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f2@10-4'::.ctor(int32) + IL_003b: tail. + IL_003d: call class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::MakeAsync(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>) + IL_0042: ret } // end of method 'f2@5-3'::Invoke } // end of class 'f2@5-3' - .class auto ansi serializable sealed nested assembly beforefieldinit 'f3@19-5' + .class auto ansi serializable sealed nested assembly beforefieldinit 'f3@20-7' + extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn> + { + .field public int32 'value' + .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + .method assembly specialname rtspecialname + instance void .ctor(int32 'value') cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 14 (0xe) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: call instance void class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>::.ctor() + IL_0006: ldarg.0 + IL_0007: ldarg.1 + IL_0008: stfld int32 AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@20-7'::'value' + IL_000d: ret + } // end of method 'f3@20-7'::.ctor + + .method public strict virtual instance class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn + Invoke(class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1 ctxt) cil managed + { + // Code size 15 (0xf) + .maxstack 8 + .line 20,20 : 17,25 '' + IL_0000: ldarg.1 + IL_0001: ldarg.0 + IL_0002: ldfld int32 AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@20-7'::'value' + IL_0007: tail. + IL_0009: callvirt instance class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1::OnSuccess(!0) + IL_000e: ret + } // end of method 'f3@20-7'::Invoke + + } // end of class 'f3@20-7' + + .class auto ansi serializable sealed nested assembly beforefieldinit 'f3@19-6' extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2> { .field public class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder builder@ @@ -142,31 +224,33 @@ IL_0001: call instance void class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>::.ctor() IL_0006: ldarg.0 IL_0007: ldarg.1 - IL_0008: stfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@19-5'::builder@ + IL_0008: stfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@19-6'::builder@ IL_000d: ldarg.0 IL_000e: ldarg.2 - IL_000f: stfld int32 AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@19-5'::x1 + IL_000f: stfld int32 AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@19-6'::x1 IL_0014: ldarg.0 IL_0015: ldarg.3 - IL_0016: stfld class [FSharp.Core]Microsoft.FSharp.Core.FSharpRef`1 AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@19-5'::y + IL_0016: stfld class [FSharp.Core]Microsoft.FSharp.Core.FSharpRef`1 AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@19-6'::y IL_001b: ret - } // end of method 'f3@19-5'::.ctor + } // end of method 'f3@19-6'::.ctor .method public strict virtual instance class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 Invoke(int32 _arg4) cil managed { - // Code size 38 (0x26) + // Code size 46 (0x2e) .maxstack 6 .locals init ([0] int32 x4, - [1] int32 z) + [1] int32 z, + [2] class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder V_2, + [3] int32 V_3) .line 18,18 : 17,31 '' IL_0000: ldarg.1 IL_0001: stloc.0 .line 19,19 : 17,37 '' IL_0002: ldarg.0 - IL_0003: ldfld int32 AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@19-5'::x1 + IL_0003: ldfld int32 AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@19-6'::x1 IL_0008: ldarg.0 - IL_0009: ldfld class [FSharp.Core]Microsoft.FSharp.Core.FSharpRef`1 AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@19-5'::y + IL_0009: ldfld class [FSharp.Core]Microsoft.FSharp.Core.FSharpRef`1 AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@19-6'::y IL_000e: call !!0 [FSharp.Core]Microsoft.FSharp.Core.Operators::op_Dereference(class [FSharp.Core]Microsoft.FSharp.Core.FSharpRef`1) IL_0013: add IL_0014: ldloc.0 @@ -174,16 +258,86 @@ IL_0016: stloc.1 .line 20,20 : 17,25 '' IL_0017: ldarg.0 - IL_0018: ldfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@19-5'::builder@ - IL_001d: ldloc.1 - IL_001e: tail. - IL_0020: callvirt instance class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder::Return(!!0) - IL_0025: ret - } // end of method 'f3@19-5'::Invoke + IL_0018: ldfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@19-6'::builder@ + IL_001d: stloc.2 + IL_001e: ldloc.1 + IL_001f: stloc.3 + IL_0020: ldloc.3 + IL_0021: newobj instance void AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@20-7'::.ctor(int32) + IL_0026: tail. + IL_0028: call class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::MakeAsync(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>) + IL_002d: ret + } // end of method 'f3@19-6'::Invoke + + } // end of class 'f3@19-6' + + .class auto ansi serializable sealed nested assembly beforefieldinit 'f3@18-8' + extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn> + { + .field public class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 computation + .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + .field public class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2> binder + .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + .method assembly specialname rtspecialname + instance void .ctor(class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 computation, + class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2> binder) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 21 (0x15) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: call instance void class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>::.ctor() + IL_0006: ldarg.0 + IL_0007: ldarg.1 + IL_0008: stfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@18-8'::computation + IL_000d: ldarg.0 + IL_000e: ldarg.2 + IL_000f: stfld class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2> AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@18-8'::binder + IL_0014: ret + } // end of method 'f3@18-8'::.ctor + + .method public strict virtual instance class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn + Invoke(class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1 ctxt) cil managed + { + // Code size 47 (0x2f) + .maxstack 8 + .line 100001,100001 : 0,0 '' + IL_0000: ldarg.1 + IL_0001: callvirt instance bool class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1::get_IsCancellationRequested() + IL_0006: brfalse.s IL_000a + + IL_0008: br.s IL_000c - } // end of class 'f3@19-5' + IL_000a: br.s IL_0015 - .class auto ansi serializable sealed nested assembly beforefieldinit 'f3@16-4' + .line 100001,100001 : 0,0 '' + IL_000c: ldarg.1 + IL_000d: tail. + IL_000f: callvirt instance class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1::OnCancellation() + IL_0014: ret + + .line 100001,100001 : 0,0 '' + IL_0015: ldarg.0 + IL_0016: ldfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@18-8'::computation + IL_001b: ldarg.1 + IL_001c: ldarg.0 + IL_001d: ldfld class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2> AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@18-8'::binder + IL_0022: call class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1 [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::Bind(class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1, + class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>) + IL_0027: tail. + IL_0029: call class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::Invoke(class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1, + class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1) + IL_002e: ret + } // end of method 'f3@18-8'::Invoke + + } // end of class 'f3@18-8' + + .class auto ansi serializable sealed nested assembly beforefieldinit 'f3@16-5' extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2> { .field public class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder builder@ @@ -203,20 +357,23 @@ IL_0001: call instance void class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>::.ctor() IL_0006: ldarg.0 IL_0007: ldarg.1 - IL_0008: stfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@16-4'::builder@ + IL_0008: stfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@16-5'::builder@ IL_000d: ldarg.0 IL_000e: ldarg.2 - IL_000f: stfld int32 AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@16-4'::x1 + IL_000f: stfld int32 AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@16-5'::x1 IL_0014: ret - } // end of method 'f3@16-4'::.ctor + } // end of method 'f3@16-5'::.ctor .method public strict virtual instance class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 Invoke(int32 _arg3) cil managed { - // Code size 53 (0x35) - .maxstack 9 + // Code size 65 (0x41) + .maxstack 7 .locals init ([0] int32 x3, - [1] class [FSharp.Core]Microsoft.FSharp.Core.FSharpRef`1 y) + [1] class [FSharp.Core]Microsoft.FSharp.Core.FSharpRef`1 y, + [2] class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder V_2, + [3] class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 V_3, + [4] class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2> V_4) .line 15,15 : 17,31 '' IL_0000: ldarg.1 IL_0001: stloc.0 @@ -230,25 +387,97 @@ IL_000f: nop .line 18,18 : 17,31 '' IL_0010: ldarg.0 - IL_0011: ldfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@16-4'::builder@ - IL_0016: call class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6::f2() - IL_001b: ldarg.0 - IL_001c: ldfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@16-4'::builder@ - IL_0021: ldarg.0 - IL_0022: ldfld int32 AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@16-4'::x1 - IL_0027: ldloc.1 - IL_0028: newobj instance void AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@19-5'::.ctor(class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder, + IL_0011: ldfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@16-5'::builder@ + IL_0016: stloc.2 + IL_0017: call class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6::f2() + IL_001c: stloc.3 + IL_001d: ldarg.0 + IL_001e: ldfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@16-5'::builder@ + IL_0023: ldarg.0 + IL_0024: ldfld int32 AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@16-5'::x1 + IL_0029: ldloc.1 + IL_002a: newobj instance void AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@19-6'::.ctor(class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder, int32, class [FSharp.Core]Microsoft.FSharp.Core.FSharpRef`1) - IL_002d: tail. - IL_002f: callvirt instance class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder::Bind(class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1, - class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>) - IL_0034: ret - } // end of method 'f3@16-4'::Invoke + IL_002f: stloc.s V_4 + IL_0031: ldloc.3 + IL_0032: ldloc.s V_4 + IL_0034: newobj instance void AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@18-8'::.ctor(class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1, + class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>) + IL_0039: tail. + IL_003b: call class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::MakeAsync(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>) + IL_0040: ret + } // end of method 'f3@16-5'::Invoke + + } // end of class 'f3@16-5' + + .class auto ansi serializable sealed nested assembly beforefieldinit 'f3@15-9' + extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn> + { + .field public class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 computation + .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + .field public class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2> binder + .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + .method assembly specialname rtspecialname + instance void .ctor(class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 computation, + class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2> binder) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 21 (0x15) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: call instance void class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>::.ctor() + IL_0006: ldarg.0 + IL_0007: ldarg.1 + IL_0008: stfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@15-9'::computation + IL_000d: ldarg.0 + IL_000e: ldarg.2 + IL_000f: stfld class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2> AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@15-9'::binder + IL_0014: ret + } // end of method 'f3@15-9'::.ctor + + .method public strict virtual instance class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn + Invoke(class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1 ctxt) cil managed + { + // Code size 47 (0x2f) + .maxstack 8 + .line 100001,100001 : 0,0 '' + IL_0000: ldarg.1 + IL_0001: callvirt instance bool class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1::get_IsCancellationRequested() + IL_0006: brfalse.s IL_000a + + IL_0008: br.s IL_000c + + IL_000a: br.s IL_0015 - } // end of class 'f3@16-4' + .line 100001,100001 : 0,0 '' + IL_000c: ldarg.1 + IL_000d: tail. + IL_000f: callvirt instance class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1::OnCancellation() + IL_0014: ret - .class auto ansi serializable sealed nested assembly beforefieldinit 'f3@15-3' + .line 100001,100001 : 0,0 '' + IL_0015: ldarg.0 + IL_0016: ldfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@15-9'::computation + IL_001b: ldarg.1 + IL_001c: ldarg.0 + IL_001d: ldfld class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2> AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@15-9'::binder + IL_0022: call class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1 [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::Bind(class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1, + class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>) + IL_0027: tail. + IL_0029: call class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::Invoke(class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1, + class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1) + IL_002e: ret + } // end of method 'f3@15-9'::Invoke + + } // end of class 'f3@15-9' + + .class auto ansi serializable sealed nested assembly beforefieldinit 'f3@15-4' extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2> { .field public class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder builder@ @@ -268,41 +497,116 @@ IL_0001: call instance void class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>::.ctor() IL_0006: ldarg.0 IL_0007: ldarg.1 - IL_0008: stfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@15-3'::builder@ + IL_0008: stfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@15-4'::builder@ IL_000d: ldarg.0 IL_000e: ldarg.2 - IL_000f: stfld int32 AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@15-3'::x1 + IL_000f: stfld int32 AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@15-4'::x1 IL_0014: ret - } // end of method 'f3@15-3'::.ctor + } // end of method 'f3@15-4'::.ctor .method public strict virtual instance class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 Invoke(int32 _arg2) cil managed { - // Code size 38 (0x26) - .maxstack 8 - .locals init ([0] int32 x2) + // Code size 48 (0x30) + .maxstack 6 + .locals init ([0] int32 x2, + [1] class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder V_1, + [2] class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 V_2, + [3] class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2> V_3) .line 14,14 : 17,31 '' IL_0000: ldarg.1 IL_0001: stloc.0 .line 15,15 : 17,31 '' IL_0002: ldarg.0 - IL_0003: ldfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@15-3'::builder@ - IL_0008: call class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6::f2() - IL_000d: ldarg.0 - IL_000e: ldfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@15-3'::builder@ - IL_0013: ldarg.0 - IL_0014: ldfld int32 AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@15-3'::x1 - IL_0019: newobj instance void AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@16-4'::.ctor(class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder, + IL_0003: ldfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@15-4'::builder@ + IL_0008: stloc.1 + IL_0009: call class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6::f2() + IL_000e: stloc.2 + IL_000f: ldarg.0 + IL_0010: ldfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@15-4'::builder@ + IL_0015: ldarg.0 + IL_0016: ldfld int32 AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@15-4'::x1 + IL_001b: newobj instance void AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@16-5'::.ctor(class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder, int32) - IL_001e: tail. - IL_0020: callvirt instance class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder::Bind(class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1, - class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>) - IL_0025: ret - } // end of method 'f3@15-3'::Invoke + IL_0020: stloc.3 + IL_0021: ldloc.2 + IL_0022: ldloc.3 + IL_0023: newobj instance void AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@15-9'::.ctor(class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1, + class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>) + IL_0028: tail. + IL_002a: call class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::MakeAsync(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>) + IL_002f: ret + } // end of method 'f3@15-4'::Invoke + + } // end of class 'f3@15-4' + + .class auto ansi serializable sealed nested assembly beforefieldinit 'f3@14-10' + extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn> + { + .field public class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 computation + .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + .field public class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2> binder + .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + .method assembly specialname rtspecialname + instance void .ctor(class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 computation, + class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2> binder) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 21 (0x15) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: call instance void class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>::.ctor() + IL_0006: ldarg.0 + IL_0007: ldarg.1 + IL_0008: stfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@14-10'::computation + IL_000d: ldarg.0 + IL_000e: ldarg.2 + IL_000f: stfld class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2> AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@14-10'::binder + IL_0014: ret + } // end of method 'f3@14-10'::.ctor + + .method public strict virtual instance class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn + Invoke(class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1 ctxt) cil managed + { + // Code size 47 (0x2f) + .maxstack 8 + .line 100001,100001 : 0,0 '' + IL_0000: ldarg.1 + IL_0001: callvirt instance bool class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1::get_IsCancellationRequested() + IL_0006: brfalse.s IL_000a + + IL_0008: br.s IL_000c + + IL_000a: br.s IL_0015 - } // end of class 'f3@15-3' + .line 100001,100001 : 0,0 '' + IL_000c: ldarg.1 + IL_000d: tail. + IL_000f: callvirt instance class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1::OnCancellation() + IL_0014: ret - .class auto ansi serializable sealed nested assembly beforefieldinit 'f3@14-2' + .line 100001,100001 : 0,0 '' + IL_0015: ldarg.0 + IL_0016: ldfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@14-10'::computation + IL_001b: ldarg.1 + IL_001c: ldarg.0 + IL_001d: ldfld class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2> AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@14-10'::binder + IL_0022: call class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1 [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::Bind(class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1, + class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>) + IL_0027: tail. + IL_0029: call class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::Invoke(class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1, + class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1) + IL_002e: ret + } // end of method 'f3@14-10'::Invoke + + } // end of class 'f3@14-10' + + .class auto ansi serializable sealed nested assembly beforefieldinit 'f3@14-3' extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2> { .field public class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder builder@ @@ -320,37 +624,112 @@ IL_0001: call instance void class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>::.ctor() IL_0006: ldarg.0 IL_0007: ldarg.1 - IL_0008: stfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@14-2'::builder@ + IL_0008: stfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@14-3'::builder@ IL_000d: ret - } // end of method 'f3@14-2'::.ctor + } // end of method 'f3@14-3'::.ctor .method public strict virtual instance class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 Invoke(int32 _arg1) cil managed { - // Code size 33 (0x21) - .maxstack 8 - .locals init ([0] int32 x1) + // Code size 43 (0x2b) + .maxstack 6 + .locals init ([0] int32 x1, + [1] class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder V_1, + [2] class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 V_2, + [3] class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2> V_3) .line 13,13 : 17,31 '' IL_0000: ldarg.1 IL_0001: stloc.0 .line 14,14 : 17,31 '' IL_0002: ldarg.0 - IL_0003: ldfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@14-2'::builder@ - IL_0008: call class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6::f2() - IL_000d: ldarg.0 - IL_000e: ldfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@14-2'::builder@ - IL_0013: ldloc.0 - IL_0014: newobj instance void AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@15-3'::.ctor(class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder, + IL_0003: ldfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@14-3'::builder@ + IL_0008: stloc.1 + IL_0009: call class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6::f2() + IL_000e: stloc.2 + IL_000f: ldarg.0 + IL_0010: ldfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@14-3'::builder@ + IL_0015: ldloc.0 + IL_0016: newobj instance void AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@15-4'::.ctor(class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder, int32) - IL_0019: tail. - IL_001b: callvirt instance class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder::Bind(class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1, - class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>) - IL_0020: ret - } // end of method 'f3@14-2'::Invoke + IL_001b: stloc.3 + IL_001c: ldloc.2 + IL_001d: ldloc.3 + IL_001e: newobj instance void AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@14-10'::.ctor(class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1, + class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>) + IL_0023: tail. + IL_0025: call class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::MakeAsync(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>) + IL_002a: ret + } // end of method 'f3@14-3'::Invoke + + } // end of class 'f3@14-3' + + .class auto ansi serializable sealed nested assembly beforefieldinit 'f3@13-11' + extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn> + { + .field public class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 computation + .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + .field public class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2> binder + .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + .method assembly specialname rtspecialname + instance void .ctor(class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 computation, + class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2> binder) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 21 (0x15) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: call instance void class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>::.ctor() + IL_0006: ldarg.0 + IL_0007: ldarg.1 + IL_0008: stfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@13-11'::computation + IL_000d: ldarg.0 + IL_000e: ldarg.2 + IL_000f: stfld class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2> AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@13-11'::binder + IL_0014: ret + } // end of method 'f3@13-11'::.ctor + + .method public strict virtual instance class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn + Invoke(class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1 ctxt) cil managed + { + // Code size 47 (0x2f) + .maxstack 8 + .line 100001,100001 : 0,0 '' + IL_0000: ldarg.1 + IL_0001: callvirt instance bool class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1::get_IsCancellationRequested() + IL_0006: brfalse.s IL_000a + + IL_0008: br.s IL_000c + + IL_000a: br.s IL_0015 - } // end of class 'f3@14-2' + .line 100001,100001 : 0,0 '' + IL_000c: ldarg.1 + IL_000d: tail. + IL_000f: callvirt instance class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1::OnCancellation() + IL_0014: ret - .class auto ansi serializable sealed nested assembly beforefieldinit 'f3@13-1' + .line 100001,100001 : 0,0 '' + IL_0015: ldarg.0 + IL_0016: ldfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@13-11'::computation + IL_001b: ldarg.1 + IL_001c: ldarg.0 + IL_001d: ldfld class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2> AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@13-11'::binder + IL_0022: call class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1 [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::Bind(class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1, + class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>) + IL_0027: tail. + IL_0029: call class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::Invoke(class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1, + class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1) + IL_002e: ret + } // end of method 'f3@13-11'::Invoke + + } // end of class 'f3@13-11' + + .class auto ansi serializable sealed nested assembly beforefieldinit 'f3@13-2' extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2> { .field public class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder builder@ @@ -368,29 +747,38 @@ IL_0001: call instance void class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>::.ctor() IL_0006: ldarg.0 IL_0007: ldarg.1 - IL_0008: stfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@13-1'::builder@ + IL_0008: stfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@13-2'::builder@ IL_000d: ret - } // end of method 'f3@13-1'::.ctor + } // end of method 'f3@13-2'::.ctor .method public strict virtual instance class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 Invoke(class [FSharp.Core]Microsoft.FSharp.Core.Unit unitVar) cil managed { - // Code size 30 (0x1e) - .maxstack 8 + // Code size 40 (0x28) + .maxstack 6 + .locals init ([0] class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder V_0, + [1] class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 V_1, + [2] class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2> V_2) .line 13,13 : 17,31 '' IL_0000: ldarg.0 - IL_0001: ldfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@13-1'::builder@ - IL_0006: call class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6::f2() - IL_000b: ldarg.0 - IL_000c: ldfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@13-1'::builder@ - IL_0011: newobj instance void AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@14-2'::.ctor(class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder) - IL_0016: tail. - IL_0018: callvirt instance class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder::Bind(class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1, - class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>) - IL_001d: ret - } // end of method 'f3@13-1'::Invoke - - } // end of class 'f3@13-1' + IL_0001: ldfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@13-2'::builder@ + IL_0006: stloc.0 + IL_0007: call class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6::f2() + IL_000c: stloc.1 + IL_000d: ldarg.0 + IL_000e: ldfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@13-2'::builder@ + IL_0013: newobj instance void AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@14-3'::.ctor(class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder) + IL_0018: stloc.2 + IL_0019: ldloc.1 + IL_001a: ldloc.2 + IL_001b: newobj instance void AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@13-11'::.ctor(class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1, + class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>) + IL_0020: tail. + IL_0022: call class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::MakeAsync(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>) + IL_0027: ret + } // end of method 'f3@13-2'::Invoke + + } // end of class 'f3@13-2' .method public static class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 f2() cil managed @@ -420,7 +808,7 @@ IL_0005: stloc.0 IL_0006: ldloc.0 IL_0007: ldloc.0 - IL_0008: newobj instance void AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@13-1'::.ctor(class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder) + IL_0008: newobj instance void AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@13-2'::.ctor(class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder) IL_000d: tail. IL_000f: callvirt instance class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 [FSharp.Core]Microsoft.FSharp.Control.FSharpAsyncBuilder::Delay(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>) IL_0014: ret From e946976f20767e9585687e09ccdd89ef369d5a53 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Fri, 11 May 2018 16:36:08 +0100 Subject: [PATCH 29/39] add check that no line 0 appear in stack --- src/fsharp/FSharp.Core/control.fs | 15 ++++++++------- src/fsharp/FSharp.Core/control.fsi | 2 +- tests/fsharp/core/asyncStackTraces/test.fsx | 1 + 3 files changed, 10 insertions(+), 8 deletions(-) diff --git a/src/fsharp/FSharp.Core/control.fs b/src/fsharp/FSharp.Core/control.fs index a6590a2bc14..a04d8ce7f7f 100644 --- a/src/fsharp/FSharp.Core/control.fs +++ b/src/fsharp/FSharp.Core/control.fs @@ -479,9 +479,13 @@ namespace Microsoft.FSharp.Control [] // Note: direct calls to this function end up in user assemblies via inlining - let Bind (ctxt: AsyncActivation<'T>) (part2: 'U -> Async<'T>) : AsyncActivation<'U> = - let cont result1 = CallThenInvokeNoHijackCheck ctxt part2 result1 - { cont=cont; aux = ctxt.aux } + let Bind (ctxt: AsyncActivation<'T>) (part1: Async<'U>) (part2: 'U -> Async<'T>) : AsyncReturn = + if ctxt.IsCancellationRequested then + ctxt.OnCancellation () + else + let cont result1 = CallThenInvokeNoHijackCheck ctxt part2 result1 + let ctxt2 = { cont=cont; aux = ctxt.aux } + Invoke part1 ctxt2 /// Execute the with-filter part of a try-with-filer but first check for trampoline and cancellation. // @@ -550,10 +554,7 @@ namespace Microsoft.FSharp.Control let inline CreateBindAsync part1 part2 = // Note: this code ends up in user assemblies via inlining MakeAsync (fun ctxt -> - if ctxt.IsCancellationRequested then - ctxt.OnCancellation () - else - Invoke part1 (Bind ctxt part2)) + Bind ctxt part1 part2) // Call the given function with exception protection, but first // check for cancellation. diff --git a/src/fsharp/FSharp.Core/control.fsi b/src/fsharp/FSharp.Core/control.fsi index b40f156f4c9..90702508604 100644 --- a/src/fsharp/FSharp.Core/control.fsi +++ b/src/fsharp/FSharp.Core/control.fsi @@ -490,7 +490,7 @@ namespace Microsoft.FSharp.Control /// A function returning the second part of the computation. /// /// An async activation suitable for running part1 of the asynchronous execution. - val Bind: ctxt:AsyncActivation<'T> -> part2:('U -> Async<'T>) -> AsyncActivation<'U> + val Bind: ctxt:AsyncActivation<'T> -> part1:Async<'U> -> part2:('U -> Async<'T>) -> AsyncReturn /// The F# compiler emits calls to this function to implement the try/finally construct for F# async expressions. /// diff --git a/tests/fsharp/core/asyncStackTraces/test.fsx b/tests/fsharp/core/asyncStackTraces/test.fsx index 46719564d48..56b3810bf55 100644 --- a/tests/fsharp/core/asyncStackTraces/test.fsx +++ b/tests/fsharp/core/asyncStackTraces/test.fsx @@ -154,6 +154,7 @@ for (asyncTopName, asyncTop) in [("asyncTop2", asyncTop2); ("asyncTop3", asyncTo failwith "should have raised exception" with e -> let stack = e.StackTrace + test (sprintf "case %s: clncw09ew09m0" functionName) (not (stack.Contains("line 0"))) test (sprintf "case %s: clncw09ew09m1" functionName) (stack.Contains(functionName)) test (sprintf "case %s: clncw09ew09n2" functionName) (stack.Contains("asyncMid")) test (sprintf "case %s: clncw09ew09n3" functionName) (stack.Contains(asyncTopName)) From bba01b90016bbd3f0c3c9336cbc286353a484ead Mon Sep 17 00:00:00 2001 From: Don Syme Date: Fri, 11 May 2018 16:37:29 +0100 Subject: [PATCH 30/39] update baseline --- tests/FSharp.Core.UnitTests/SurfaceArea.coreclr.fs | 2 +- tests/FSharp.Core.UnitTests/SurfaceArea.net40.fs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/FSharp.Core.UnitTests/SurfaceArea.coreclr.fs b/tests/FSharp.Core.UnitTests/SurfaceArea.coreclr.fs index 56e4f998248..261efd13fad 100644 --- a/tests/FSharp.Core.UnitTests/SurfaceArea.coreclr.fs +++ b/tests/FSharp.Core.UnitTests/SurfaceArea.coreclr.fs @@ -578,7 +578,7 @@ Microsoft.FSharp.Control.AsyncActivation`1[T]: System.String ToString() Microsoft.FSharp.Control.AsyncActivation`1[T]: System.Type GetType() Microsoft.FSharp.Control.AsyncPrimitives: Boolean Equals(System.Object) Microsoft.FSharp.Control.AsyncPrimitives: Int32 GetHashCode() -Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.AsyncActivation`1[TResult] Bind[T,TResult](Microsoft.FSharp.Control.AsyncActivation`1[T], Microsoft.FSharp.Core.FSharpFunc`2[TResult,Microsoft.FSharp.Control.FSharpAsync`1[T]]) +-Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.AsyncReturn Bind[T,TResult](Microsoft.FSharp.Control.AsyncActivation`1[T], Microsoft.FSharp.Control.FSharpAsync`1[TResult], Microsoft.FSharp.Core.FSharpFunc`2[TResult,Microsoft.FSharp.Control.FSharpAsync`1[T]]) Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.AsyncReturn CallThenInvoke[T,TResult](Microsoft.FSharp.Control.AsyncActivation`1[T], TResult, Microsoft.FSharp.Core.FSharpFunc`2[TResult,Microsoft.FSharp.Control.FSharpAsync`1[T]]) Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.AsyncReturn Invoke[T](Microsoft.FSharp.Control.FSharpAsync`1[T], Microsoft.FSharp.Control.AsyncActivation`1[T]) Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.AsyncReturn TryFinally[T](Microsoft.FSharp.Control.AsyncActivation`1[T], Microsoft.FSharp.Control.FSharpAsync`1[T], Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit]) diff --git a/tests/FSharp.Core.UnitTests/SurfaceArea.net40.fs b/tests/FSharp.Core.UnitTests/SurfaceArea.net40.fs index 09731fb3267..76175ca246b 100644 --- a/tests/FSharp.Core.UnitTests/SurfaceArea.net40.fs +++ b/tests/FSharp.Core.UnitTests/SurfaceArea.net40.fs @@ -565,7 +565,7 @@ Microsoft.FSharp.Control.AsyncActivation`1[T]: System.String ToString() Microsoft.FSharp.Control.AsyncActivation`1[T]: System.Type GetType() Microsoft.FSharp.Control.AsyncPrimitives: Boolean Equals(System.Object) Microsoft.FSharp.Control.AsyncPrimitives: Int32 GetHashCode() -Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.AsyncActivation`1[TResult] Bind[T,TResult](Microsoft.FSharp.Control.AsyncActivation`1[T], Microsoft.FSharp.Core.FSharpFunc`2[TResult,Microsoft.FSharp.Control.FSharpAsync`1[T]]) +-Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.AsyncReturn Bind[T,TResult](Microsoft.FSharp.Control.AsyncActivation`1[T], Microsoft.FSharp.Control.FSharpAsync`1[TResult], Microsoft.FSharp.Core.FSharpFunc`2[TResult,Microsoft.FSharp.Control.FSharpAsync`1[T]]) Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.AsyncReturn CallThenInvoke[T,TResult](Microsoft.FSharp.Control.AsyncActivation`1[T], TResult, Microsoft.FSharp.Core.FSharpFunc`2[TResult,Microsoft.FSharp.Control.FSharpAsync`1[T]]) Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.AsyncReturn Invoke[T](Microsoft.FSharp.Control.FSharpAsync`1[T], Microsoft.FSharp.Control.AsyncActivation`1[T]) Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.AsyncReturn TryFinally[T](Microsoft.FSharp.Control.AsyncActivation`1[T], Microsoft.FSharp.Control.FSharpAsync`1[T], Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit]) From 5f7f98d128c5f4f047ad6187da9ffee8ff59d47b Mon Sep 17 00:00:00 2001 From: Don Syme Date: Fri, 11 May 2018 17:27:08 +0100 Subject: [PATCH 31/39] use struct wrapper for async activation --- src/fsharp/FSharp.Core/control.fs | 66 +++++++++++++++++------------- src/fsharp/FSharp.Core/control.fsi | 6 +-- 2 files changed, 40 insertions(+), 32 deletions(-) diff --git a/src/fsharp/FSharp.Core/control.fs b/src/fsharp/FSharp.Core/control.fs index a04d8ce7f7f..0573423da5a 100644 --- a/src/fsharp/FSharp.Core/control.fs +++ b/src/fsharp/FSharp.Core/control.fs @@ -293,18 +293,27 @@ namespace Microsoft.FSharp.Control [] [] /// Represents an in-flight async computation - type AsyncActivation<'T> = + type AsyncActivationContents<'T> = { cont : cont<'T> aux : AsyncActivationAux } - member ctxt.IsCancellationRequested = ctxt.aux.token.IsCancellationRequested + [] + type AsyncActivation<'T>(contents: AsyncActivationContents<'T>) = + + member ctxt.Contents = contents + member ctxt.aux = contents.aux + member ctxt.cont = contents.cont + member ctxt.econt = contents.aux.econt + member ctxt.ccont = contents.aux.ccont + + member ctxt.IsCancellationRequested = contents.aux.token.IsCancellationRequested /// Call the cancellation continuation of the active computation member ctxt.OnCancellation () = - ctxt.aux.ccont (new OperationCanceledException (ctxt.aux.token)) + contents.aux.ccont (new OperationCanceledException (contents.aux.token)) member inline ctxt.HijackCheckThenCall cont arg = - ctxt.aux.trampolineHolder.HijackCheckThenCall cont arg + contents.aux.trampolineHolder.HijackCheckThenCall cont arg member ctxt.OnSuccess result = if ctxt.IsCancellationRequested then @@ -314,11 +323,11 @@ namespace Microsoft.FSharp.Control /// Call the exception continuation directly member ctxt.CallExceptionContinuation edi = - ctxt.aux.econt edi + contents.aux.econt edi /// Save the exception continuation during propagation of an exception, or prior to raising an exception member ctxt.OnExceptionRaised() = - ctxt.aux.trampolineHolder.OnExceptionRaised ctxt.aux.econt + contents.aux.trampolineHolder.OnExceptionRaised contents.aux.econt [] [] @@ -446,7 +455,7 @@ namespace Microsoft.FSharp.Control if ok then match resOpt with | None -> - ctxt.HijackCheckThenCall ctxt.aux.econt edi + ctxt.HijackCheckThenCall ctxt.econt edi | Some res -> Invoke res ctxt else @@ -472,7 +481,7 @@ namespace Microsoft.FSharp.Control /// Make an initial asyc activation. [] let CreateAsyncActivation cancellationToken trampolineHolder cont econt ccont = - { cont = cont; aux = { token = cancellationToken; econt = econt; ccont = ccont; trampolineHolder = trampolineHolder } } + AsyncActivation { cont = cont; aux = { token = cancellationToken; econt = econt; ccont = ccont; trampolineHolder = trampolineHolder } } /// Build a primitive without any exception or resync protection let MakeAsync body = { Invoke = body } @@ -484,7 +493,7 @@ namespace Microsoft.FSharp.Control ctxt.OnCancellation () else let cont result1 = CallThenInvokeNoHijackCheck ctxt part2 result1 - let ctxt2 = { cont=cont; aux = ctxt.aux } + let ctxt2 = AsyncActivation { cont=cont; aux = ctxt.aux } Invoke part1 ctxt2 /// Execute the with-filter part of a try-with-filer but first check for trampoline and cancellation. @@ -504,19 +513,20 @@ namespace Microsoft.FSharp.Control // The new continuation runs the finallyFunction and resumes the old continuation // If an exception is thrown we continue with the previous exception continuation. let cont b = - let ctxt = { cont = (fun () -> ctxt.cont b); aux = ctxt.aux } + let ctxt = AsyncActivation { cont = (fun () -> ctxt.cont b); aux = ctxt.aux } CallThenContinue ctxt finallyFunction () // The new exception continuation runs the finallyFunction and then runs the previous exception continuation. // If an exception is thrown we continue with the previous exception continuation. let econt exn = - let ctxt = { cont = (fun () -> ctxt.aux.econt exn); aux = ctxt.aux } + let ctxt = AsyncActivation { cont = (fun () -> ctxt.econt exn); aux = ctxt.aux } CallThenContinue ctxt finallyFunction () // The cancellation continuation runs the finallyFunction and then runs the previous cancellation continuation. // If an exception is thrown we continue with the previous cancellation continuation (the exception is lost) let ccont cexn = - let ctxt = { cont = (fun () -> ctxt.aux.ccont cexn); aux = { ctxt.aux with econt = (fun _ -> ctxt.aux.ccont cexn) } } + let ctxt = AsyncActivation { cont = (fun () -> ctxt.ccont cexn); aux = { ctxt.aux with econt = (fun _ -> ctxt.ccont cexn) } } CallThenContinue ctxt finallyFunction () - computation.Invoke { ctxt with cont = cont; aux = { ctxt.aux with econt = econt; ccont = ccont } } + let newCtxt = AsyncActivation { ctxt.Contents with cont = cont; aux = { ctxt.aux with econt = econt; ccont = ccont } } + computation.Invoke newCtxt // Re-route the exception continuation to call to catchFunction. If catchFunction or the new process fail // then call the original exception continuation with the failure. @@ -526,7 +536,7 @@ namespace Microsoft.FSharp.Control ctxt.OnCancellation () else let econt (edi: ExceptionDispatchInfo) = CallTryWithFilterFunction ctxt edi catchFunction - let newCtxt = { ctxt with aux = { ctxt.aux with econt = econt } } + let newCtxt = AsyncActivation { ctxt.Contents with aux = { ctxt.aux with econt = econt } } computation.Invoke newCtxt /// Internal way of making an async from code, for exact code compat. @@ -541,7 +551,7 @@ namespace Microsoft.FSharp.Control match res with | AsyncResult.Ok r -> ctxt.cont r | AsyncResult.Error edi -> ctxt.CallExceptionContinuation edi - | AsyncResult.Canceled oce -> ctxt.aux.ccont oce) + | AsyncResult.Canceled oce -> ctxt.ccont oce) // Generate async computation which calls its continuation with the given result let inline CreateReturnAsync res = @@ -597,9 +607,9 @@ namespace Microsoft.FSharp.Control MakeAsync (fun ctxt -> let aux = ctxt.aux let ccont exn = - let ctxt = { cont = (fun _ -> aux.ccont exn); aux = { aux with econt = (fun _ -> aux.ccont exn) } } - CallThenContinue ctxt finallyFunction exn - let newCtxt = { ctxt with aux = { aux with ccont = ccont } } + let finallyCtxt = AsyncActivation { cont = (fun _ -> aux.ccont exn); aux = { aux with econt = (fun _ -> aux.ccont exn) } } + CallThenContinue finallyCtxt finallyFunction exn + let newCtxt = AsyncActivation { ctxt.Contents with aux = { aux with ccont = ccont } } computation.Invoke newCtxt) /// A single pre-allocated computation that fetched the current cancellation token @@ -649,18 +659,18 @@ namespace Microsoft.FSharp.Control CreateProtectedAsync (fun ctxt -> ctxt.aux.trampolineHolder.QueueWorkItemWithTrampoline ctxt.cont) - let delimitSyncContext ctxt = + let delimitSyncContext (ctxt: AsyncActivation<_>) = match SynchronizationContext.Current with | null -> ctxt | syncCtxt -> let aux = ctxt.aux let trampolineHolder = aux.trampolineHolder - { ctxt with - cont = (fun x -> trampolineHolder.PostWithTrampoline syncCtxt (fun () -> ctxt.cont x)) - aux = { aux with - econt = (fun x -> trampolineHolder.PostWithTrampoline syncCtxt (fun () -> aux.econt x)) - ccont = (fun x -> trampolineHolder.PostWithTrampoline syncCtxt (fun () -> aux.ccont x)) } - } + AsyncActivation + { ctxt.Contents with + cont = (fun x -> trampolineHolder.PostWithTrampoline syncCtxt (fun () -> ctxt.cont x)) + aux = { aux with + econt = (fun x -> trampolineHolder.PostWithTrampoline syncCtxt (fun () -> aux.econt x)) + ccont = (fun x -> trampolineHolder.PostWithTrampoline syncCtxt (fun () -> aux.ccont x)) } } // When run, ensures that each of the continuations of the process are run in the same synchronization context. let CreateDelimitedUserCodeAsync f = @@ -975,7 +985,7 @@ namespace Microsoft.FSharp.Control task // Helper to attach continuation to the given task. - let taskContinueWith (task : Task<'T>) ctxt useCcontForTaskCancellation = + let taskContinueWith (task : Task<'T>) (ctxt: AsyncActivation<'T>) useCcontForTaskCancellation = let continuation (completedTask: Task<_>) : unit = ctxt.aux.trampolineHolder.ExecuteWithTrampoline (fun () -> @@ -994,7 +1004,7 @@ namespace Microsoft.FSharp.Control task.ContinueWith(Action>(continuation)) |> ignore |> fake [] - let taskContinueWithUnit (task: Task) ctxt useCcontForTaskCancellation = + let taskContinueWithUnit (task: Task) (ctxt: AsyncActivation) useCcontForTaskCancellation = let continuation (completedTask: Task) : unit = ctxt.aux.trampolineHolder.ExecuteWithTrampoline (fun () -> @@ -1184,7 +1194,7 @@ namespace Microsoft.FSharp.Control MakeAsync (fun ctxt -> let cont = (Choice1Of2 >> ctxt.cont) let econt (edi: ExceptionDispatchInfo) = ctxt.cont (Choice2Of2 (edi.GetAssociatedSourceException())) - let ctxt = { cont = cont; aux = { ctxt.aux with econt = econt } } + let ctxt = AsyncActivation { cont = cont; aux = { ctxt.aux with econt = econt } } computation.Invoke ctxt) static member RunSynchronously (computation: Async<'T>,?timeout,?cancellationToken:CancellationToken) = diff --git a/src/fsharp/FSharp.Core/control.fsi b/src/fsharp/FSharp.Core/control.fsi index 90702508604..ae5eee68930 100644 --- a/src/fsharp/FSharp.Core/control.fsi +++ b/src/fsharp/FSharp.Core/control.fsi @@ -27,9 +27,7 @@ namespace Microsoft.FSharp.Control /// computation expressions can check the cancellation condition regularly. Synchronous /// computations within an asynchronous computation do not automatically check this condition. - [] - [] - [] + [] type Async<'T> /// This static class holds members for creating and manipulating asynchronous computations. @@ -435,7 +433,7 @@ namespace Microsoft.FSharp.Control type AsyncReturn /// The F# compiler emits references to this type to implement F# async expressions. - [] + [] type AsyncActivation<'T> = /// The F# compiler emits calls to this function to implement F# async expressions. From 1b08d5aac75dc82fc534e27d465d89aee89f64b6 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Fri, 11 May 2018 18:11:50 +0100 Subject: [PATCH 32/39] simplify code --- src/fsharp/FSharp.Core/control.fs | 132 ++++++++++++++---------------- 1 file changed, 63 insertions(+), 69 deletions(-) diff --git a/src/fsharp/FSharp.Core/control.fs b/src/fsharp/FSharp.Core/control.fs index 0573423da5a..da7cf5b10ab 100644 --- a/src/fsharp/FSharp.Core/control.fs +++ b/src/fsharp/FSharp.Core/control.fs @@ -285,22 +285,34 @@ namespace Microsoft.FSharp.Control [] /// Represents rarely changing components of an in-flight async computation type AsyncActivationAux = - { token : CancellationToken + { /// The active cancellation token + token : CancellationToken + /// The exception continuation econt : econt + /// The cancellation continuation ccont : ccont + /// Holds some commonly-allocated callbacks and a mutable location to use for a trampoline trampolineHolder : TrampolineHolder } [] [] - /// Represents an in-flight async computation + /// Represents context for an in-flight async computation type AsyncActivationContents<'T> = - { cont : cont<'T> + { /// The success continuation + cont : cont<'T> + /// The rarely changing components aux : AsyncActivationAux } + /// A struct wrapper around AsyncActivationContents. Using a struct wrapper allows us to change representation of the + /// contents at a later point, e.g. to change the contents to a .NET Task or some other representation. [] type AsyncActivation<'T>(contents: AsyncActivationContents<'T>) = - member ctxt.Contents = contents + member ctxt.WithCancellationContinuation ccont = AsyncActivation<_> { contents with aux = { ctxt.aux with ccont = ccont } } + member ctxt.WithExceptionContinuation econt = AsyncActivation<_> { contents with aux = { ctxt.aux with econt = econt } } + member ctxt.WithContinuation(cont) = AsyncActivation<_> { cont = cont; aux = contents.aux } + member ctxt.WithContinuations(cont, econt) = AsyncActivation<_> { cont = cont; aux = { contents.aux with econt = econt } } + member ctxt.WithContinuations(cont, econt, ccont) = AsyncActivation<_> { contents with cont = cont; aux = { ctxt.aux with econt = econt; ccont = ccont } } member ctxt.aux = contents.aux member ctxt.cont = contents.cont member ctxt.econt = contents.aux.econt @@ -329,6 +341,11 @@ namespace Microsoft.FSharp.Control member ctxt.OnExceptionRaised() = contents.aux.trampolineHolder.OnExceptionRaised contents.aux.econt + /// Make an initial async activation. + static member Create cancellationToken trampolineHolder cont econt ccont : AsyncActivation<'T> = + AsyncActivation { cont = cont; aux = { token = cancellationToken; econt = econt; ccont = ccont; trampolineHolder = trampolineHolder } } + + [] [] type Async<'T> = @@ -384,7 +401,7 @@ namespace Microsoft.FSharp.Control /// Apply userCode to x. If no exception is raised then call the normal continuation. Used to implement /// 'finally' and 'when cancelled'. [] - let CallThenContinue (ctxt: AsyncActivation<_>) userCode arg : AsyncReturn = + let CallThenContinue userCode arg (ctxt: AsyncActivation<_>) : AsyncReturn = let mutable result = Unchecked.defaultof<_> let mutable ok = false @@ -441,7 +458,7 @@ namespace Microsoft.FSharp.Control /// Apply 'catchFilter' to 'arg'. If the result is 'Some' invoke the resulting computation. If the result is 'None' /// then send 'result1' to the exception continuation. [] - let CallThenInvokeFilter (ctxt: AsyncActivation<_>) catchFilter (edi: ExceptionDispatchInfo) : AsyncReturn = + let CallFilterThenInvoke (ctxt: AsyncActivation<'T>) catchFilter (edi: ExceptionDispatchInfo) : AsyncReturn = let mutable resOpt = Unchecked.defaultof<_> let mutable ok = false @@ -465,7 +482,7 @@ namespace Microsoft.FSharp.Control /// Perform a cancellation check and ensure that any exceptions raised by /// the immediate execution of "userCode" are sent to the exception continuation. [] - let ProtectedCode (ctxt: AsyncActivation<_>) userCode = + let ProtectedCode (ctxt: AsyncActivation<'T>) userCode = if ctxt.IsCancellationRequested then ctxt.OnCancellation () else @@ -478,11 +495,6 @@ namespace Microsoft.FSharp.Control if not ok then ctxt.OnExceptionRaised() - /// Make an initial asyc activation. - [] - let CreateAsyncActivation cancellationToken trampolineHolder cont econt ccont = - AsyncActivation { cont = cont; aux = { token = cancellationToken; econt = econt; ccont = ccont; trampolineHolder = trampolineHolder } } - /// Build a primitive without any exception or resync protection let MakeAsync body = { Invoke = body } @@ -492,51 +504,42 @@ namespace Microsoft.FSharp.Control if ctxt.IsCancellationRequested then ctxt.OnCancellation () else - let cont result1 = CallThenInvokeNoHijackCheck ctxt part2 result1 - let ctxt2 = AsyncActivation { cont=cont; aux = ctxt.aux } - Invoke part1 ctxt2 - - /// Execute the with-filter part of a try-with-filer but first check for trampoline and cancellation. - // - // Note: direct calls to this function end up in user assemblies via inlining - let CallTryWithFilterFunction (ctxt: AsyncActivation<'T>) result1 (part2: Exception -> Async<'T> option) = - if ctxt.IsCancellationRequested then - ctxt.OnCancellation () - else - CallThenInvokeFilter ctxt part2 result1 + Invoke part1 (ctxt.WithContinuation(fun result1 -> CallThenInvokeNoHijackCheck ctxt part2 result1 )) [] + /// Re-route all continuations to execute the finally function. let TryFinally (ctxt: AsyncActivation<'T>) computation finallyFunction = if ctxt.IsCancellationRequested then ctxt.OnCancellation () else // The new continuation runs the finallyFunction and resumes the old continuation // If an exception is thrown we continue with the previous exception continuation. - let cont b = - let ctxt = AsyncActivation { cont = (fun () -> ctxt.cont b); aux = ctxt.aux } - CallThenContinue ctxt finallyFunction () + let cont result = + CallThenContinue finallyFunction () (ctxt.WithContinuation(fun () -> ctxt.cont result)) // The new exception continuation runs the finallyFunction and then runs the previous exception continuation. // If an exception is thrown we continue with the previous exception continuation. let econt exn = - let ctxt = AsyncActivation { cont = (fun () -> ctxt.econt exn); aux = ctxt.aux } - CallThenContinue ctxt finallyFunction () + CallThenContinue finallyFunction () (ctxt.WithContinuation(fun () -> ctxt.econt exn)) // The cancellation continuation runs the finallyFunction and then runs the previous cancellation continuation. // If an exception is thrown we continue with the previous cancellation continuation (the exception is lost) let ccont cexn = - let ctxt = AsyncActivation { cont = (fun () -> ctxt.ccont cexn); aux = { ctxt.aux with econt = (fun _ -> ctxt.ccont cexn) } } - CallThenContinue ctxt finallyFunction () - let newCtxt = AsyncActivation { ctxt.Contents with cont = cont; aux = { ctxt.aux with econt = econt; ccont = ccont } } + CallThenContinue finallyFunction () (ctxt.WithContinuations(cont=(fun () -> ctxt.ccont cexn), econt = (fun _ -> ctxt.ccont cexn))) + let newCtxt = ctxt.WithContinuations(cont=cont, econt=econt, ccont=ccont) computation.Invoke newCtxt - // Re-route the exception continuation to call to catchFunction. If catchFunction or the new process fail - // then call the original exception continuation with the failure. + /// Re-route the exception continuation to call to catchFunction. If catchFunction returns None then call the exception continuation. + /// If it returns Some, invoke the resulting async. [] let TryWith (ctxt: AsyncActivation<'T>) computation catchFunction = if ctxt.IsCancellationRequested then ctxt.OnCancellation () else - let econt (edi: ExceptionDispatchInfo) = CallTryWithFilterFunction ctxt edi catchFunction - let newCtxt = AsyncActivation { ctxt.Contents with aux = { ctxt.aux with econt = econt } } + let newCtxt = + ctxt.WithExceptionContinuation(fun edi -> + if ctxt.IsCancellationRequested then + ctxt.OnCancellation () + else + CallFilterThenInvoke ctxt catchFunction edi) computation.Invoke newCtxt /// Internal way of making an async from code, for exact code compat. @@ -585,31 +588,26 @@ namespace Microsoft.FSharp.Control // Note: this code ends up in user assemblies via inlining CreateBindAsync part1 (fun () -> part2) - // Call p but augment the normal, exception and cancel continuations with a call to finallyFunction. - // If the finallyFunction raises an exception then call the original exception continuation - // with the new exception. If exception is raised after a cancellation, exception is ignored - // and cancel continuation is called. + /// Create an async for a try/finally let inline CreateTryFinallyAsync finallyFunction computation = MakeAsync (fun ctxt -> TryFinally ctxt computation finallyFunction) - // Re-route the exception continuation to call to catchFunction. If catchFunction or the new process fail - // then call the original exception continuation with the failure. + /// Create an async for a try/with filtering exceptions through a pattern match let inline CreateTryWithFilterAsync catchFunction computation = MakeAsync (fun ctxt -> TryWith ctxt computation (fun edi -> catchFunction edi)) - // Re-route the exception continuation to call to catchFunction. If catchFunction or the new process fail - // then call the original exception continuation with the failure. + /// Create an async for a try/with filtering let inline CreateTryWithAsync catchFunction computation = CreateTryWithFilterAsync (fun exn -> Some (catchFunction exn)) computation - /// Call the finallyFunction if the computation results in a cancellation + /// Call the finallyFunction if the computation results in a cancellation, and then continue with cancellation. + /// If the finally function gives an exception then continue with cancellation regardless. let CreateWhenCancelledAsync (finallyFunction : OperationCanceledException -> unit) computation = MakeAsync (fun ctxt -> - let aux = ctxt.aux - let ccont exn = - let finallyCtxt = AsyncActivation { cont = (fun _ -> aux.ccont exn); aux = { aux with econt = (fun _ -> aux.ccont exn) } } - CallThenContinue finallyCtxt finallyFunction exn - let newCtxt = AsyncActivation { ctxt.Contents with aux = { aux with ccont = ccont } } + let ccont = ctxt.ccont + let newCtxt = + ctxt.WithCancellationContinuation(fun exn -> + CallThenContinue finallyFunction exn (ctxt.WithContinuations(cont = (fun _ -> ccont exn), econt = (fun _ -> ccont exn)))) computation.Invoke newCtxt) /// A single pre-allocated computation that fetched the current cancellation token @@ -659,23 +657,19 @@ namespace Microsoft.FSharp.Control CreateProtectedAsync (fun ctxt -> ctxt.aux.trampolineHolder.QueueWorkItemWithTrampoline ctxt.cont) - let delimitSyncContext (ctxt: AsyncActivation<_>) = + /// Post back to the sync context regardless of which continuation is taken + let DelimitSyncContext (ctxt: AsyncActivation<_>) = match SynchronizationContext.Current with | null -> ctxt | syncCtxt -> - let aux = ctxt.aux - let trampolineHolder = aux.trampolineHolder - AsyncActivation - { ctxt.Contents with - cont = (fun x -> trampolineHolder.PostWithTrampoline syncCtxt (fun () -> ctxt.cont x)) - aux = { aux with - econt = (fun x -> trampolineHolder.PostWithTrampoline syncCtxt (fun () -> aux.econt x)) - ccont = (fun x -> trampolineHolder.PostWithTrampoline syncCtxt (fun () -> aux.ccont x)) } } + ctxt.WithContinuations(cont = (fun x -> ctxt.aux.trampolineHolder.PostWithTrampoline syncCtxt (fun () -> ctxt.cont x)), + econt = (fun x -> ctxt.aux.trampolineHolder.PostWithTrampoline syncCtxt (fun () -> ctxt.aux.econt x)), + ccont = (fun x -> ctxt.aux.trampolineHolder.PostWithTrampoline syncCtxt (fun () -> ctxt.aux.ccont x))) // When run, ensures that each of the continuations of the process are run in the same synchronization context. let CreateDelimitedUserCodeAsync f = CreateProtectedAsync (fun ctxt -> - let ctxtWithSync = delimitSyncContext ctxt + let ctxtWithSync = DelimitSyncContext ctxt f ctxtWithSync) [] @@ -871,7 +865,7 @@ namespace Microsoft.FSharp.Control let QueueAsync cancellationToken cont econt ccont computation = let trampolineHolder = new TrampolineHolder() trampolineHolder.QueueWorkItemWithTrampoline (fun () -> - let ctxt = CreateAsyncActivation cancellationToken trampolineHolder cont econt ccont + let ctxt = AsyncActivation.Create cancellationToken trampolineHolder cont econt ccont computation.Invoke ctxt) /// Run the asynchronous workflow and wait for its result. @@ -918,7 +912,7 @@ namespace Microsoft.FSharp.Control trampolineHolder.ExecuteWithTrampoline (fun () -> let ctxt = - CreateAsyncActivation + AsyncActivation.Create cancellationToken trampolineHolder (fun res -> resultCell.RegisterResult(AsyncResult.Ok(res),reuseThread=true)) @@ -962,7 +956,7 @@ namespace Microsoft.FSharp.Control let StartWithContinuations cancellationToken (computation:Async<'T>) cont econt ccont = let trampolineHolder = new TrampolineHolder() trampolineHolder.ExecuteWithTrampoline (fun () -> - let ctxt = CreateAsyncActivation cancellationToken trampolineHolder (cont >> fake) (econt >> fake) (ccont >> fake) + let ctxt = AsyncActivation.Create cancellationToken trampolineHolder (cont >> fake) (econt >> fake) (ccont >> fake) computation.Invoke ctxt) |> unfake @@ -1192,10 +1186,10 @@ namespace Microsoft.FSharp.Control static member Catch (computation: Async<'T>) = MakeAsync (fun ctxt -> - let cont = (Choice1Of2 >> ctxt.cont) - let econt (edi: ExceptionDispatchInfo) = ctxt.cont (Choice2Of2 (edi.GetAssociatedSourceException())) - let ctxt = AsyncActivation { cont = cont; aux = { ctxt.aux with econt = econt } } - computation.Invoke ctxt) + // Turn the success or exception into data + let newCtxt = ctxt.WithContinuations(cont = (fun res -> ctxt.cont (Choice1Of2 res)), + econt = (fun edi -> ctxt.cont (Choice2Of2 (edi.GetAssociatedSourceException())))) + computation.Invoke newCtxt) static member RunSynchronously (computation: Async<'T>,?timeout,?cancellationToken:CancellationToken) = let timeout, cancellationToken = @@ -1234,7 +1228,7 @@ namespace Microsoft.FSharp.Control ctxt.cont [| |] else ProtectedCode ctxt (fun ctxt -> - let ctxtWithSync = delimitSyncContext ctxt // manually resync + let ctxtWithSync = DelimitSyncContext ctxt // manually resync let aux = ctxtWithSync.aux let count = ref tasks.Length let firstExn = ref None @@ -1298,7 +1292,7 @@ namespace Microsoft.FSharp.Control | Choice1Of2 [||] -> ctxt.cont None | Choice1Of2 computations -> ProtectedCode ctxt (fun ctxt -> - let ctxtWithSync = delimitSyncContext ctxt + let ctxtWithSync = DelimitSyncContext ctxt let aux = ctxtWithSync.aux let noneCount = ref 0 let exnCount = ref 0 From dc6707c805633d499fcaf60c754237addc11da59 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Fri, 11 May 2018 18:20:42 +0100 Subject: [PATCH 33/39] simplify code --- src/fsharp/FSharp.Core/control.fs | 117 ++++++++++++++++-------------- 1 file changed, 61 insertions(+), 56 deletions(-) diff --git a/src/fsharp/FSharp.Core/control.fs b/src/fsharp/FSharp.Core/control.fs index da7cf5b10ab..e3adc2fcdc7 100644 --- a/src/fsharp/FSharp.Core/control.fs +++ b/src/fsharp/FSharp.Core/control.fs @@ -309,15 +309,27 @@ namespace Microsoft.FSharp.Control type AsyncActivation<'T>(contents: AsyncActivationContents<'T>) = member ctxt.WithCancellationContinuation ccont = AsyncActivation<_> { contents with aux = { ctxt.aux with ccont = ccont } } + member ctxt.WithExceptionContinuation econt = AsyncActivation<_> { contents with aux = { ctxt.aux with econt = econt } } + member ctxt.WithContinuation(cont) = AsyncActivation<_> { cont = cont; aux = contents.aux } + member ctxt.WithContinuations(cont, econt) = AsyncActivation<_> { cont = cont; aux = { contents.aux with econt = econt } } + member ctxt.WithContinuations(cont, econt, ccont) = AsyncActivation<_> { contents with cont = cont; aux = { ctxt.aux with econt = econt; ccont = ccont } } + member ctxt.aux = contents.aux + member ctxt.cont = contents.cont + member ctxt.econt = contents.aux.econt + member ctxt.ccont = contents.aux.ccont + member ctxt.token = contents.aux.token + + member ctxt.trampolineHolder = contents.aux.trampolineHolder + member ctxt.IsCancellationRequested = contents.aux.token.IsCancellationRequested /// Call the cancellation continuation of the active computation @@ -647,24 +659,24 @@ namespace Microsoft.FSharp.Control let CreateSwitchToAsync (syncCtxt: SynchronizationContext) = CreateProtectedAsync (fun ctxt -> - ctxt.aux.trampolineHolder.PostWithTrampoline syncCtxt ctxt.cont) + ctxt.trampolineHolder.PostWithTrampoline syncCtxt ctxt.cont) let CreateSwitchToNewThreadAsync() = CreateProtectedAsync (fun ctxt -> - ctxt.aux.trampolineHolder.StartThreadWithTrampoline ctxt.cont) + ctxt.trampolineHolder.StartThreadWithTrampoline ctxt.cont) let CreateSwitchToThreadPoolAsync() = CreateProtectedAsync (fun ctxt -> - ctxt.aux.trampolineHolder.QueueWorkItemWithTrampoline ctxt.cont) + ctxt.trampolineHolder.QueueWorkItemWithTrampoline ctxt.cont) /// Post back to the sync context regardless of which continuation is taken let DelimitSyncContext (ctxt: AsyncActivation<_>) = match SynchronizationContext.Current with | null -> ctxt | syncCtxt -> - ctxt.WithContinuations(cont = (fun x -> ctxt.aux.trampolineHolder.PostWithTrampoline syncCtxt (fun () -> ctxt.cont x)), - econt = (fun x -> ctxt.aux.trampolineHolder.PostWithTrampoline syncCtxt (fun () -> ctxt.aux.econt x)), - ccont = (fun x -> ctxt.aux.trampolineHolder.PostWithTrampoline syncCtxt (fun () -> ctxt.aux.ccont x))) + ctxt.WithContinuations(cont = (fun x -> ctxt.trampolineHolder.PostWithTrampoline syncCtxt (fun () -> ctxt.cont x)), + econt = (fun x -> ctxt.trampolineHolder.PostWithTrampoline syncCtxt (fun () -> ctxt.econt x)), + ccont = (fun x -> ctxt.trampolineHolder.PostWithTrampoline syncCtxt (fun () -> ctxt.ccont x))) // When run, ensures that each of the continuations of the process are run in the same synchronization context. let CreateDelimitedUserCodeAsync f = @@ -683,7 +695,7 @@ namespace Microsoft.FSharp.Control | null -> null // saving a thread-local access | _ -> Thread.CurrentThread - let trampolineHolder = ctxt.aux.trampolineHolder + let trampolineHolder = ctxt.trampolineHolder member __.ContinueImmediate res = let action () = ctxt.cont res @@ -982,7 +994,7 @@ namespace Microsoft.FSharp.Control let taskContinueWith (task : Task<'T>) (ctxt: AsyncActivation<'T>) useCcontForTaskCancellation = let continuation (completedTask: Task<_>) : unit = - ctxt.aux.trampolineHolder.ExecuteWithTrampoline (fun () -> + ctxt.trampolineHolder.ExecuteWithTrampoline (fun () -> if completedTask.IsCanceled then if useCcontForTaskCancellation then ctxt.OnCancellation () @@ -1001,7 +1013,7 @@ namespace Microsoft.FSharp.Control let taskContinueWithUnit (task: Task) (ctxt: AsyncActivation) useCcontForTaskCancellation = let continuation (completedTask: Task) : unit = - ctxt.aux.trampolineHolder.ExecuteWithTrampoline (fun () -> + ctxt.trampolineHolder.ExecuteWithTrampoline (fun () -> if completedTask.IsCanceled then if useCcontForTaskCancellation then ctxt.OnCancellation () @@ -1148,22 +1160,21 @@ namespace Microsoft.FSharp.Control let mutable contToTailCall = None let thread = Thread.CurrentThread let latch = Latch() - let aux = ctxt.aux let once cont x = if not(latch.Enter()) then invalidOp(SR.GetString(SR.controlContinuationInvokedMultipleTimes)) if Thread.CurrentThread.Equals(thread) && underCurrentThreadStack then contToTailCall <- Some(fun () -> cont x) else if Trampoline.ThisThreadHasTrampoline then let syncCtxt = SynchronizationContext.Current - aux.trampolineHolder.PostOrQueueWithTrampoline syncCtxt (fun () -> cont x) |> unfake + ctxt.trampolineHolder.PostOrQueueWithTrampoline syncCtxt (fun () -> cont x) |> unfake else - aux.trampolineHolder.ExecuteWithTrampoline (fun () -> cont x ) |> unfake + ctxt.trampolineHolder.ExecuteWithTrampoline (fun () -> cont x ) |> unfake try - callback (once ctxt.cont, (fun exn -> once aux.econt (ExceptionDispatchInfo.RestoreOrCapture(exn))), once aux.ccont) + callback (once ctxt.cont, (fun exn -> once ctxt.econt (ExceptionDispatchInfo.RestoreOrCapture(exn))), once ctxt.ccont) with exn -> if not(latch.Enter()) then invalidOp(SR.GetString(SR.controlContinuationInvokedMultipleTimes)) let edi = ExceptionDispatchInfo.RestoreOrCapture(exn) - aux.econt edi |> unfake + ctxt.econt edi |> unfake underCurrentThreadStack <- false @@ -1229,21 +1240,19 @@ namespace Microsoft.FSharp.Control else ProtectedCode ctxt (fun ctxt -> let ctxtWithSync = DelimitSyncContext ctxt // manually resync - let aux = ctxtWithSync.aux - let count = ref tasks.Length - let firstExn = ref None + let mutable count = tasks.Length + let mutable firstExn = None let results = Array.zeroCreate tasks.Length // Attempt to cancel the individual operations if an exception happens on any of the other threads - let innerCTS = new LinkedSubSource(aux.token) - let trampolineHolder = aux.trampolineHolder + let innerCTS = new LinkedSubSource(ctxtWithSync.token) let finishTask(remaining) = if (remaining = 0) then innerCTS.Dispose() - match (!firstExn) with - | None -> trampolineHolder.ExecuteWithTrampoline (fun () -> ctxtWithSync.cont results) - | Some (Choice1Of2 exn) -> trampolineHolder.ExecuteWithTrampoline (fun () -> aux.econt exn) - | Some (Choice2Of2 cexn) -> trampolineHolder.ExecuteWithTrampoline (fun () -> aux.ccont cexn) + match firstExn with + | None -> ctxtWithSync.trampolineHolder.ExecuteWithTrampoline (fun () -> ctxtWithSync.cont results) + | Some (Choice1Of2 exn) -> ctxtWithSync.trampolineHolder.ExecuteWithTrampoline (fun () -> ctxtWithSync.econt exn) + | Some (Choice2Of2 cexn) -> ctxtWithSync.trampolineHolder.ExecuteWithTrampoline (fun () -> ctxtWithSync.ccont cexn) else Unchecked.defaultof @@ -1251,22 +1260,22 @@ namespace Microsoft.FSharp.Control // as soon as 0 is reached dispose innerCancellationSource let recordSuccess i res = - results.[i] <- res; - finishTask(Interlocked.Decrement count) + results.[i] <- res + finishTask(Interlocked.Decrement &count) let recordFailure exn = // capture first exception and then decrement the counter to avoid race when // - thread 1 decremented counter and preempted by the scheduler // - thread 2 decremented counter and called finishTask // since exception is not yet captured - finishtask will fall into success branch - match Interlocked.CompareExchange(firstExn, Some exn, None) with + match Interlocked.CompareExchange(&firstExn, Some exn, None) with | None -> // signal cancellation before decrementing the counter - this guarantees that no other thread can sneak to finishTask and dispose innerCTS // NOTE: Cancel may introduce reentrancy - i.e. when handler registered for the cancellation token invokes cancel continuation that will call 'recordFailure' // to correctly handle this we need to return decremented value, not the current value of 'count' otherwise we may invoke finishTask with value '0' several times innerCTS.Cancel() | _ -> () - finishTask(Interlocked.Decrement count) + finishTask(Interlocked.Decrement &count) tasks |> Array.iteri (fun i p -> QueueAsync @@ -1278,7 +1287,7 @@ namespace Microsoft.FSharp.Control // on cancellation... (fun cexn -> recordFailure (Choice2Of2 cexn)) p - |> unfake); + |> unfake) Unchecked.defaultof)) static member Choice(computations : Async<'T option> seq) : Async<'T option> = @@ -1293,35 +1302,33 @@ namespace Microsoft.FSharp.Control | Choice1Of2 computations -> ProtectedCode ctxt (fun ctxt -> let ctxtWithSync = DelimitSyncContext ctxt - let aux = ctxtWithSync.aux let noneCount = ref 0 let exnCount = ref 0 - let innerCts = new LinkedSubSource(aux.token) - let trampolineHolder = aux.trampolineHolder + let innerCts = new LinkedSubSource(ctxtWithSync.token) let scont (result : 'T option) = match result with | Some _ -> if Interlocked.Increment exnCount = 1 then - innerCts.Cancel(); trampolineHolder.ExecuteWithTrampoline (fun () -> ctxtWithSync.cont result) + innerCts.Cancel(); ctxtWithSync.trampolineHolder.ExecuteWithTrampoline (fun () -> ctxtWithSync.cont result) else Unchecked.defaultof | None -> if Interlocked.Increment noneCount = computations.Length then - innerCts.Cancel(); trampolineHolder.ExecuteWithTrampoline (fun () -> ctxtWithSync.cont None) + innerCts.Cancel(); ctxtWithSync.trampolineHolder.ExecuteWithTrampoline (fun () -> ctxtWithSync.cont None) else Unchecked.defaultof let econt (exn : ExceptionDispatchInfo) = if Interlocked.Increment exnCount = 1 then - innerCts.Cancel(); trampolineHolder.ExecuteWithTrampoline (fun () -> ctxtWithSync.aux.econt exn) + innerCts.Cancel(); ctxtWithSync.trampolineHolder.ExecuteWithTrampoline (fun () -> ctxtWithSync.econt exn) else Unchecked.defaultof let ccont (exn : OperationCanceledException) = if Interlocked.Increment exnCount = 1 then - innerCts.Cancel(); trampolineHolder.ExecuteWithTrampoline (fun () -> ctxtWithSync.aux.ccont exn) + innerCts.Cancel(); ctxtWithSync.trampolineHolder.ExecuteWithTrampoline (fun () -> ctxtWithSync.ccont exn) else Unchecked.defaultof @@ -1346,8 +1353,8 @@ namespace Microsoft.FSharp.Control let task = ts.Task Async.StartWithContinuations( computation, - (fun (k) -> ts.SetResult(k)), - (fun exn -> ts.SetException(exn)), + (fun k -> ts.SetResult k), + (fun exn -> ts.SetException exn), (fun _ -> ts.SetCanceled()), cancellationToken) task @@ -1358,50 +1365,48 @@ namespace Microsoft.FSharp.Control static member Sleep(millisecondsDueTime) : Async = CreateDelimitedUserCodeAsync (fun ctxt -> - let aux = ctxt.aux - let timer = ref (None : Timer option) - let savedCont = ctxt.cont - let savedCCont = aux.ccont + let mutable timer = None : Timer option + let cont = ctxt.cont + let ccont = ctxt.ccont let latch = new Latch() let registration = - aux.token.Register( + ctxt.token.Register( (fun _ -> if latch.Enter() then - match !timer with + match timer with | None -> () | Some t -> t.Dispose() - aux.trampolineHolder.ExecuteWithTrampoline (fun () -> savedCCont(new OperationCanceledException(aux.token))) |> unfake - ), + ctxt.trampolineHolder.ExecuteWithTrampoline (fun () -> ccont(new OperationCanceledException(ctxt.token))) |> unfake), null) let mutable edi = null try - timer := new Timer((fun _ -> + timer <- new Timer((fun _ -> if latch.Enter() then // NOTE: If the CTS for the token would have been disposed, disposal of the registration would throw // However, our contract is that until async computation ceases execution (and invokes ccont) // the CTS will not be disposed. Execution of savedCCont is guarded by latch, so we are safe unless // user violates the contract. registration.Dispose() - // Try to Dispose of the TImer. + // Try to Dispose of the Timer. // Note: there is a race here: the Timer time very occasionally // calls the callback _before_ the timer object has been recorded anywhere. This makes it difficult to dispose the // timer in this situation. In this case we just let the timer be collected by finalization. - match !timer with + match timer with | None -> () | Some t -> t.Dispose() // Now we're done, so call the continuation - aux.trampolineHolder.ExecuteWithTrampoline (fun () -> savedCont()) |> unfake), + ctxt.trampolineHolder.ExecuteWithTrampoline (fun () -> cont()) |> unfake), null, dueTime=millisecondsDueTime, period = -1) |> Some with exn -> if latch.Enter() then - edi <- ExceptionDispatchInfo.RestoreOrCapture(exn) // post exception to econt only if we successfully enter the latch (no other continuations were called) + // post exception to econt only if we successfully enter the latch (no other continuations were called) + edi <- ExceptionDispatchInfo.RestoreOrCapture(exn) match edi with | null -> Unchecked.defaultof | _ -> - aux.econt edi - ) + ctxt.econt edi) /// Wait for a wait handle. Both timeout and cancellation are supported static member AwaitWaitHandle(waitHandle: WaitHandle, ?millisecondsTimeout:int) = @@ -1432,7 +1437,7 @@ namespace Microsoft.FSharp.Control match !rwh with | None -> () | Some rwh -> rwh.Unregister(null) |> ignore) - Async.Start (async { do (aux.ccont (OperationCanceledException(aux.token)) |> unfake) })) + Async.Start (async { do (ctxt.ccont (OperationCanceledException(aux.token)) |> unfake) })) and registration : CancellationTokenRegistration = aux.token.Register(cancelHandler, null) @@ -1446,7 +1451,7 @@ namespace Microsoft.FSharp.Control lock rwh (fun () -> rwh.Value.Value.Unregister(null) |> ignore) rwh := None registration.Dispose() - aux.trampolineHolder.ExecuteWithTrampoline (fun () -> savedCont (not timeOut)) |> unfake), + ctxt.trampolineHolder.ExecuteWithTrampoline (fun () -> savedCont (not timeOut)) |> unfake), state=null, millisecondsTimeOutInterval=millisecondsTimeout, executeOnlyOnce=true)); @@ -1472,7 +1477,7 @@ namespace Microsoft.FSharp.Control (match result with | Ok v -> ctxt.cont v | Error exn -> ctxt.CallExceptionContinuation exn - | Canceled exn -> ctxt.aux.ccont exn) ) + | Canceled exn -> ctxt.ccont exn) ) /// Await and use the result of a result cell. The resulting async doesn't support cancellation /// or timeout directly, rather the underlying computation must fill the result if cancellation @@ -1897,7 +1902,7 @@ namespace Microsoft.FSharp.Control lock syncRoot (fun () -> if arrivals.Count = 0 then // OK, no arrival so deschedule - savedCont <- Some(ctxt.cont, ctxt.aux.trampolineHolder); + savedCont <- Some(ctxt.cont, ctxt.trampolineHolder); true else false) From 4549b0fa34d55888864b75261c7bd826309c953a Mon Sep 17 00:00:00 2001 From: Don Syme Date: Fri, 11 May 2018 19:16:10 +0100 Subject: [PATCH 34/39] update baselines --- .../AsyncExpressionSteppingTest1.il.bsl | 4 +- .../AsyncExpressionSteppingTest2.il.bsl | 4 +- .../AsyncExpressionSteppingTest3.il.bsl | 25 +- .../AsyncExpressionSteppingTest4.il.bsl | 35 ++- .../AsyncExpressionSteppingTest5.il.bsl | 46 ++-- .../AsyncExpressionSteppingTest6.il.bsl | 214 ++++++------------ 6 files changed, 122 insertions(+), 206 deletions(-) diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/AsyncExpressionStepping/AsyncExpressionSteppingTest1.il.bsl b/tests/fsharpqa/Source/CodeGen/EmittedIL/AsyncExpressionStepping/AsyncExpressionSteppingTest1.il.bsl index 574b6e6b939..3e69ae4967f 100644 --- a/tests/fsharpqa/Source/CodeGen/EmittedIL/AsyncExpressionStepping/AsyncExpressionSteppingTest1.il.bsl +++ b/tests/fsharpqa/Source/CodeGen/EmittedIL/AsyncExpressionStepping/AsyncExpressionSteppingTest1.il.bsl @@ -36,13 +36,13 @@ // Offset: 0x00000270 Length: 0x000000B1 } .module AsyncExpressionSteppingTest1.dll -// MVID: {5AF59393-6394-B5D4-A745-03839393F55A} +// MVID: {5AF5DDAE-6394-B5D4-A745-0383AEDDF55A} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x05030000 +// Image base: 0x02880000 // =============== CLASS MEMBERS DECLARATION =================== diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/AsyncExpressionStepping/AsyncExpressionSteppingTest2.il.bsl b/tests/fsharpqa/Source/CodeGen/EmittedIL/AsyncExpressionStepping/AsyncExpressionSteppingTest2.il.bsl index aba8526ee98..7bdb6a074c0 100644 --- a/tests/fsharpqa/Source/CodeGen/EmittedIL/AsyncExpressionStepping/AsyncExpressionSteppingTest2.il.bsl +++ b/tests/fsharpqa/Source/CodeGen/EmittedIL/AsyncExpressionStepping/AsyncExpressionSteppingTest2.il.bsl @@ -36,13 +36,13 @@ // Offset: 0x00000270 Length: 0x000000B1 } .module AsyncExpressionSteppingTest2.dll -// MVID: {5AF59393-6394-D499-A745-03839393F55A} +// MVID: {5AF5DDAE-6394-D499-A745-0383AEDDF55A} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x04A80000 +// Image base: 0x04520000 // =============== CLASS MEMBERS DECLARATION =================== diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/AsyncExpressionStepping/AsyncExpressionSteppingTest3.il.bsl b/tests/fsharpqa/Source/CodeGen/EmittedIL/AsyncExpressionStepping/AsyncExpressionSteppingTest3.il.bsl index ae5efc2bbfd..6dfebd88b1e 100644 --- a/tests/fsharpqa/Source/CodeGen/EmittedIL/AsyncExpressionStepping/AsyncExpressionSteppingTest3.il.bsl +++ b/tests/fsharpqa/Source/CodeGen/EmittedIL/AsyncExpressionStepping/AsyncExpressionSteppingTest3.il.bsl @@ -36,13 +36,13 @@ // Offset: 0x00000280 Length: 0x000000B1 } .module AsyncExpressionSteppingTest3.dll -// MVID: {5AF59393-6394-F35E-A745-03839393F55A} +// MVID: {5AF5DDAE-6394-F35E-A745-0383AEDDF55A} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x031B0000 +// Image base: 0x04650000 // =============== CLASS MEMBERS DECLARATION =================== @@ -56,7 +56,7 @@ { .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 07 00 00 00 00 00 ) .class auto ansi serializable sealed nested assembly beforefieldinit 'f3@10-1' - extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn> + extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn> { .field public int32 'value' .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) @@ -70,7 +70,7 @@ // Code size 14 (0xe) .maxstack 8 IL_0000: ldarg.0 - IL_0001: call instance void class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>::.ctor() + IL_0001: call instance void class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>::.ctor() IL_0006: ldarg.0 IL_0007: ldarg.1 IL_0008: stfld int32 AsyncExpressionSteppingTest3/AsyncExpressionSteppingTest3/'f3@10-1'::'value' @@ -78,18 +78,17 @@ } // end of method 'f3@10-1'::.ctor .method public strict virtual instance class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn - Invoke(class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1 ctxt) cil managed + Invoke(valuetype [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1 ctxt) cil managed { - // Code size 15 (0xf) + // Code size 14 (0xe) .maxstack 8 .language '{AB4F38C9-B6E6-43BA-BE3B-58080B2CCCE3}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}' .line 10,10 : 17,25 'C:\\GitHub\\dsyme\\visualfsharp\\tests\\fsharpqa\\Source\\CodeGen\\EmittedIL\\AsyncExpressionStepping\\AsyncExpressionSteppingTest3.fs' - IL_0000: ldarg.1 - IL_0001: ldarg.0 - IL_0002: ldfld int32 AsyncExpressionSteppingTest3/AsyncExpressionSteppingTest3/'f3@10-1'::'value' - IL_0007: tail. - IL_0009: callvirt instance class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1::OnSuccess(!0) - IL_000e: ret + IL_0000: ldarga.s ctxt + IL_0002: ldarg.0 + IL_0003: ldfld int32 AsyncExpressionSteppingTest3/AsyncExpressionSteppingTest3/'f3@10-1'::'value' + IL_0008: call instance class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn valuetype [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1::OnSuccess(!0) + IL_000d: ret } // end of method 'f3@10-1'::Invoke } // end of class 'f3@10-1' @@ -158,7 +157,7 @@ IL_0034: ldloc.s V_4 IL_0036: newobj instance void AsyncExpressionSteppingTest3/AsyncExpressionSteppingTest3/'f3@10-1'::.ctor(int32) IL_003b: tail. - IL_003d: call class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::MakeAsync(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>) + IL_003d: call class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::MakeAsync(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>) IL_0042: ret } // end of method f3@5::Invoke diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/AsyncExpressionStepping/AsyncExpressionSteppingTest4.il.bsl b/tests/fsharpqa/Source/CodeGen/EmittedIL/AsyncExpressionStepping/AsyncExpressionSteppingTest4.il.bsl index 3c27376ba30..ce54bd4945d 100644 --- a/tests/fsharpqa/Source/CodeGen/EmittedIL/AsyncExpressionStepping/AsyncExpressionSteppingTest4.il.bsl +++ b/tests/fsharpqa/Source/CodeGen/EmittedIL/AsyncExpressionStepping/AsyncExpressionSteppingTest4.il.bsl @@ -36,13 +36,13 @@ // Offset: 0x00000280 Length: 0x000000B1 } .module AsyncExpressionSteppingTest4.dll -// MVID: {5AF59393-6394-6D4B-A745-03839393F55A} +// MVID: {5AF5DDAE-6394-6D4B-A745-0383AEDDF55A} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x03370000 +// Image base: 0x028F0000 // =============== CLASS MEMBERS DECLARATION =================== @@ -56,7 +56,7 @@ { .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 07 00 00 00 00 00 ) .class auto ansi serializable sealed nested assembly beforefieldinit 'f4@10-2' - extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn> + extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn> { .field public int32 'value' .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) @@ -70,7 +70,7 @@ // Code size 14 (0xe) .maxstack 8 IL_0000: ldarg.0 - IL_0001: call instance void class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>::.ctor() + IL_0001: call instance void class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>::.ctor() IL_0006: ldarg.0 IL_0007: ldarg.1 IL_0008: stfld int32 AsyncExpressionSteppingTest4/AsyncExpressionSteppingTest4/'f4@10-2'::'value' @@ -78,18 +78,17 @@ } // end of method 'f4@10-2'::.ctor .method public strict virtual instance class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn - Invoke(class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1 ctxt) cil managed + Invoke(valuetype [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1 ctxt) cil managed { - // Code size 15 (0xf) + // Code size 14 (0xe) .maxstack 8 .language '{AB4F38C9-B6E6-43BA-BE3B-58080B2CCCE3}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}' .line 10,10 : 21,29 'C:\\GitHub\\dsyme\\visualfsharp\\tests\\fsharpqa\\Source\\CodeGen\\EmittedIL\\AsyncExpressionStepping\\AsyncExpressionSteppingTest4.fs' - IL_0000: ldarg.1 - IL_0001: ldarg.0 - IL_0002: ldfld int32 AsyncExpressionSteppingTest4/AsyncExpressionSteppingTest4/'f4@10-2'::'value' - IL_0007: tail. - IL_0009: callvirt instance class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1::OnSuccess(!0) - IL_000e: ret + IL_0000: ldarga.s ctxt + IL_0002: ldarg.0 + IL_0003: ldfld int32 AsyncExpressionSteppingTest4/AsyncExpressionSteppingTest4/'f4@10-2'::'value' + IL_0008: call instance class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn valuetype [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1::OnSuccess(!0) + IL_000d: ret } // end of method 'f4@10-2'::Invoke } // end of class 'f4@10-2' @@ -155,7 +154,7 @@ IL_002a: ldloc.3 IL_002b: newobj instance void AsyncExpressionSteppingTest4/AsyncExpressionSteppingTest4/'f4@10-2'::.ctor(int32) IL_0030: tail. - IL_0032: call class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::MakeAsync(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>) + IL_0032: call class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::MakeAsync(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>) IL_0037: ret } // end of method 'f4@7-1'::Invoke @@ -201,7 +200,7 @@ } // end of class 'f4@12-3' .class auto ansi serializable sealed nested assembly beforefieldinit 'f4@6-4' - extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn> + extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn> { .field public class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 computation .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) @@ -220,7 +219,7 @@ // Code size 21 (0x15) .maxstack 8 IL_0000: ldarg.0 - IL_0001: call instance void class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>::.ctor() + IL_0001: call instance void class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>::.ctor() IL_0006: ldarg.0 IL_0007: ldarg.1 IL_0008: stfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 AsyncExpressionSteppingTest4/AsyncExpressionSteppingTest4/'f4@6-4'::computation @@ -231,7 +230,7 @@ } // end of method 'f4@6-4'::.ctor .method public strict virtual instance class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn - Invoke(class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1 ctxt) cil managed + Invoke(valuetype [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1 ctxt) cil managed { // Code size 21 (0x15) .maxstack 8 @@ -242,7 +241,7 @@ IL_0007: ldarg.0 IL_0008: ldfld class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2 AsyncExpressionSteppingTest4/AsyncExpressionSteppingTest4/'f4@6-4'::compensation IL_000d: tail. - IL_000f: call class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::TryFinally(class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1, + IL_000f: call class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::TryFinally(valuetype [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1, class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1, class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2) IL_0014: ret @@ -306,7 +305,7 @@ IL_002f: newobj instance void AsyncExpressionSteppingTest4/AsyncExpressionSteppingTest4/'f4@6-4'::.ctor(class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1, class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2) IL_0034: tail. - IL_0036: call class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::MakeAsync(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>) + IL_0036: call class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::MakeAsync(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>) IL_003b: ret } // end of method f4@5::Invoke diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/AsyncExpressionStepping/AsyncExpressionSteppingTest5.il.bsl b/tests/fsharpqa/Source/CodeGen/EmittedIL/AsyncExpressionStepping/AsyncExpressionSteppingTest5.il.bsl index 39045c913f8..da554a3adf4 100644 --- a/tests/fsharpqa/Source/CodeGen/EmittedIL/AsyncExpressionStepping/AsyncExpressionSteppingTest5.il.bsl +++ b/tests/fsharpqa/Source/CodeGen/EmittedIL/AsyncExpressionStepping/AsyncExpressionSteppingTest5.il.bsl @@ -36,13 +36,13 @@ // Offset: 0x000002C0 Length: 0x000000BE } .module AsyncExpressionSteppingTest5.dll -// MVID: {5AF59393-6394-30E8-A745-03839393F55A} +// MVID: {5AF5DDAE-6394-30E8-A745-0383AEDDF55A} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x03590000 +// Image base: 0x04430000 // =============== CLASS MEMBERS DECLARATION =================== @@ -234,7 +234,7 @@ } // end of class 'f7@6-4' .class auto ansi serializable sealed nested assembly beforefieldinit 'f7@6-5' - extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn> + extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn> { .field public class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 computation1 .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) @@ -253,7 +253,7 @@ // Code size 21 (0x15) .maxstack 8 IL_0000: ldarg.0 - IL_0001: call instance void class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>::.ctor() + IL_0001: call instance void class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>::.ctor() IL_0006: ldarg.0 IL_0007: ldarg.1 IL_0008: stfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 AsyncExpressionSteppingTest5/AsyncExpressionSteppingTest5/'f7@6-5'::computation1 @@ -264,37 +264,21 @@ } // end of method 'f7@6-5'::.ctor .method public strict virtual instance class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn - Invoke(class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1 ctxt) cil managed + Invoke(valuetype [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1 ctxt) cil managed { - // Code size 47 (0x2f) + // Code size 21 (0x15) .maxstack 8 - .line 100001,100001 : 0,0 '' + .line 6,6 : 17,31 '' IL_0000: ldarg.1 - IL_0001: callvirt instance bool class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1::get_IsCancellationRequested() - IL_0006: brfalse.s IL_000a - - IL_0008: br.s IL_000c - - IL_000a: br.s IL_0015 - - .line 100001,100001 : 0,0 '' - IL_000c: ldarg.1 + IL_0001: ldarg.0 + IL_0002: ldfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 AsyncExpressionSteppingTest5/AsyncExpressionSteppingTest5/'f7@6-5'::computation1 + IL_0007: ldarg.0 + IL_0008: ldfld class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2> AsyncExpressionSteppingTest5/AsyncExpressionSteppingTest5/'f7@6-5'::part2 IL_000d: tail. - IL_000f: callvirt instance class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1::OnCancellation() + IL_000f: call class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::Bind(valuetype [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1, + class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1, + class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>) IL_0014: ret - - .line 100001,100001 : 0,0 '' - IL_0015: ldarg.0 - IL_0016: ldfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 AsyncExpressionSteppingTest5/AsyncExpressionSteppingTest5/'f7@6-5'::computation1 - IL_001b: ldarg.1 - IL_001c: ldarg.0 - IL_001d: ldfld class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2> AsyncExpressionSteppingTest5/AsyncExpressionSteppingTest5/'f7@6-5'::part2 - IL_0022: call class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1 [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::Bind(class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1, - class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>) - IL_0027: tail. - IL_0029: call class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::Invoke(class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1, - class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1) - IL_002e: ret } // end of method 'f7@6-5'::Invoke } // end of class 'f7@6-5' @@ -358,7 +342,7 @@ IL_0043: newobj instance void AsyncExpressionSteppingTest5/AsyncExpressionSteppingTest5/'f7@6-5'::.ctor(class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1, class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>) IL_0048: tail. - IL_004a: call class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::MakeAsync(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>) + IL_004a: call class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::MakeAsync(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>) IL_004f: ret } // end of method f7@6::Invoke diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/AsyncExpressionStepping/AsyncExpressionSteppingTest6.il.bsl b/tests/fsharpqa/Source/CodeGen/EmittedIL/AsyncExpressionStepping/AsyncExpressionSteppingTest6.il.bsl index f12626bdcc8..379ad6bbe7c 100644 --- a/tests/fsharpqa/Source/CodeGen/EmittedIL/AsyncExpressionStepping/AsyncExpressionSteppingTest6.il.bsl +++ b/tests/fsharpqa/Source/CodeGen/EmittedIL/AsyncExpressionStepping/AsyncExpressionSteppingTest6.il.bsl @@ -36,13 +36,13 @@ // Offset: 0x000002A8 Length: 0x000000BE } .module AsyncExpressionSteppingTest6.dll -// MVID: {5AF59393-6394-4FAD-A745-03839393F55A} +// MVID: {5AF5DDAE-6394-4FAD-A745-0383AEDDF55A} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x030D0000 +// Image base: 0x04C40000 // =============== CLASS MEMBERS DECLARATION =================== @@ -56,7 +56,7 @@ { .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 07 00 00 00 00 00 ) .class auto ansi serializable sealed nested assembly beforefieldinit 'f2@10-4' - extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn> + extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn> { .field public int32 'value' .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) @@ -70,7 +70,7 @@ // Code size 14 (0xe) .maxstack 8 IL_0000: ldarg.0 - IL_0001: call instance void class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>::.ctor() + IL_0001: call instance void class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>::.ctor() IL_0006: ldarg.0 IL_0007: ldarg.1 IL_0008: stfld int32 AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f2@10-4'::'value' @@ -78,18 +78,17 @@ } // end of method 'f2@10-4'::.ctor .method public strict virtual instance class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn - Invoke(class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1 ctxt) cil managed + Invoke(valuetype [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1 ctxt) cil managed { - // Code size 15 (0xf) + // Code size 14 (0xe) .maxstack 8 .language '{AB4F38C9-B6E6-43BA-BE3B-58080B2CCCE3}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}' .line 10,10 : 17,25 'C:\\GitHub\\dsyme\\visualfsharp\\tests\\fsharpqa\\Source\\CodeGen\\EmittedIL\\AsyncExpressionStepping\\AsyncExpressionSteppingTest6.fs' - IL_0000: ldarg.1 - IL_0001: ldarg.0 - IL_0002: ldfld int32 AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f2@10-4'::'value' - IL_0007: tail. - IL_0009: callvirt instance class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1::OnSuccess(!0) - IL_000e: ret + IL_0000: ldarga.s ctxt + IL_0002: ldarg.0 + IL_0003: ldfld int32 AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f2@10-4'::'value' + IL_0008: call instance class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn valuetype [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1::OnSuccess(!0) + IL_000d: ret } // end of method 'f2@10-4'::Invoke } // end of class 'f2@10-4' @@ -158,14 +157,14 @@ IL_0034: ldloc.s V_4 IL_0036: newobj instance void AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f2@10-4'::.ctor(int32) IL_003b: tail. - IL_003d: call class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::MakeAsync(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>) + IL_003d: call class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::MakeAsync(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>) IL_0042: ret } // end of method 'f2@5-3'::Invoke } // end of class 'f2@5-3' .class auto ansi serializable sealed nested assembly beforefieldinit 'f3@20-7' - extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn> + extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn> { .field public int32 'value' .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) @@ -179,7 +178,7 @@ // Code size 14 (0xe) .maxstack 8 IL_0000: ldarg.0 - IL_0001: call instance void class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>::.ctor() + IL_0001: call instance void class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>::.ctor() IL_0006: ldarg.0 IL_0007: ldarg.1 IL_0008: stfld int32 AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@20-7'::'value' @@ -187,17 +186,16 @@ } // end of method 'f3@20-7'::.ctor .method public strict virtual instance class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn - Invoke(class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1 ctxt) cil managed + Invoke(valuetype [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1 ctxt) cil managed { - // Code size 15 (0xf) + // Code size 14 (0xe) .maxstack 8 .line 20,20 : 17,25 '' - IL_0000: ldarg.1 - IL_0001: ldarg.0 - IL_0002: ldfld int32 AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@20-7'::'value' - IL_0007: tail. - IL_0009: callvirt instance class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1::OnSuccess(!0) - IL_000e: ret + IL_0000: ldarga.s ctxt + IL_0002: ldarg.0 + IL_0003: ldfld int32 AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@20-7'::'value' + IL_0008: call instance class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn valuetype [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1::OnSuccess(!0) + IL_000d: ret } // end of method 'f3@20-7'::Invoke } // end of class 'f3@20-7' @@ -265,14 +263,14 @@ IL_0020: ldloc.3 IL_0021: newobj instance void AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@20-7'::.ctor(int32) IL_0026: tail. - IL_0028: call class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::MakeAsync(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>) + IL_0028: call class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::MakeAsync(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>) IL_002d: ret } // end of method 'f3@19-6'::Invoke } // end of class 'f3@19-6' .class auto ansi serializable sealed nested assembly beforefieldinit 'f3@18-8' - extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn> + extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn> { .field public class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 computation .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) @@ -291,7 +289,7 @@ // Code size 21 (0x15) .maxstack 8 IL_0000: ldarg.0 - IL_0001: call instance void class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>::.ctor() + IL_0001: call instance void class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>::.ctor() IL_0006: ldarg.0 IL_0007: ldarg.1 IL_0008: stfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@18-8'::computation @@ -302,37 +300,21 @@ } // end of method 'f3@18-8'::.ctor .method public strict virtual instance class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn - Invoke(class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1 ctxt) cil managed + Invoke(valuetype [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1 ctxt) cil managed { - // Code size 47 (0x2f) + // Code size 21 (0x15) .maxstack 8 - .line 100001,100001 : 0,0 '' + .line 18,18 : 17,31 '' IL_0000: ldarg.1 - IL_0001: callvirt instance bool class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1::get_IsCancellationRequested() - IL_0006: brfalse.s IL_000a - - IL_0008: br.s IL_000c - - IL_000a: br.s IL_0015 - - .line 100001,100001 : 0,0 '' - IL_000c: ldarg.1 + IL_0001: ldarg.0 + IL_0002: ldfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@18-8'::computation + IL_0007: ldarg.0 + IL_0008: ldfld class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2> AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@18-8'::binder IL_000d: tail. - IL_000f: callvirt instance class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1::OnCancellation() + IL_000f: call class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::Bind(valuetype [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1, + class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1, + class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>) IL_0014: ret - - .line 100001,100001 : 0,0 '' - IL_0015: ldarg.0 - IL_0016: ldfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@18-8'::computation - IL_001b: ldarg.1 - IL_001c: ldarg.0 - IL_001d: ldfld class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2> AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@18-8'::binder - IL_0022: call class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1 [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::Bind(class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1, - class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>) - IL_0027: tail. - IL_0029: call class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::Invoke(class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1, - class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1) - IL_002e: ret } // end of method 'f3@18-8'::Invoke } // end of class 'f3@18-8' @@ -405,14 +387,14 @@ IL_0034: newobj instance void AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@18-8'::.ctor(class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1, class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>) IL_0039: tail. - IL_003b: call class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::MakeAsync(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>) + IL_003b: call class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::MakeAsync(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>) IL_0040: ret } // end of method 'f3@16-5'::Invoke } // end of class 'f3@16-5' .class auto ansi serializable sealed nested assembly beforefieldinit 'f3@15-9' - extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn> + extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn> { .field public class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 computation .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) @@ -431,7 +413,7 @@ // Code size 21 (0x15) .maxstack 8 IL_0000: ldarg.0 - IL_0001: call instance void class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>::.ctor() + IL_0001: call instance void class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>::.ctor() IL_0006: ldarg.0 IL_0007: ldarg.1 IL_0008: stfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@15-9'::computation @@ -442,37 +424,21 @@ } // end of method 'f3@15-9'::.ctor .method public strict virtual instance class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn - Invoke(class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1 ctxt) cil managed + Invoke(valuetype [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1 ctxt) cil managed { - // Code size 47 (0x2f) + // Code size 21 (0x15) .maxstack 8 - .line 100001,100001 : 0,0 '' + .line 15,15 : 17,31 '' IL_0000: ldarg.1 - IL_0001: callvirt instance bool class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1::get_IsCancellationRequested() - IL_0006: brfalse.s IL_000a - - IL_0008: br.s IL_000c - - IL_000a: br.s IL_0015 - - .line 100001,100001 : 0,0 '' - IL_000c: ldarg.1 + IL_0001: ldarg.0 + IL_0002: ldfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@15-9'::computation + IL_0007: ldarg.0 + IL_0008: ldfld class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2> AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@15-9'::binder IL_000d: tail. - IL_000f: callvirt instance class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1::OnCancellation() + IL_000f: call class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::Bind(valuetype [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1, + class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1, + class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>) IL_0014: ret - - .line 100001,100001 : 0,0 '' - IL_0015: ldarg.0 - IL_0016: ldfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@15-9'::computation - IL_001b: ldarg.1 - IL_001c: ldarg.0 - IL_001d: ldfld class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2> AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@15-9'::binder - IL_0022: call class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1 [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::Bind(class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1, - class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>) - IL_0027: tail. - IL_0029: call class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::Invoke(class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1, - class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1) - IL_002e: ret } // end of method 'f3@15-9'::Invoke } // end of class 'f3@15-9' @@ -534,14 +500,14 @@ IL_0023: newobj instance void AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@15-9'::.ctor(class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1, class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>) IL_0028: tail. - IL_002a: call class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::MakeAsync(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>) + IL_002a: call class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::MakeAsync(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>) IL_002f: ret } // end of method 'f3@15-4'::Invoke } // end of class 'f3@15-4' .class auto ansi serializable sealed nested assembly beforefieldinit 'f3@14-10' - extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn> + extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn> { .field public class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 computation .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) @@ -560,7 +526,7 @@ // Code size 21 (0x15) .maxstack 8 IL_0000: ldarg.0 - IL_0001: call instance void class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>::.ctor() + IL_0001: call instance void class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>::.ctor() IL_0006: ldarg.0 IL_0007: ldarg.1 IL_0008: stfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@14-10'::computation @@ -571,37 +537,21 @@ } // end of method 'f3@14-10'::.ctor .method public strict virtual instance class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn - Invoke(class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1 ctxt) cil managed + Invoke(valuetype [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1 ctxt) cil managed { - // Code size 47 (0x2f) + // Code size 21 (0x15) .maxstack 8 - .line 100001,100001 : 0,0 '' + .line 14,14 : 17,31 '' IL_0000: ldarg.1 - IL_0001: callvirt instance bool class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1::get_IsCancellationRequested() - IL_0006: brfalse.s IL_000a - - IL_0008: br.s IL_000c - - IL_000a: br.s IL_0015 - - .line 100001,100001 : 0,0 '' - IL_000c: ldarg.1 + IL_0001: ldarg.0 + IL_0002: ldfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@14-10'::computation + IL_0007: ldarg.0 + IL_0008: ldfld class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2> AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@14-10'::binder IL_000d: tail. - IL_000f: callvirt instance class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1::OnCancellation() + IL_000f: call class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::Bind(valuetype [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1, + class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1, + class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>) IL_0014: ret - - .line 100001,100001 : 0,0 '' - IL_0015: ldarg.0 - IL_0016: ldfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@14-10'::computation - IL_001b: ldarg.1 - IL_001c: ldarg.0 - IL_001d: ldfld class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2> AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@14-10'::binder - IL_0022: call class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1 [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::Bind(class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1, - class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>) - IL_0027: tail. - IL_0029: call class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::Invoke(class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1, - class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1) - IL_002e: ret } // end of method 'f3@14-10'::Invoke } // end of class 'f3@14-10' @@ -657,14 +607,14 @@ IL_001e: newobj instance void AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@14-10'::.ctor(class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1, class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>) IL_0023: tail. - IL_0025: call class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::MakeAsync(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>) + IL_0025: call class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::MakeAsync(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>) IL_002a: ret } // end of method 'f3@14-3'::Invoke } // end of class 'f3@14-3' .class auto ansi serializable sealed nested assembly beforefieldinit 'f3@13-11' - extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn> + extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn> { .field public class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 computation .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) @@ -683,7 +633,7 @@ // Code size 21 (0x15) .maxstack 8 IL_0000: ldarg.0 - IL_0001: call instance void class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>::.ctor() + IL_0001: call instance void class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>::.ctor() IL_0006: ldarg.0 IL_0007: ldarg.1 IL_0008: stfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@13-11'::computation @@ -694,37 +644,21 @@ } // end of method 'f3@13-11'::.ctor .method public strict virtual instance class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn - Invoke(class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1 ctxt) cil managed + Invoke(valuetype [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1 ctxt) cil managed { - // Code size 47 (0x2f) + // Code size 21 (0x15) .maxstack 8 - .line 100001,100001 : 0,0 '' + .line 13,13 : 17,31 '' IL_0000: ldarg.1 - IL_0001: callvirt instance bool class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1::get_IsCancellationRequested() - IL_0006: brfalse.s IL_000a - - IL_0008: br.s IL_000c - - IL_000a: br.s IL_0015 - - .line 100001,100001 : 0,0 '' - IL_000c: ldarg.1 + IL_0001: ldarg.0 + IL_0002: ldfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@13-11'::computation + IL_0007: ldarg.0 + IL_0008: ldfld class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2> AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@13-11'::binder IL_000d: tail. - IL_000f: callvirt instance class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1::OnCancellation() + IL_000f: call class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::Bind(valuetype [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1, + class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1, + class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>) IL_0014: ret - - .line 100001,100001 : 0,0 '' - IL_0015: ldarg.0 - IL_0016: ldfld class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@13-11'::computation - IL_001b: ldarg.1 - IL_001c: ldarg.0 - IL_001d: ldfld class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2> AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@13-11'::binder - IL_0022: call class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1 [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::Bind(class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1, - class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>) - IL_0027: tail. - IL_0029: call class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::Invoke(class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1, - class [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1) - IL_002e: ret } // end of method 'f3@13-11'::Invoke } // end of class 'f3@13-11' @@ -774,7 +708,7 @@ IL_001b: newobj instance void AsyncExpressionSteppingTest6/AsyncExpressionSteppingTest6/'f3@13-11'::.ctor(class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1, class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>) IL_0020: tail. - IL_0022: call class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::MakeAsync(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>) + IL_0022: call class [FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1 [FSharp.Core]Microsoft.FSharp.Control.AsyncPrimitives::MakeAsync(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn>) IL_0027: ret } // end of method 'f3@13-2'::Invoke From 368d009e4bc26aef141bec2c742890a3a569ad85 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Fri, 11 May 2018 22:53:35 +0100 Subject: [PATCH 35/39] update baselines --- tests/FSharp.Core.UnitTests/SurfaceArea.coreclr.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/FSharp.Core.UnitTests/SurfaceArea.coreclr.fs b/tests/FSharp.Core.UnitTests/SurfaceArea.coreclr.fs index 261efd13fad..e0373b38de1 100644 --- a/tests/FSharp.Core.UnitTests/SurfaceArea.coreclr.fs +++ b/tests/FSharp.Core.UnitTests/SurfaceArea.coreclr.fs @@ -578,7 +578,7 @@ Microsoft.FSharp.Control.AsyncActivation`1[T]: System.String ToString() Microsoft.FSharp.Control.AsyncActivation`1[T]: System.Type GetType() Microsoft.FSharp.Control.AsyncPrimitives: Boolean Equals(System.Object) Microsoft.FSharp.Control.AsyncPrimitives: Int32 GetHashCode() --Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.AsyncReturn Bind[T,TResult](Microsoft.FSharp.Control.AsyncActivation`1[T], Microsoft.FSharp.Control.FSharpAsync`1[TResult], Microsoft.FSharp.Core.FSharpFunc`2[TResult,Microsoft.FSharp.Control.FSharpAsync`1[T]]) +Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.AsyncReturn Bind[T,TResult](Microsoft.FSharp.Control.AsyncActivation`1[T], Microsoft.FSharp.Control.FSharpAsync`1[TResult], Microsoft.FSharp.Core.FSharpFunc`2[TResult,Microsoft.FSharp.Control.FSharpAsync`1[T]]) Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.AsyncReturn CallThenInvoke[T,TResult](Microsoft.FSharp.Control.AsyncActivation`1[T], TResult, Microsoft.FSharp.Core.FSharpFunc`2[TResult,Microsoft.FSharp.Control.FSharpAsync`1[T]]) Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.AsyncReturn Invoke[T](Microsoft.FSharp.Control.FSharpAsync`1[T], Microsoft.FSharp.Control.AsyncActivation`1[T]) Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.AsyncReturn TryFinally[T](Microsoft.FSharp.Control.AsyncActivation`1[T], Microsoft.FSharp.Control.FSharpAsync`1[T], Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit]) From 4c8e9f294ee7c782326536f419a6238b920ee35c Mon Sep 17 00:00:00 2001 From: Don Syme Date: Sat, 12 May 2018 01:49:58 +0100 Subject: [PATCH 36/39] fix baseline --- tests/FSharp.Core.UnitTests/SurfaceArea.net40.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/FSharp.Core.UnitTests/SurfaceArea.net40.fs b/tests/FSharp.Core.UnitTests/SurfaceArea.net40.fs index 76175ca246b..3608ab710fd 100644 --- a/tests/FSharp.Core.UnitTests/SurfaceArea.net40.fs +++ b/tests/FSharp.Core.UnitTests/SurfaceArea.net40.fs @@ -565,7 +565,7 @@ Microsoft.FSharp.Control.AsyncActivation`1[T]: System.String ToString() Microsoft.FSharp.Control.AsyncActivation`1[T]: System.Type GetType() Microsoft.FSharp.Control.AsyncPrimitives: Boolean Equals(System.Object) Microsoft.FSharp.Control.AsyncPrimitives: Int32 GetHashCode() --Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.AsyncReturn Bind[T,TResult](Microsoft.FSharp.Control.AsyncActivation`1[T], Microsoft.FSharp.Control.FSharpAsync`1[TResult], Microsoft.FSharp.Core.FSharpFunc`2[TResult,Microsoft.FSharp.Control.FSharpAsync`1[T]]) +Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.AsyncReturn Bind[T,TResult](Microsoft.FSharp.Control.AsyncActivation`1[T], Microsoft.FSharp.Control.FSharpAsync`1[TResult], Microsoft.FSharp.Core.FSharpFunc`2[TResult,Microsoft.FSharp.Control.FSharpAsync`1[T]]) Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.AsyncReturn CallThenInvoke[T,TResult](Microsoft.FSharp.Control.AsyncActivation`1[T], TResult, Microsoft.FSharp.Core.FSharpFunc`2[TResult,Microsoft.FSharp.Control.FSharpAsync`1[T]]) Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.AsyncReturn Invoke[T](Microsoft.FSharp.Control.FSharpAsync`1[T], Microsoft.FSharp.Control.AsyncActivation`1[T]) Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.AsyncReturn TryFinally[T](Microsoft.FSharp.Control.AsyncActivation`1[T], Microsoft.FSharp.Control.FSharpAsync`1[T], Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit]) From 5045d6450951007a893b594630e8ab9e2ab6b5b3 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Sat, 12 May 2018 23:34:51 +0100 Subject: [PATCH 37/39] remove dead code --- src/fsharp/FSharp.Core/async.fs | 7 ------- 1 file changed, 7 deletions(-) diff --git a/src/fsharp/FSharp.Core/async.fs b/src/fsharp/FSharp.Core/async.fs index d301b199d0b..4d5fe676d68 100644 --- a/src/fsharp/FSharp.Core/async.fs +++ b/src/fsharp/FSharp.Core/async.fs @@ -98,13 +98,6 @@ namespace Microsoft.FSharp.Control /// the given function. The function might write its continuation into the trampoline. [] member __.Execute (firstAction : unit -> AsyncReturn) = - let rec loop action = - action() |> unfake - match storedCont with - | None -> () - | Some newAction -> - storedCont <- None - loop newAction let thisIsTopTrampoline = if Trampoline.thisThreadHasTrampoline then From b0fea336f26401c6ae8a1aa34875cb64d0233866 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Sat, 12 May 2018 23:37:06 +0100 Subject: [PATCH 38/39] simplify code --- src/fsharp/FSharp.Core/async.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fsharp/FSharp.Core/async.fs b/src/fsharp/FSharp.Core/async.fs index 4d5fe676d68..5207fc15935 100644 --- a/src/fsharp/FSharp.Core/async.fs +++ b/src/fsharp/FSharp.Core/async.fs @@ -594,8 +594,8 @@ namespace Microsoft.FSharp.Control /// Implement the while loop construct of async computation expressions let CreateWhileAsync guardFunc computation = - let mutable whileAsync = Unchecked.defaultof<_> if guardFunc() then + let mutable whileAsync = Unchecked.defaultof<_> whileAsync <- CreateBindAsync computation (fun () -> if guardFunc() then whileAsync else unitAsync) whileAsync else From 1cd72fe97113bdd3ef1c917adec5ef791ae9e2e7 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Sun, 13 May 2018 23:54:09 +0100 Subject: [PATCH 39/39] apply DebuggerHidden in a couple more places --- src/fsharp/FSharp.Core/async.fs | 16 +++++++--------- src/fsharp/FSharp.Core/prim-types.fs | 12 ++++++------ 2 files changed, 13 insertions(+), 15 deletions(-) diff --git a/src/fsharp/FSharp.Core/async.fs b/src/fsharp/FSharp.Core/async.fs index 5207fc15935..2d87a60078a 100644 --- a/src/fsharp/FSharp.Core/async.fs +++ b/src/fsharp/FSharp.Core/async.fs @@ -83,8 +83,7 @@ namespace Microsoft.FSharp.Control [] static let bindLimitBeforeHijack = 300 - [] - [] + [] static val mutable private thisThreadHasTrampoline : bool static member ThisThreadHasTrampoline = @@ -309,8 +308,7 @@ namespace Microsoft.FSharp.Control member ctxt.CallContinuation(result: 'T) = ctxt.cont result - [] - [] + [] type Async<'T> = { Invoke : (AsyncActivation<'T> -> AsyncReturn) } @@ -320,14 +318,12 @@ namespace Microsoft.FSharp.Control member __.Proceed = not isStopped member __.Stop() = isStopped <- true - [] - [] + [] type Latch() = let mutable i = 0 member this.Enter() = Interlocked.CompareExchange(&i, 1, 0) = 0 - [] - [] + [] type Once() = let latch = Latch() member this.Do f = @@ -350,6 +346,7 @@ namespace Microsoft.FSharp.Control module AsyncPrimitives = let fake () = Unchecked.defaultof + let unfake (_: AsyncReturn) = () let mutable defaultCancellationTokenSource = new CancellationTokenSource() @@ -459,6 +456,7 @@ namespace Microsoft.FSharp.Control ctxt.OnExceptionRaised() /// Build a primitive without any exception or resync protection + [] let MakeAsync body = { Invoke = body } [] @@ -530,7 +528,7 @@ namespace Microsoft.FSharp.Control let inline CreateBindAsync part1 part2 = // Note: this code ends up in user assemblies via inlining MakeAsync (fun ctxt -> - Bind ctxt part1 part2) + Bind ctxt part1 part2) // Call the given function with exception protection, but first // check for cancellation. diff --git a/src/fsharp/FSharp.Core/prim-types.fs b/src/fsharp/FSharp.Core/prim-types.fs index bb79e0f84d7..34b7e82beae 100644 --- a/src/fsharp/FSharp.Core/prim-types.fs +++ b/src/fsharp/FSharp.Core/prim-types.fs @@ -2764,17 +2764,17 @@ namespace Microsoft.FSharp.Core // Function Values [] - type FSharpTypeFunc() = + type FSharpTypeFunc [] () = abstract Specialize<'T> : unit -> obj [] - type FSharpFunc<'T,'Res>() = + type FSharpFunc<'T,'Res> [] () = abstract Invoke : 'T -> 'Res module OptimizedClosures = [] - type FSharpFunc<'T,'U,'V>() = + type FSharpFunc<'T,'U,'V> [] () = inherit FSharpFunc<'T,('U -> 'V)>() abstract Invoke : 'T * 'U -> 'V override f.Invoke(t) = (fun u -> f.Invoke(t,u)) @@ -2787,7 +2787,7 @@ namespace Microsoft.FSharp.Core member x.Invoke(t,u) = (retype func : FSharpFunc<'T,FSharpFunc<'U,'V>>).Invoke(t).Invoke(u) } [] - type FSharpFunc<'T,'U,'V,'W>() = + type FSharpFunc<'T,'U,'V,'W> [] () = inherit FSharpFunc<'T,('U -> 'V -> 'W)>() abstract Invoke : 'T * 'U * 'V -> 'W override f.Invoke(t) = (fun u v -> f.Invoke(t,u,v)) @@ -2805,7 +2805,7 @@ namespace Microsoft.FSharp.Core member x.Invoke(t,u,v) = (retype func : FSharpFunc<'T,('U -> 'V -> 'W)>).Invoke(t) u v } [] - type FSharpFunc<'T,'U,'V,'W,'X>() = + type FSharpFunc<'T,'U,'V,'W,'X> [] () = inherit FSharpFunc<'T,('U -> 'V -> 'W -> 'X)>() abstract Invoke : 'T * 'U * 'V * 'W -> 'X static member Adapt(func : 'T -> 'U -> 'V -> 'W -> 'X) = @@ -2828,7 +2828,7 @@ namespace Microsoft.FSharp.Core override f.Invoke(t) = (fun u v w -> f.Invoke(t,u,v,w)) [] - type FSharpFunc<'T,'U,'V,'W,'X,'Y>() = + type FSharpFunc<'T,'U,'V,'W,'X,'Y> [] () = inherit FSharpFunc<'T,('U -> 'V -> 'W -> 'X -> 'Y)>() abstract Invoke : 'T * 'U * 'V * 'W * 'X -> 'Y override f.Invoke(t) = (fun u v w x -> f.Invoke(t,u,v,w,x))