Semaphores

let semaphores (round: Round) : Flow<Axial.ClockEnvironment, Never, Check list> =
    let permits = 3
    let workers = round.Size 60

    flow {
        let! semaphore = Semaphore.make permits
        let! active = Ref.make 0
        let! busiest = Ref.make 0
        let entered = ResizeArray<int>()

        // Each worker holds a permit while it counts itself in; ensuring counts it out however the worker ends.
        let worker id =
            flow {
                let! now = active |> Ref.updateAndGet ((+) 1)
                do! busiest |> Ref.update (max now)
                lock entered (fun () -> entered.Add id)
                do! Flow.sleep (TimeSpan.FromMilliseconds(float (round.Next 2)))
            }
            |> Flow.ensuring (active |> Ref.update (fun count -> count - 1))
            |> Semaphore.withPermit semaphore

        let! fibers = [ 1..workers ] |> Flow.traverse (worker >> Flow.fork)

        // Interrupt a random third of the workers, whether they are waiting for a permit or holding one.
        let! exits =
            fibers
            |> Flow.traverse (fun fiber -> if round.Chance 33 then Fiber.interrupt fiber else Fiber.await fiber)

        let! finalActive = Ref.get active
        let! mostAtOnce = Ref.get busiest

        // If an interrupted waiter had lost a permit, these three could not all hold one at the same time.
        let! barrier = Deferred.make<Axial.ClockEnvironment, Never, unit> ()
        let! arrived = Ref.make 0

        let holdTogether =
            flow {
                let! count = arrived |> Ref.updateAndGet ((+) 1)
                if count = permits then do! Deferred.succeed () barrier |> Flow.ignore
                do! Deferred.await barrier
            }
            |> Semaphore.withPermit semaphore

        let! allPermitsFree =
            List.replicate permits holdTogether
            |> Flow.sequencePar
            |> Flow.map (fun _ -> true)
            |> Flow.timeoutToOk (TimeSpan.FromSeconds 10.0) false

        let succeeded = exits |> List.filter (function Exit.Success _ -> true | _ -> false) |> List.length

        return
            [ check "no more workers than permits ever held one at once" (mostAtOnce <= permits && mostAtOnce >= 1)
              check "every worker that finished had entered" (succeeded <= entered.Count)
              check "every worker that entered was counted out, even if interrupted inside" (finalActive = 0)
              check "interrupted waiters returned their permits: all permits can be held together" allPermitsFree ]
    }