#:export (<agenda>
make-agenda agenda?
agenda-queue agenda-prompt-tag
- agenda-read-port-map agenda-write-port-map agenda-except-port-map
+ agenda-read-port-map agenda-write-port-map
agenda-schedule
make-async-prompt-tag
run-it wrap wrap-apply run run-at run-delay
- 8sync 8sync-delay
+ 8sync-delay
8sync-run 8sync-run-at 8sync-run-delay
8sync-nowait
8sleep
- catch-8sync
-
;; used for introspecting the error, but a method for making
;; is not exposed
wrapped-exception?
(wrapped-exception-stacks body-result))
body-result)))
-(define-syntax 8sync
- (syntax-rules ()
- "Run BODY asynchronously (8synchronously?) at a prompt, then return.
-
-Possibly specify WHEN as the second argument."
- ((8sync body)
- (8sync-run body))
- ((8sync body when)
- (8sync-run-at body when))))
-
(define-syntax-rule (8sync-run body ...)
(8sync-run-at body ... #f))
(wrap (kont #f)) #f)
(make-run-request (lambda () body) #f))))))
-(define-syntax-rule (catch-8sync exp (handler-key handler) ...)
- (catch '8sync-caught-error
- (lambda ()
- exp)
- (lambda (_ orig-key orig-args orig-stacks)
- (cond
- ((or (eq? handler-key #t)
- (eq? orig-key handler-key))
- (apply handler orig-stacks orig-args)) ...
- (else (raise '8sync-caught-error
- orig-key orig-args orig-stacks))))))
-
;; This is sugar... and could probably be considerably
;; simplified and optimized. But whatever.
(define-syntax-rule (8sleep time)
(selector agenda))
0)))
(or (has-items? agenda-read-port-map)
- (has-items? agenda-write-port-map)
- (has-items? agenda-except-port-map)))
+ (has-items? agenda-write-port-map)))
(if (or (ports-to-select?)
;; select doubles as sleep...
(begin body ...)))
(define (wait-for-readable port)
- (display "Waiting to read\n")
(8sync-abort-to-prompt
(make-async-request
(lambda (kont)
(make-read-request port (wrap (kont #f)))))))
(define (wait-for-writable port)
- (display "Waiting to write\n")
(8sync-abort-to-prompt
(make-async-request
(lambda (kont)
((? write-request? write-request)
(agenda-handle-write-request! agenda write-request))
;; do nothing
- ;; @@: Why not throw an error?
+ ;; Remember, we don't throw an error here because procedures can
+ ;; return a run request, eg with run-it, at the end of their
+ ;; evaluation to keep looping.
+ ;; @@: Though is this really a useful feature?
(_ #f)))
;; @@: We might support delay-wrapped procedures here
(match proc-result