actor: clean-up: remove obsolete code, only use async:task

core/actor.lisp

@@ -51,14 +51,13 @@
 
 (defgeneric ac-loop (tsk bhv)
   (:method ((tsk async:mailbox) bhv)
-    (let ((*self* tsk)
+    (let ((msg (async:rcv tsk))
-          (msg (async:rcv tsk)))
+          result)
       (unless (eq (content msg) +quit-message+)
-        (ac-loop tsk (or (funcall bhv msg) bhv))))))
+        (let ((*self* tsk))
+          (setf result (funcall bhv msg)))
+        (ac-loop tsk (or result bhv))))))
 
-(defgeneric set-bhv (tsk bhv)
-  (:method ((tsk async:mailbox) bhv)))
- 
 ;;;; the core (classical, i.e. Hewitt) actor API
 
 (defun create (bhv)
@@ -69,30 +68,24 @@
     (async:snd tsk msg)))
 
 (defun become (bhv)
-  (set-bhv *self* bhv))
+  (setf (async:behavior *self*) bhv))
 
 ;;;; handling restartable tasks
 
 (defmethod ac-loop ((tsk async:restartable-task) bhv)
-  (async:get-status tsk)    ; wait for end of concurrent activities
+  (async:get-status tsk)    ; wait / lock status
   (multiple-value-bind (msg ok) (async:try-rcv tsk)
     (if ok
-      (if (eq (content msg) +quit-message+)
+      (progn 
-        (async:set-status tsk :stopped) 
+        (async:set-status tsk :running)
-        (progn 
+        (let ((*self* tsk)) 
-          (async:set-status tsk :running)
+          (handler-case (funcall bhv msg)
-          (let ((*self* tsk)) 
+            (error (error) (util:lg :error "handling message" msg error)))
-            (handler-case (funcall bhv msg)
+        (ac-loop tsk (async:behavior tsk))))
-              (error (error) (util:lg :error "handling message" msg error)))
+      (async:set-status tsk :suspended))))
-          (ac-loop tsk (async:behavior tsk)))))
-       (async:set-status tsk :suspended))))
 
 (defmethod send ((tsk async:restartable-task) msg)
   (let ((status (async:get-status tsk)))
-    (when (eq status :stopped)
-      (util:lgw "trying to send message to stopped task")
-      (async:set-status tsk :stopped)
-      (return-from send))
     (async:snd tsk msg)
     (unless (eq status :running) 
       (async:try-receive-result tsk)
@@ -100,9 +93,6 @@
         tsk (lambda () (ac-loop tsk (async:behavior tsk)))))
     (async:set-status tsk :running)))
 
-(defmethod set-bhv ((tsk async:task) bhv)
-  (setf (async:behavior tsk) bhv))
- 
  ;;;; predefined behaviors
 
 (defun no-op (msg))
@@ -126,5 +116,5 @@
 (defun minus (msg val param)
   (calculator (- val param))) 
 (defun show (msg val param)
-  (send (customer msg ) (message val)))
+  (send (customer msg) (message val)))
 

core/core.lisp

@@ -82,7 +82,7 @@
 (defun setup-services (&optional (cfg config:*root*))
   (async:init)
   (let* ((ctx (make-instance 'context :config cfg))) 
-    (setf (mailbox ctx) (async:make-mb))
+    (setf (mailbox ctx) (async:make-task nil))
     (setf *root* ctx))
   (dolist (c (reverse (config:children cfg)))
     (add-service *root* c)))

csys/csys.lisp

@@ -32,7 +32,7 @@
       (util:lgw "no action selected" msg))))
 
 (defun run-action (job msg)
-  (let ((mb (async:make-mb)))
+  (let ((mb (async:make-task job)))
     (async:submit-task mb (lambda () (funcall job msg)))))
 
 ;;;; example behaviors / actions

test/test-core.lisp

@@ -110,7 +110,7 @@
     (== (shape:head-value rec :username) :u1)))
 
 (deftest test-util-async ()
-  (let ((mb (async:make-mb)))
+  (let ((mb (async:make-task nil)))
     (async:submit-task mb (lambda () (sleep 0.1) :done))
     (== (async:try-receive-result mb) nil)
     (== (async:receive-result mb) :done)
@@ -126,8 +126,6 @@
     (actor:send calc (actor:message '(actor:minus 3)))
     (actor:send calc (actor:message '(actor:show) collector))
     (sleep 0.1)
-    (actor:stop calc)
-    (sleep 0.1)
     (== val -1)
 ))
 

web/response.lisp

@@ -74,7 +74,7 @@
   (let* ((headers (getf env :headers))
          (resp-class (select-response-class (gethash "accept" headers) html-responder))
          (resp (make-instance resp-class :context ctx :env env)))
-    (setf (core:mailbox resp) (async:make-mb))
+    (setf (core:mailbox resp) (async:make-task nil))
     resp))
     ;(actor:make-actor #'core:handle-message resp-class :context ctx :env env)))