"Run BODY asynchronously at a prompt, passing args to make-future.
Runs things asynchronously (8synchronously?)"
- (abort-to-prompt (current-agenda-prompt)
- async-request))
+ (propagate-%async-exceptions
+ (abort-to-prompt (current-agenda-prompt)
+ async-request)))
;; Async port request and run-request meta-requests
(define (make-async-request proc)
"Invalid request passed back via an (%8sync) procedure."
async-request))))
+(define-record-type <wrapped-exception>
+ (make-wrapped-exception key args stack)
+ wrapped-exception?
+ (key wrapped-exception-key)
+ (args wrapped-exception-args)
+ (stack wrapped-exception-stack))
+
+(define-syntax-rule (propagate-%async-exceptions body)
+ (let ((body-result body))
+ (display "hi!\n")
+ (if (wrapped-exception? body-result)
+ (throw '%8sync-caught-error
+ (wrapped-exception-key body-result)
+ (wrapped-exception-args body-result)
+ (wrapped-exception-stack body-result))
+ body-result)))
+
(define-syntax-rule (%run body ...)
(%run-at body ... #f))
(define-syntax-rule (%run-at body ... when)
+ ;; Send an asynchronous request to apply a continuation to the
+ ;; following function, then handle that as a request to the agenda
(make-async-request
(lambda (kont)
+ ;; We're making a run request
(make-run-request
+ ;; Wrapping the following execution to run...
(wrap
+ ;; Once we get the result from the inner part, we'll resume
+ ;; this continuation, but first
+ ;; @@: Is this running immediately, or queueing the result
+ ;; after evaluation for the next agenda tick? It looks
+ ;; like evaluating immediately. Is that what we want?
(kont
- (begin body ...)))
+ ;; Any unhandled errors are caught
+ (let ((exception-stack #f))
+ (catch #t
+ ;; Run the actual code the user requested
+ (lambda ()
+ body ...)
+ ;; If something bad happened and we didn't catch it,
+ ;; we'll wrap it up in such a way that the continuation
+ ;; can address it
+ ;; @@: For this stack to work doesn't it have to be
+ (lambda (key . args)
+ (make-wrapped-exception key args
+ exception-stack))
+ (lambda _
+ (set! exception-stack (make-stack #t 1 0)))))))
when))))
(define-syntax-rule (%run-delay body ... delay-time)