@@ -52,8 +52,6 @@ module Async2Implementation =
5252
5353    module  BindContext  = 
5454        let  bindCount  =  new  ThreadLocal< int>() 
55-         // Used to prevent sync over async deadlocks. 
56-         let  started  =  new  AsyncLocal< bool>() 
5755
5856        [<Literal>] 
5957        let  bindLimit  =  100 
@@ -103,6 +101,8 @@ module Async2Implementation =
103101
104102        member  this.Ref :  ICriticalNotifyCompletion ref  =  ref this
105103
104+         member  _.Running  =  running
105+ 
106106        static member  Current  =  holder.Value
107107
108108    module  ExceptionCache  = 
@@ -474,36 +474,40 @@ module Async2 =
474474
475475    let  CheckAndThrowToken  =  AsyncLocal< CancellationToken>() 
476476
477+     let  startInThreadPool  ct  ( code :  Async2 < _ >)  = 
478+         Task.Run< 't>( fun   ()  -> 
479+             CheckAndThrowToken.Value <-  ct
480+             code.StartImmediate ct |>  _. Task) 
481+ 
477482    let inline  start  ct  ( code :  Async2 < _ >)  = 
478-         let  oldCt  =  CheckAndThrowToken.Value
479-         let  oldStarted  =  BindContext.started.Value
480483
481484        let  immediate  = 
482-             not  oldStarted 
485+             not  Trampoline.Current.Running  // prevent deadlock, TODO: better solution? 
483486            &&  isNull SynchronizationContext.Current
484487            &&  TaskScheduler.Current =  TaskScheduler.Default
485488
486-         try 
487-             BindContext.started.Value <-  true 
488-             CheckAndThrowToken.Value <-  ct
489+         if  immediate then 
490+             let  oldCt  =  CheckAndThrowToken.Value
489491
490-             if  immediate then 
492+             try 
493+                 CheckAndThrowToken.Value <-  ct
491494                code.StartImmediate ct |>  _. Task
492-              else 
493-                 Task.Run < 't >( fun   ()   ->  code.StartImmediate ct  |>   _. Task ) 
494-         finally 
495-             CheckAndThrowToken.Value  <-  oldCt 
496-             BindContext.started.Value  <-  oldStarted 
495+ 
496+             finally 
497+                 CheckAndThrowToken.Value  <-  oldCt 
498+         else 
499+             startInThreadPool ct code 
497500
498501    let  run  ct  ( code :  Async2 < 't >)  = 
499-         start  ct code |>  _. GetAwaiter() .GetResult() 
502+         startInThreadPool  ct code |>  _. GetAwaiter() .GetResult() 
500503
501504    let  runWithoutCancellation  code  =  run CancellationToken.None code
502505
503506    //let queueTask ct code = 
504507    //    Task.Run<'t>(fun () -> start ct code) 
505508
506-     let  startAsTaskWithoutCancellation  code  =  start CancellationToken.None code
509+     let  startAsTaskWithoutCancellation  code  = 
510+         startInThreadPool CancellationToken.None code
507511
508512    let  toAsync   ( code :  Async2 < 't >)  = 
509513        async  { 
@@ -530,15 +534,15 @@ type Async2 =
530534
531535    static member  Start ( computation :  Async2 < _ >,  ? cancellationToken :  CancellationToken )  :  unit  = 
532536        let  ct  =  defaultArg cancellationToken CancellationToken.None
533-         Async2.start  ct computation |>  ignore
537+         Async2.startInThreadPool  ct computation |>  ignore
534538
535539    static member  StartAsTask ( computation :  Async2 < _ >,  ? cancellationToken :  CancellationToken )  :  Task < _ >  = 
536540        let  ct  =  defaultArg cancellationToken CancellationToken.None
537-         Async2.start  ct computation
541+         Async2.startInThreadPool  ct computation
538542
539543    static member  RunImmediate ( computation :  Async2 < 'T >,  ? cancellationToken :  CancellationToken )  :  'T  = 
540544        let  ct  =  defaultArg cancellationToken CancellationToken.None
541-         Async2.run  ct computation
545+         Async2.start  ct computation  |>   _. GetAwaiter () .GetResult () 
542546
543547    static member  Parallel ( computations :  Async2 < _ >  seq )  = 
544548        async2 { 
@@ -555,7 +559,7 @@ type Async2 =
555559                                lcts.Cancel() 
556560                                return  raise exn
557561                        } 
558-                         |>  Async2.start  lcts.Token
562+                         |>  Async2.startInThreadPool  lcts.Token
559563                } 
560564
561565            return !  Task.WhenAll tasks
@@ -584,25 +588,25 @@ type Async2 =
584588    static member  TryCancelled ( computation :  Async2 < 'T >,  compensation )  = 
585589        async2 { 
586590            let!  ct  =  Async2.CancellationToken
587-             let  task  =  Async2.start  ct computation 
591+             let  invocation  =  computation.StartImmediate  ct
588592
589593            try 
590-                 return !  task 
594+                 return !  invocation 
591595            finally 
592-                 if  task .IsCanceled then 
596+                 if  invocation.Task .IsCanceled then 
593597                    compensation () 
594598        } 
595599
596600    static member  StartChild ( computation :  Async2 < 'T >)  :  Async2 < Async2 < 'T >>  = 
597601        async2 { 
598602            let!  ct  =  Async2.CancellationToken
599-             return  async2 {  return !  computation |>  Async2.start  ct } 
603+             return  async2 {  return !  computation |>  Async2.startInThreadPool  ct } 
600604        } 
601605
602606    static member  StartChildAsTask ( computation :  Async2 < 'T >)  :  Async2 < Task < 'T >>  = 
603607        async2 { 
604608            let!  ct  =  Async2.CancellationToken
605-             let  task  =  computation |>  Async2.start  ct
609+             let  task  =  computation |>  Async2.startInThreadPool  ct
606610            return  task
607611        } 
608612
0 commit comments