#:use-module (fibers channels)
#:use-module (fibers conditions)
#:use-module (fibers operations)
- #:use-module (fibers internal)
#:use-module (8sync inbox)
#:use-module (8sync rmeta-slot)
actor-id
actor-message-handler
+ *current-actor*
+
;;; Commenting out the <address> type for now;
;;; it may be back when we have better serializers
;; <address>
actor-init! actor-cleanup!
- actor-alive?
-
build-actions
define-actor
<- <-wait
- spawn-hive run-hive))
+ spawn-hive run-hive
+
+ ;; Maybe the wrong place for this, or for it to be exported.
+ ;; But it's used in websockets' server implementation at least...
+ live-wrap))
;; For ids
(set! *random-state* (random-state-from-platform))
;; 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
'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>)) actor)
+ (%<- wants-reply from-actor (actor-id actor) action
+ args message-id in-reply-to))))
(define (<- to action . args)
(define from-actor (*current-actor*))
#:message message))
(apply method actor message (message-body message)))
-(define-syntax-rule (wrap-apply 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-apply 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-apply method)) ...)))
+ (live-wrap method)) ...)))
(define-class <actor> ()
;; An address object... a vector of #(actor-id hive-id inbox-channel dead?)
;; spawn a fiber that wakes up a thunk on the actor when its port is
;; available. Funky...
-(define (%suspend-io-to-actor resume-method get-wait-fd-method)
+(define (%suspend-io-to-actor wait-for-read/write)
(lambda (port)
(define prompt (*actor-prompt*))
(define resume-channel (*resume-io-channel*))
(define (run-at-prompt k)
(spawn-fiber
(lambda ()
- (suspend-current-fiber
- (lambda (fiber)
- (resume-on-readable-fd (port-read-wait-fd port) fiber)))
+ (wait-for-read/write port)
;; okay, we're awake again, tell the actor to resume this
;; continuation
(put-message resume-channel k))
'run-me run-at-prompt)))
(define suspend-read-to-actor
- (%suspend-io-to-actor resume-on-readable-fd port-read-wait-fd))
+ (%suspend-io-to-actor (@@ (fibers) wait-for-readable)))
(define suspend-write-to-actor
- (%suspend-io-to-actor resume-on-writable-fd port-write-wait-fd))
+ (%suspend-io-to-actor (@@ (fibers) wait-for-writable)))
(define (with-actor-nonblocking-ports thunk)
"Runs THUNK in dynamic context in which attempting to read/write
(*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))))
projects / 8sync.git / blobdiff