port-request-port
port-request-read port-request-write port-request-except
+ <port-remove-request>
+ make-port-remove-request port-remove-request port-remove-request?
+ port-remove-request-port
+
run-it wrap wrap-apply run run-at run-delay
%run %run-at %run-delay %port-request
print-error-and-continue
+ stop-on-nothing-to-do
+
%current-agenda
start-agenda agenda-run-once))
(define port-request make-port-request)
+(define-record-type <port-remove-request>
+ (make-port-remove-request port)
+ port-remove-request?
+ (port port-remove-request-port))
+
+(define port-remove-request make-port-remove-request)
+
\f
;;; Asynchronous escape to run things
(define-syntax-rule (%run-delay body ... delay-time)
(%run-at body ... (tdelta delay-time)))
-(define-syntax-rule (%port-request add-this-port port-request-args ...)
+(define-syntax-rule (%port-request port port-request-args ...)
+ (make-async-request
+ (lambda (kont)
+ (list (make-port-request port port-request-args ...)
+ (make-run-request kont)))))
+
+(define-syntax-rule (%port-remove-request port)
(make-async-request
(lambda (kont)
- (list (make-port-request port-request-args ...)
+ (list (make-port-remove-request port)
(make-run-request kont)))))
+
;; Sugar
(define-syntax-rule (%8sync-run rest ...)
"Sugar for (%8sync (%run ...))"
(define %current-agenda (make-parameter #f))
(define (update-agenda-from-select! agenda)
- "Potentially (select) on ports specified in agenda, adding items to queue"
+ "Potentially (select) on ports specified in agenda, adding items to queue.
+
+Also handles sleeping when all we have to do is wait on the schedule."
(define (hash-keys hash)
(hash-map->list (lambda (k v) k) hash))
(define (get-wait-time)
(has-items? agenda-write-port-map)
(has-items? agenda-except-port-map)))
- (if (ports-to-select?)
+ (if (or (ports-to-select?)
+ ;; select doubles as sleep...
+ (not (schedule-empty? (agenda-schedule agenda))))
(update-agenda)
agenda))
"Update an agenda for a port-request"
(define (handle-selector request-selector port-map-selector)
(if (request-selector port-request)
+ ;; @@: Should we remove if #f?
(hash-set! (port-map-selector agenda)
(port-request-port port-request)
(request-selector port-request))))
(handle-selector port-request-except agenda-except-port-map))
+(define (agenda-handle-port-remove-request! agenda port-remove-request)
+ "Update an agenda for a port-remove-request"
+ (let ((port (port-remove-request-port port-remove-request)))
+ (hash-remove! (agenda-read-port-map agenda) port)
+ (hash-remove! (agenda-write-port-map agenda) port)
+ (hash-remove! (agenda-except-port-map agenda) port)))
+
+
+(define (stop-on-nothing-to-do agenda)
+ (and (q-empty? (agenda-queue agenda))
+ (schedule-empty? (agenda-schedule agenda))
+ (= 0 (hash-count (const #t) (agenda-read-port-map agenda)))
+ (= 0 (hash-count (const #t) (agenda-write-port-map agenda)))
+ (= 0 (hash-count (const #t) (agenda-except-port-map agenda)))))
+
+
(define* (start-agenda agenda
- #:key stop-condition
+ #:key
+ ;; @@: Should we make stop-on-nothing-to-do
+ ;; the default stop-condition?
+ stop-condition
(get-time gettimeofday)
(handle-ports update-agenda-from-select!))
;; TODO: Document fields
(agenda-queue agenda))
(loop agenda))))))
+
(define (print-error-and-continue key . args)
"Frequently used as pre-unwind-handler for agenda"
(cond
(#f
(enq! next-queue (run-request-proc run-request))))))))
(define (handle-individual result)
+ ;; @@: Could maybe optimize by switching to an explicit cond...
(match result
((? run-request? new-proc)
(enqueue new-proc))
((? port-request? port-request)
(agenda-handle-port-request! agenda port-request))
+ ((? port-remove-request? port-remove-request)
+ (agenda-handle-port-remove-request! agenda port-remove-request))
;; do nothing
(_ #f)))
;; @@: We might support delay-wrapped procedures here