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

new actor implementation basically working

Browse source
This commit is contained in:
Helmut Merz 2025-06-01 19:14:29 +02:00
parent 386d286fe6
commit a33071906f
3 changed files with 31 additions and 19 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
core/actor-ng.lisp
View file

@ -40,7 +40,7 @@
ch))) ch)))
(defun stop (mb) (defun stop (mb)
(send mb +quit-message+)) (send mb (message +quit-message+)))
(defun ac-loop (mb bhv) (defun ac-loop (mb bhv)
(let ((next (ac-step mb bhv))) (let ((next (ac-step mb bhv)))
@ -49,7 +49,9 @@
(defun ac-step (mb bhv) (defun ac-step (mb bhv)
(let ((msg (lpq:pop-queue mb))) (let ((msg (lpq:pop-queue mb)))
(funcall bhv msg))) (if (eq (content msg) +quit-message+)
+quit-message+
(funcall bhv msg))))
;;;; the core (classical, i.e. Hewitt) actor API ;;;; the core (classical, i.e. Hewitt) actor API
;;; there is no `become` operation: the behavior just returns the new behavior ;;; there is no `become` operation: the behavior just returns the new behavior
@ -83,7 +85,8 @@
;;;; example behavior: calculator ;;;; example behavior: calculator
(defun calculator (&optional (val 0)) (defun calculator (&optional (val 0))
#'(lambda (msg) (lambda (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)))) (funcall fn msg val param))))
@ -92,7 +95,7 @@
(defun minus (msg val param) (defun minus (msg val param)
(calculator (- val param))) (calculator (- val param)))
(defun show (msg val param) (defun show (msg val param)
(send (or (customer msg) *logger*) val)) (send (or (customer msg) *logger*) (message val)))
(defun send-value (msg val param) (defun send-value (msg val param)
(send (customer msg) val)) (send (customer msg) (message val)))

3
core/core.lisp
View file

@ -104,7 +104,8 @@
(funcall (config:shutdown (config ctx)) ctx)) (funcall (config:shutdown (config ctx)) ctx))
(if (task *root*) (if (task *root*)
(actor:stop *root*)) (actor:stop *root*))
(async:finish)) (async:finish)
)
(defun add-action (ctx pat hdlr) (defun add-action (ctx pat hdlr)
(let* ((acts (actions ctx)) (let* ((acts (actions ctx))

16
test/test-core.lisp
View file

@ -146,10 +146,18 @@
(deftest test-actor () (deftest test-actor ()
;(async:init) ;(async:init)
(let (calc (actor:create (actor:calculator))) (let* ((calc (actor:create (actor:calculator)))
;(actor:stop calc) val
) (collector
) (actor:create (lambda (msg) (setf val (actor:content msg))))))
(actor:send calc (actor:message '(actor:plus 2)))
(actor:send calc (actor:message '(actor:minus 3)))
(actor:send calc (actor:message '(actor:show)))
(actor:send calc (actor:message '(actor:send-value) collector))
(actor:stop calc)
(sleep 0.1)
(== val -1)
))
(deftest test-send () (deftest test-send ()
(let ((rcvr (receiver t:*test-suite*)) (let ((rcvr (receiver t:*test-suite*))