new actor implementation basically working
This commit is contained in:
parent
386d286fe6
commit
a33071906f
3 changed files with 31 additions and 19 deletions
|
@ -40,7 +40,7 @@
|
|||
ch)))
|
||||
|
||||
(defun stop (mb)
|
||||
(send mb +quit-message+))
|
||||
(send mb (message +quit-message+)))
|
||||
|
||||
(defun ac-loop (mb bhv)
|
||||
(let ((next (ac-step mb bhv)))
|
||||
|
@ -49,7 +49,9 @@
|
|||
|
||||
(defun ac-step (mb bhv)
|
||||
(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
|
||||
;;; there is no `become` operation: the behavior just returns the new behavior
|
||||
|
@ -83,16 +85,17 @@
|
|||
;;;; example behavior: calculator
|
||||
|
||||
(defun calculator (&optional (val 0))
|
||||
#'(lambda (msg)
|
||||
(destructuring-bind (fn &optional param) (content msg)
|
||||
(funcall fn msg val param))))
|
||||
(lambda (msg)
|
||||
(format t "calc ~a ~a~%" val (content msg))
|
||||
(destructuring-bind (fn &optional param) (content msg)
|
||||
(funcall fn msg val param))))
|
||||
|
||||
(defun plus (msg val param)
|
||||
(calculator (+ val param)))
|
||||
(defun minus (msg val param)
|
||||
(calculator (- 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)
|
||||
(send (customer msg) val))
|
||||
(send (customer msg) (message val)))
|
||||
|
||||
|
|
|
@ -92,19 +92,20 @@
|
|||
(dolist (c (reverse (config:children cfg)))
|
||||
(add-service *root* c)))
|
||||
|
||||
(defun run-services (&optional (cfg config:*root*))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(setup-services cfg)
|
||||
(actor:start *root*))
|
||||
(shutdown)))
|
||||
(defun run-services (&optional (cfg config:*root*))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(setup-services cfg)
|
||||
(actor:start *root*))
|
||||
(shutdown)))
|
||||
|
||||
(defun shutdown ()
|
||||
(defun shutdown ()
|
||||
(dolist (ctx (alx:hash-table-values (services *root*)))
|
||||
(funcall (config:shutdown (config ctx)) ctx))
|
||||
(if (task *root*)
|
||||
(actor:stop *root*))
|
||||
(async:finish))
|
||||
(async:finish)
|
||||
)
|
||||
|
||||
(defun add-action (ctx pat hdlr)
|
||||
(let* ((acts (actions ctx))
|
||||
|
|
|
@ -146,10 +146,18 @@
|
|||
|
||||
(deftest test-actor ()
|
||||
;(async:init)
|
||||
(let (calc (actor:create (actor:calculator)))
|
||||
;(actor:stop calc)
|
||||
)
|
||||
)
|
||||
(let* ((calc (actor:create (actor:calculator)))
|
||||
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 ()
|
||||
(let ((rcvr (receiver t:*test-suite*))
|
||||
|
|
Loading…
Add table
Reference in a new issue