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

work in progress: csys: autostart actors upon send

Browse source
This commit is contained in:
Helmut Merz 2025-06-18 10:24:04 +02:00
parent 5565a60353
commit 2aaf8a482d
4 changed files with 23 additions and 21 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
core/core.lisp
View file

@ -83,6 +83,8 @@
(async:init) (async:init)
(let* ((ctx (make-instance 'context :config cfg))) (let* ((ctx (make-instance 'context :config cfg)))
(setf (mailbox ctx) (async:make-task nil)) (setf (mailbox ctx) (async:make-task nil))
(dolist (a (config:actions cfg))
(add-action ctx (car a) (cadr a)))
(setf *root* ctx)) (setf *root* ctx))
(dolist (c (reverse (config:children cfg))) (dolist (c (reverse (config:children cfg)))
(add-service *root* c))) (add-service *root* c)))

10
core/message.lisp
View file

@ -14,14 +14,18 @@
(defun message-meta () (defun message-meta ()
(make-instance 'shape:record-meta :head-fields '(:domain :action :class :item))) (make-instance 'shape:record-meta :head-fields '(:domain :action :class :item)))
(defclass message (shape:record actor:message) (defclass message (shape:record)
((shape:meta :initform (message-meta) :allocation :class))) ((shape:meta :initform (message-meta) :allocation :class)
(actor:customer :accessor customer :initarg :customer :initform nil)))
(defun create (head &key data customer) (defun create (head &key data customer)
(shape:create 'message :head head :data data :customer customer)) (shape:create 'message :head head :data data :customer customer))
(defmethod print-object ((msg message) stream) (defmethod print-object ((msg message) stream)
(shape:print-slots msg stream 'shape:head 'actor:customer 'shape:data)) ;(shape:print-slots msg stream 'shape:head 'actor:customer 'shape:data)
(format stream "#<message ~a ~a ~a>"
(shape:head msg) (actor:customer msg) (shape:data msg))
)
(defmethod actor:content ((msg message)) (defmethod actor:content ((msg message))
(list (shape:head-plist msg) (shape:data msg))) (list (shape:head-plist msg) (shape:data msg)))

20
csys/csys.lisp
View file

@ -16,19 +16,11 @@
(in-package :scopes/csys) (in-package :scopes/csys)
(defun send (msg) (defun send (msg)
(handle-message msg)) (let ((hdlrs (core:select msg (core:actions core:*root*))))
(defvar *dispatcher* nil)
(defun setup (&optional (cfg config:*root*))
(setf *dispatcher* (make-instance 'core:context :config cfg))
(dolist (a (config:actions cfg))
(core:add-action *dispatcher* (car a) (cadr a))))
(defun handle-message (msg)
(let ((hdlrs (core:select msg (core:actions *dispatcher*))))
(if hdlrs (if hdlrs
(mapcar #'(lambda (hdlr) (run-action hdlr msg)) hdlrs) ;(mapcar #'(lambda (hdlr) (run-action hdlr msg)) hdlrs)
(let ((tsks (mapcar (lambda (hdlr) (actor:create hdlr)) hdlrs)))
(dolist (tsk tsks) (actor:send tsk msg)))
(util:lgw "no action selected" msg)))) (util:lgw "no action selected" msg))))
(defun run-action (job msg) (defun run-action (job msg)
@ -38,4 +30,6 @@
;;;; example behaviors / actions ;;;; example behaviors / actions
(defun printer (msg) (defun printer (msg)
(format t "~&*** message: ~a~%" msg)) (util:lgi msg)
;(format t "~&~a" msg)
)

12
test/test-csys.lisp
View file

@ -31,9 +31,11 @@
(t:show-result)))) (t:show-result))))
(deftest test-nodispatch () (deftest test-nodispatch ()
(csys:setup) (core:setup-services)
(csys:send (message:create '(:test 1))) ;(csys:setup)
(csys:send (message:create '(:test 2))) (csys:send (message:create '(:test :add :op :n1) :data 1))
(csys:send (message:create '(:test 3))) (csys:send (message:create '(:test :add :op :n1) :data 3))
(csys:send (message:create '(:test 4))) (csys:send (message:create '(:test :sub :op :n2) :data 4))
(csys:send (message:create '(:test :add :op :n2) :data 5))
(sleep 0.2)
) )