cco/cl-scopes
3
0
Fork 0
Code Issues 1 Pull requests Releases Wiki Activity Actions

actor: improve handling of standard (looping) task, use behavior slot

Browse source
This commit is contained in:
Helmut Merz 2025-06-17 10:40:21 +02:00
parent 5562155740
commit 91e52e7437
1 changed files with 8 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

15
core/actor.lisp
View file

@ -40,6 +40,7 @@
(defconstant +quit-message+ (gensym "QUIT"))))
(defun start (tsk bhv &key foreground)
(setf (async:behavior tsk) bhv)
(if foreground
(ac-loop tsk bhv)
(async:submit-task tsk #'ac-loop tsk bhv)))
@ -50,13 +51,13 @@
(defvar *self* nil)
(defgeneric ac-loop (tsk bhv)
(:method ((tsk async:mailbox) bhv)
(let ((msg (async:rcv tsk))
result)
(:method ((tsk async:task) bhv)
(let ((msg (async:rcv tsk)))
(unless (eq (content msg) +quit-message+)
(let ((*self* tsk))
(setf result (funcall bhv msg)))
(ac-loop tsk (or result bhv))))))
(handler-case (funcall bhv msg)
(error (error) (util:lg :error "behavior" msg error))))
(ac-loop tsk (async:behavior tsk))))))
;;;; the core (classical, i.e. Hewitt) actor API
@ -64,7 +65,7 @@
(async:make-task bhv :restartable t))
(defgeneric send (tsk msg)
(:method ((tsk async:mailbox) msg)
(:method ((tsk async:task) msg)
(async:snd tsk msg)))
(defun become (bhv)
@ -80,7 +81,7 @@
(async:set-status tsk :running)
(let ((*self* tsk))
(handler-case (funcall bhv msg)
(error (error) (util:lg :error "handling message" msg error)))
(error (error) (util:lg :error "behavior" msg error)))
(ac-loop tsk (async:behavior tsk))))
(async:set-status tsk :suspended))))