diff --git a/core/core.lisp b/core/core.lisp index ffa0569..deefb24 100644 --- a/core/core.lisp +++ b/core/core.lisp @@ -83,6 +83,8 @@ (async:init) (let* ((ctx (make-instance 'context :config cfg))) (setf (mailbox ctx) (async:make-task nil)) + (dolist (a (config:actions cfg)) + (add-action ctx (car a) (cadr a))) (setf *root* ctx)) (dolist (c (reverse (config:children cfg))) (add-service *root* c))) diff --git a/core/message.lisp b/core/message.lisp index e2282f3..0ffe48f 100644 --- a/core/message.lisp +++ b/core/message.lisp @@ -14,14 +14,18 @@ (defun message-meta () (make-instance 'shape:record-meta :head-fields '(:domain :action :class :item))) -(defclass message (shape:record actor:message) - ((shape:meta :initform (message-meta) :allocation :class))) +(defclass message (shape:record) + ((shape:meta :initform (message-meta) :allocation :class) + (actor:customer :accessor customer :initarg :customer :initform nil))) (defun create (head &key data customer) (shape:create 'message :head head :data data :customer customer)) (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 "#" + (shape:head msg) (actor:customer msg) (shape:data msg)) + ) (defmethod actor:content ((msg message)) (list (shape:head-plist msg) (shape:data msg))) diff --git a/csys/csys.lisp b/csys/csys.lisp index 8c1b566..cdee4c3 100644 --- a/csys/csys.lisp +++ b/csys/csys.lisp @@ -16,19 +16,11 @@ (in-package :scopes/csys) (defun send (msg) - (handle-message msg)) - -(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*)))) + (let ((hdlrs (core:select msg (core:actions core:*root*)))) (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)))) (defun run-action (job msg) @@ -38,4 +30,6 @@ ;;;; example behaviors / actions (defun printer (msg) - (format t "~&*** message: ~a~%" msg)) + (util:lgi msg) + ;(format t "~&~a" msg) + ) diff --git a/test/test-csys.lisp b/test/test-csys.lisp index e9471d5..eabd2d4 100644 --- a/test/test-csys.lisp +++ b/test/test-csys.lisp @@ -31,9 +31,11 @@ (t:show-result)))) (deftest test-nodispatch () - (csys:setup) - (csys:send (message:create '(:test 1))) - (csys:send (message:create '(:test 2))) - (csys:send (message:create '(:test 3))) - (csys:send (message:create '(:test 4))) + (core:setup-services) + ;(csys:setup) + (csys:send (message:create '(:test :add :op :n1) :data 1)) + (csys:send (message:create '(:test :add :op :n1) :data 3)) + (csys:send (message:create '(:test :sub :op :n2) :data 4)) + (csys:send (message:create '(:test :add :op :n2) :data 5)) + (sleep 0.2) )