examples/my-resource.rkt
#lang racket

(require (planet williams/simulation/simulation))

(define-process* (my-resource (total-units 1))
  ((allocations (make-hasheq))
   (allocated-units 0))
  (let loop ()
    (select
     ((accept caller (request (units 1))
         (let* ((current-allocation (hash-ref (my-resource-allocations self) caller 0))
                (requested-allocation (+ current-allocation units))
                (available-units (- total-units (my-resource-allocated-units self))))
           (when (> requested-allocation total-units)
             (error 'request
                    "Total units requested ~a > total units ~a for ~s"
                    requested-allocation total-units caller))
           (if (<= units available-units)
               (begin
                 (hash-set! (my-resource-allocations self) caller requested-allocation)
                 (set-my-resource-allocated-units!
                  self (+ (my-resource-allocated-units self) units)))
               (requeue)))))
     ((accept caller (relinquish (units 1))
         (let* ((current-allocation (hash-ref (my-resource-allocations self) caller 0))
                (remaining-allocation (- current-allocation units)))
           (when (< remaining-allocation 0)
             (error 'relinquish
                    "Units relinquished ~a > units allocated ~a for ~s"
                    units current-allocation caller))
           (if (= remaining-allocation 0)
               (hash-remove! (my-resource-allocations self) caller)
               (hash-set! (my-resource-allocations self) caller remaining-allocation))
           (set-my-resource-allocated-units!
            self (- (my-resource-allocated-units self) units))))))
    (loop)))

;;; n-attendants : exact-positive-integer? = 2
;;; attendant : (or/c resource? false/c) = #f
(define n-attendants 2)
(define attendant #f)

;;; (generator n) -> void?
;;;   n : exact-nonnegative-integer?
(define (generator n)
  (for ((i (in-range n)))
    (wait (random-exponential 4.0))
    (schedule #:now (customer i))))

;;; process (customer i) -> void?
;;;   i : exact-nonnegative-integer?
(define-process (customer i)
  (printf "~a: customer ~a enters~n" (current-simulation-time) i)
  (call attendant (request))
  (printf "~a: customer ~a gets an attendant~n" (current-simulation-time) i)
  (work (random-flat 2.0 10.0))
  (call attendant (relinquish))
  (printf "~a: customer ~a leaves~n" (current-simulation-time) i))

;;; (run-simulation n) -> void?
;;;   n : exact-nonnegative-integer?
(define (run-simulation n)
  (with-new-simulation-environment
   (set! attendant (schedule #:now (my-resource n-attendants)))
   (schedule #:at 0.0 (generator n))
   (start-simulation)))

;;; Run the simulation for 10 customers.
(run-simulation 10)