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

work in progress: restartable task: fix become - use *self* for current task in ac-loop

Browse source
This commit is contained in:
Helmut Merz 2025-06-16 10:26:17 +02:00
parent 8de0ee8927
commit b8dd5314e2
2 changed files with 16 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

24
core/actor.lisp
View file

@ -47,12 +47,18 @@
(defun stop (mb) (defun stop (mb)
(send mb +quit-message+)) (send mb +quit-message+))
(defvar *self* nil)
(defgeneric ac-loop (tsk bhv) (defgeneric ac-loop (tsk bhv)
(:method ((tsk async:mailbox) bhv) (:method ((tsk async:mailbox) bhv)
(let ((msg (async:rcv tsk))) (let ((*self* tsk)
(msg (async:rcv tsk)))
(unless (eq (content msg) +quit-message+) (unless (eq (content msg) +quit-message+)
(ac-loop tsk (or (funcall bhv msg) bhv)))))) (ac-loop tsk (or (funcall bhv msg) bhv))))))
(defgeneric set-bhv (tsk bhv)
(:method ((tsk async:mailbox) bhv)))
;;;; the core (classical, i.e. Hewitt) actor API ;;;; the core (classical, i.e. Hewitt) actor API
(defun create (bhv) (defun create (bhv)
@ -65,8 +71,9 @@
;(util:lgi msg) ;(util:lgi msg)
(async:snd tsk msg))) (async:snd tsk msg)))
(defgeneric become (tsk bhv) (defun become (bhv)
(:method ((tsk async:mailbox) bhv) bhv)) (set-bhv *self* bhv)
bhv)
;;;; handling restartable tasks ;;;; handling restartable tasks
@ -76,9 +83,9 @@
(if ok (if ok
(if (eq (content msg) +quit-message+) (if (eq (content msg) +quit-message+)
(progn (async:set-status tsk :stopped) nil) (progn (async:set-status tsk :stopped) nil)
(progn (let ((*self* tsk))
(async:set-status tsk :running) (async:set-status tsk :running)
(ac-vloop tsk (or (funcall bhv msg) bhv)))) (ac-loop tsk (or (funcall bhv msg) bhv))))
(progn (async:set-status tsk :suspended) bhv)))) (progn (async:set-status tsk :suspended) bhv))))
(defmethod send ((tsk async:restartable-task) msg) (defmethod send ((tsk async:restartable-task) msg)
@ -94,9 +101,8 @@
tsk (lambda () (ac-loop tsk (async:behavior tsk))))) tsk (lambda () (ac-loop tsk (async:behavior tsk)))))
(async:set-status :running))) (async:set-status :running)))
(defmethod become ((tsk async:task) bhv) (defmethod set-bhv ((tsk async:task) bhv)
(setf (async:behavior tsk) bhv) (setf (async:behavior tsk) bhv))
bhv)
;;;; predefined behaviors ;;;; predefined behaviors
@ -114,7 +120,7 @@
(lambda (msg) (lambda (msg)
;(format t "calc ~a ~a~%" val (content msg)) ;(format t "calc ~a ~a~%" val (content msg))
(destructuring-bind (fn &optional param) (content msg) (destructuring-bind (fn &optional param) (content msg)
(funcall fn msg val param)))) (become (funcall fn msg val param)))))
(defun plus (msg val param) (defun plus (msg val param)
(calculator (+ val param))) (calculator (+ val param)))

2
util/async.lisp
View file

@ -4,7 +4,7 @@
(:use :common-lisp) (:use :common-lisp)
(:local-nicknames (:lp :lparallel) (:local-nicknames (:lp :lparallel)
(:lpq :lparallel.queue)) (:lpq :lparallel.queue))
(:export #:init #:finish #:make-ch #:make-mb #:make-task #:rcv #:try-rcv #:snd (:export #:init #:finish #:make-mb #:make-task #:rcv #:try-rcv #:snd
#:mailbox #:task #:restartable-task #:behavior #:get-status #:set-status #:mailbox #:task #:restartable-task #:behavior #:get-status #:set-status
#:submit-task #:receive-result #:try-receive-result)) #:submit-task #:receive-result #:try-receive-result))