actor: clean-up: remove obsolete code, only use async:task
This commit is contained in:
parent
4503391b22
commit
5562155740
5 changed files with 19 additions and 31 deletions
|
@ -51,13 +51,12 @@
|
|||
|
||||
(defgeneric ac-loop (tsk bhv)
|
||||
(:method ((tsk async:mailbox) bhv)
|
||||
(let ((*self* tsk)
|
||||
(msg (async:rcv tsk)))
|
||||
(let ((msg (async:rcv tsk))
|
||||
result)
|
||||
(unless (eq (content msg) +quit-message+)
|
||||
(ac-loop tsk (or (funcall bhv msg) bhv))))))
|
||||
|
||||
(defgeneric set-bhv (tsk bhv)
|
||||
(:method ((tsk async:mailbox) bhv)))
|
||||
(let ((*self* tsk))
|
||||
(setf result (funcall bhv msg)))
|
||||
(ac-loop tsk (or result bhv))))))
|
||||
|
||||
;;;; the core (classical, i.e. Hewitt) actor API
|
||||
|
||||
|
@ -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+)
|
||||
(async:set-status tsk :stopped)
|
||||
(progn
|
||||
(async:set-status tsk :running)
|
||||
(let ((*self* tsk))
|
||||
(handler-case (funcall bhv msg)
|
||||
(error (error) (util:lg :error "handling message" msg error)))
|
||||
(ac-loop tsk (async:behavior tsk)))))
|
||||
(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)))
|
||||
|
||||
|
|
|
@ -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)))
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
))
|
||||
|
||||
|
|
|
@ -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)))
|
||||
|
||||
|
|
Loading…
Add table
Reference in a new issue