Fix unnecessary conditional check.
[8sync.git] / 8sync / actors.scm
index 05502fd0a4f7e07c2c2d0eff5ee905cb1cbaf85e..8abe41a1133b20c65dcaf8a3ff3ca1c5f40a8c3e 100644 (file)
@@ -43,6 +43,8 @@
             actor-id
             actor-message-handler
 
+            *current-actor*
+
             ;;; Commenting out the <address> type for now;
             ;;; it may be back when we have better serializers
             ;; <address>
@@ -56,8 +58,6 @@
 
             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?)
@@ -362,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)
@@ -666,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))))