simpleThreadPool.fs

open System.Threading
open System.Collections.Concurrent
type ThreadPool () =
    let jobs = System.Collections.Concurrent.ConcurrentQueue<unit->unit> ()
    let semaphore = new Semaphore (0, System.Int32.MaxValue)
    let threads = ConcurrentBag<Thread>()

    let postJob job =
        jobs.Enqueue job
        semaphore.Release () |> ignore

    do
        let threadLoop _ =
            { new SynchronizationContext () with
                override __.Post (f, x) = postJob (fun () -> f.Invoke x)
                override __.Send (f, x) = 
                    use s = new Semaphore (0, 1)
                    postJob (fun () -> f.Invoke x; s.Release () |> ignore)
                    s.WaitOne () |> ignore }
            |> SynchronizationContext.SetSynchronizationContext

            let rec loop () =
                semaphore.WaitOne () |> ignore
                match jobs.TryDequeue () with
                | true, x -> x ()
                | _ -> ()
                loop ()
            loop ()            

        for i in 0..4 do
            let t = Thread(ParameterizedThreadStart threadLoop)
            t.Name <- sprintf "Custom Thread Pool/%i" i
            threads.Add t
            t.Start ()
    member __.QueueJob f = postJob f

let pool = ThreadPool ()

for _ in 1..100 do
    pool.QueueJob (fun () ->
        let synch = SynchronizationContext.Current
        let a = System.Threading.Thread.CurrentThread.Name
        async {
            let b = System.Threading.Thread.CurrentThread.Name
            do! Async.SwitchToContext synch
            printfn "%s vs %s vs %s" a b System.Threading.Thread.CurrentThread.Name
        } |> Async.Start)