X-Git-Url: https://jxself.org/git/?a=blobdiff_plain;f=8sync%2Factors.scm;h=ceb2980f533e93eab250c85e908dd05e6f885edf;hb=17e72389d61d35970bf0de07121b7aa26e11221a;hp=204582df7a2ae49e9f90b8f4d1fa8a01f6523f52;hpb=c32aa0d308ce33667168dc2c2f41b30f423fe158;p=8sync.git diff --git a/8sync/actors.scm b/8sync/actors.scm index 204582d..ceb2980 100644 --- a/8sync/actors.scm +++ b/8sync/actors.scm @@ -311,7 +311,7 @@ raise an exception if an error." "Construct an alist of (symbol . method), where the method is wrapped with wrap-apply to facilitate live hacking and allow the method definition to come after class definition." - (make-rmeta-slot + (build-rmeta-slot (list (cons (quote symbol) (wrap-apply method)) ...))) @@ -339,7 +339,7 @@ to come after class definition." #:allocation #:each-subclass) ;; This is the default, "simple" way to inherit and process messages. - (actions #:init-value (build-actions + (actions #:init-thunk (build-actions ;; Default init method is to do nothing. (*init* (const #f)) ;; Default cleanup method is to do nothing. @@ -390,7 +390,7 @@ to come after class definition." (action ...) slots ...) (define-class class inherits - (actions #:init-value (build-actions action ...) + (actions #:init-thunk (build-actions action ...) #:allocation #:each-subclass) slots ...)) @@ -424,7 +424,7 @@ to come after class definition." (prompt #:init-thunk make-prompt-tag #:getter hive-prompt) (actions #:allocation #:each-subclass - #:init-value + #:init-thunk (build-actions ;; This is in the case of an ambassador failing to forward a ;; message... it reports it back to the hive @@ -562,7 +562,9 @@ to come after class definition." message)) actor)) - (define (call-catching-coroutine thunk) + ;; TODO: I'm pretty sure we're building up another stack of prompts here + ;; with the way we're doing this. That's a real problem. + (define* (call-catching-coroutine thunk #:optional (catch-errors #t)) (define queued-error-handling-thunk #f) (define (call-catching-errors) ;; TODO: maybe parameterize (or attach to hive) and use @@ -591,7 +593,9 @@ to come after class definition." (if queued-error-handling-thunk (8sync (queued-error-handling-thunk)))) (call-with-prompt (hive-prompt hive) - call-catching-errors + (if catch-errors + call-catching-errors + thunk) (lambda (kont actor message send-options) ;; Register the coroutine (hash-set! (hive-waiting-coroutines hive) @@ -641,7 +645,9 @@ to come after class definition." result)) (#f (throw 'no-waiting-coroutine "message in-reply-to tries to resume nonexistent coroutine" - message)))))) + message)))) + ;; no need to catch errors here, there's already an error handler + #f)) ;; Unhandled action for a reply! (else (throw 'hive-unresumable-coroutine