From b3da5056c59d51bd48bd8cfc6f573fce492e0974 Mon Sep 17 00:00:00 2001 From: Christopher Allan Webber Date: Mon, 30 Nov 2015 22:59:51 -0600 Subject: [PATCH] Add and friends * 8sync/agenda.scm (, make-port-remove-request) (port-remove-request?, port-remove-request-port, port-remove-request) (%port-remove-request, agenda-handle-port-remove-request!): New variables * 8sync/agenda.scm (%port-request): Original syntax of this probably never worked; fixed. * 8sync/agenda.scm (agenda-run-once): Updated for port-remove-request --- 8sync/agenda.scm | 30 ++++++++++++++++++++++++++++-- 1 file changed, 28 insertions(+), 2 deletions(-) diff --git a/8sync/agenda.scm b/8sync/agenda.scm index aded0d5..b61cd99 100644 --- a/8sync/agenda.scm +++ b/8sync/agenda.scm @@ -454,6 +454,13 @@ Will produce (0 . 0) instead of a negative number, if needed." (define port-request make-port-request) +(define-record-type + (make-port-remove-request port) + port-remove-request? + (port port-remove-request-port)) + +(define port-remove-request make-port-remove-request) + ;;; Asynchronous escape to run things @@ -547,12 +554,19 @@ return the wrong thing via (%8sync) and trip themselves up." (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-request-args ...) + (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-remove-request port) + (make-run-request kont))))) + + ;; Sugar (define-syntax-rule (%8sync-run rest ...) "Sugar for (%8sync (%run ...))" @@ -690,6 +704,7 @@ return the wrong thing via (%8sync) and trip themselves up." "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)))) @@ -698,6 +713,14 @@ return the wrong thing via (%8sync) and trip themselves up." (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* (start-agenda agenda #:key stop-condition (get-time gettimeofday) @@ -802,11 +825,14 @@ based on the results" (#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 -- 2.31.1