From 55621557407f13f7848479f61a2a2c15b230a33b Mon Sep 17 00:00:00 2001 From: Helmut Merz Date: Tue, 17 Jun 2025 09:47:01 +0200 Subject: [PATCH] actor: clean-up: remove obsolete code, only use async:task --- core/actor.lisp | 40 +++++++++++++++------------------------- core/core.lisp | 2 +- csys/csys.lisp | 2 +- test/test-core.lisp | 4 +--- web/response.lisp | 2 +- 5 files changed, 19 insertions(+), 31 deletions(-) diff --git a/core/actor.lisp b/core/actor.lisp index 1f5556c..19e80cc 100644 --- a/core/actor.lisp +++ b/core/actor.lisp @@ -51,14 +51,13 @@ (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)))))) + (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+) - (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))))) - (async:set-status tsk :suspended)))) + (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)))) + (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))) diff --git a/core/core.lisp b/core/core.lisp index fbfb4a4..ffa0569 100644 --- a/core/core.lisp +++ b/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))) diff --git a/csys/csys.lisp b/csys/csys.lisp index 97dbadc..8c1b566 100644 --- a/csys/csys.lisp +++ b/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 diff --git a/test/test-core.lisp b/test/test-core.lisp index 0079b86..3a0e812 100644 --- a/test/test-core.lisp +++ b/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) )) diff --git a/web/response.lisp b/web/response.lisp index 99dc925..5886be2 100644 --- a/web/response.lisp +++ b/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)))