X-Git-Url: https://jxself.org/git/?a=blobdiff_plain;f=8sync%2Factors.scm;h=8abe41a1133b20c65dcaf8a3ff3ca1c5f40a8c3e;hb=5b14912b0f727252f4701c3fe4cb742e4192457b;hp=62a07ac113e15d23b87c3cce0e6cf58c2856b8ae;hpb=d50c1349a0f5abc0e110400f0c3315a1809bf813;p=8sync.git diff --git a/8sync/actors.scm b/8sync/actors.scm index 62a07ac..8abe41a 100644 --- a/8sync/actors.scm +++ b/8sync/actors.scm @@ -43,6 +43,8 @@ actor-id actor-message-handler + *current-actor* + ;;; Commenting out the
type for now; ;;; it may be back when we have better serializers ;;
@@ -56,8 +58,6 @@ actor-init! actor-cleanup! - actor-alive? - build-actions define-actor @@ -85,7 +85,7 @@ ;; Maybe the wrong place for this, or for it to be exported. ;; But it's used in websockets' server implementation at least... - wrap)) + live-wrap)) ;; For ids (set! *random-state* (random-state-from-platform)) @@ -156,7 +156,7 @@ ;; This is the internal, generalized message sending method. ;; Users shouldn't use it! Use the <-foo forms instead. -(define-inlinable (%<- wants-reply from-actor to action args message-id in-reply-to) +(define (%<- wants-reply from-actor to action args message-id in-reply-to) ;; Okay, we need to deal with message ids. ;; Could we get rid of them? :\ ;; It seems if we can use eq? and have messages be immutable then @@ -180,7 +180,13 @@ 'TODO) ;; A message sent to nobody goes nowhere. ;; TODO: Should we display a warning here, probably? - (#f #f))) + (#f #f) + ;; We shouldn't technically be passing in actors but rather their + ;; addresses, but often actors want to message themselves and + ;; this makes that slightly easier. + ((? (lambda (x) (is-a? x )) actor) + (%<- wants-reply from-actor (actor-id actor) action + args message-id in-reply-to)))) (define (<- to action . args) (define from-actor (*current-actor*)) @@ -223,18 +229,18 @@ #:message message)) (apply method actor message (message-body message))) -(define-syntax-rule (wrap body) +(define-syntax-rule (live-wrap body) "Wrap possibly multi-value function in a procedure, applies all arguments" (lambda args (apply body args))) (define-syntax-rule (build-actions (symbol method) ...) "Construct an alist of (symbol . method), where the method is wrapped -with `wrap' to facilitate live hacking and allow the method definition +with `live-wrap' to facilitate live hacking and allow the method definition to come after class definition." (build-rmeta-slot (list (cons (quote symbol) - (wrap method)) ...))) + (live-wrap method)) ...))) (define-class () ;; An address object... a vector of #(actor-id hive-id inbox-channel dead?) @@ -366,10 +372,9 @@ and handling them." (lambda vals ;; Return reply if necessary (when (message-wants-reply message) - (when (message-wants-reply message) - (%<- #f actor (message-from message) '*reply* - vals ((actor-msg-id-generator actor)) - (message-id message))))))) + (%<- #f actor (message-from message) '*reply* + vals ((actor-msg-id-generator actor)) + (message-id message)))))) (const #t) (let ((err (current-error-port))) (lambda (key . args) @@ -670,14 +675,3 @@ its '*cleanup* action handler." (*actor-prompt* #f) (actor-cleanup! actor)) -;; From a patch I sent to Fibers... -(define (condition-signalled? cvar) - "Return @code{#t} if @var{cvar} has already been signalled. - -In general you will want to use @code{wait} or @code{wait-operation} to -wait on a condition. However, sometimes it is useful to see whether or -not a condition has already been signalled without blocking." - (atomic-box-ref ((@@ (fibers conditions) condition-signalled?) cvar))) - -(define (actor-alive? actor) - (condition-signalled? (address-dead? (actor-id actor))))