Compare commits
No commits in common. "2f5a3b1d7400b6b5223dd04e7125b0d4b966faf9" and "2aaf8a482db8c3d84a17083696748daf91b0bf63" have entirely different histories.
2f5a3b1d74
...
2aaf8a482d
4 changed files with 26 additions and 39 deletions
|
@ -24,7 +24,8 @@
|
||||||
(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>"
|
(format stream "#<message ~a ~a ~a>"
|
||||||
(shape:head msg) (actor:customer msg) (shape:data msg)))
|
(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)))
|
||||||
|
|
|
@ -10,39 +10,26 @@
|
||||||
(:shape :scopes/shape)
|
(:shape :scopes/shape)
|
||||||
(:util :scopes/util)
|
(:util :scopes/util)
|
||||||
(:alx :alexandria))
|
(:alx :alexandria))
|
||||||
(:export #:send #:*sensors* #:neuron
|
(:export #:*dispatcher* #:printer #:setup #:send
|
||||||
#:nprint))
|
))
|
||||||
|
|
||||||
(in-package :scopes/csys)
|
(in-package :scopes/csys)
|
||||||
|
|
||||||
(defvar *sensors* (make-hash-table :test #'equal))
|
|
||||||
|
|
||||||
(defun send (msg)
|
(defun send (msg)
|
||||||
(if (eq (shape:head-value msg :domain) :csys)
|
(let ((hdlrs (core:select msg (core:actions core:*root*))))
|
||||||
(dolist (sn (find-create-sensors msg))
|
(if hdlrs
|
||||||
(actor:send sn msg))
|
;(mapcar #'(lambda (hdlr) (run-action hdlr msg)) hdlrs)
|
||||||
(core:handle-message core:*root* msg)))
|
(let ((tsks (mapcar (lambda (hdlr) (actor:create hdlr)) hdlrs)))
|
||||||
|
(dolist (tsk tsks) (actor:send tsk msg)))
|
||||||
|
(util:lgw "no action selected" msg))))
|
||||||
|
|
||||||
(defun find-create-sensors (msg)
|
(defun run-action (job msg)
|
||||||
(let* ((key (cddr (shape:head msg)))
|
(let ((mb (async:make-task job)))
|
||||||
(sns (gethash key *sensors*)))
|
(async:submit-task mb (lambda () (funcall job msg)))))
|
||||||
(format t "~&~a ~a" key sns)
|
|
||||||
(or sns
|
|
||||||
(let* ((mx (message:create
|
|
||||||
(list :csys :sensor (shape:head-value msg :class))))
|
|
||||||
(hdlrs (core:select mx (core:actions core:*root*))))
|
|
||||||
(if hdlrs
|
|
||||||
(let ((tsks (mapcar #'actor:create hdlrs)))
|
|
||||||
(setf (gethash key *sensors*) tsks))
|
|
||||||
(util:lgw "no action selected" msg))))))
|
|
||||||
|
|
||||||
;;;; neurons (= behavior generators)
|
;;;; example behaviors / actions
|
||||||
|
|
||||||
(defun neuron (proc &optional state syns env)
|
(defun printer (msg)
|
||||||
(lambda (msg) (funcall proc msg state syns env)))
|
(util:lgi msg)
|
||||||
|
;(format t "~&~a" msg)
|
||||||
;;;; predefined neuron processors
|
)
|
||||||
|
|
||||||
(defun nprint (msg state syns env)
|
|
||||||
(util:lgi msg state)
|
|
||||||
(actor:become (neuron #'nprint (shape:data msg) syns env)))
|
|
||||||
|
|
|
@ -4,8 +4,7 @@
|
||||||
|
|
||||||
(config:root)
|
(config:root)
|
||||||
|
|
||||||
(config:add-action '(:csys :sensor :log)
|
(config:add-action '(:test) #'csys:printer)
|
||||||
(csys:neuron #'csys:nprint :testing))
|
|
||||||
|
|
||||||
(config:add :logger :class 'logging:config
|
(config:add :logger :class 'logging:config
|
||||||
:loglevel (config:from-env :loglevel :info)
|
:loglevel (config:from-env :loglevel :info)
|
||||||
|
|
|
@ -22,8 +22,7 @@
|
||||||
|
|
||||||
(defun run ()
|
(defun run ()
|
||||||
(async:init)
|
(async:init)
|
||||||
(let* ((t:*test-suite* (make-instance 't:test-suite :name "csys"))
|
(let* ((t:*test-suite* (make-instance 't:test-suite :name "csys")))
|
||||||
(csys:*sensors* (make-hash-table :test #'equal)))
|
|
||||||
(load (t:test-path "config-csys" "etc"))
|
(load (t:test-path "config-csys" "etc"))
|
||||||
(unwind-protect
|
(unwind-protect
|
||||||
(progn
|
(progn
|
||||||
|
@ -33,9 +32,10 @@
|
||||||
|
|
||||||
(deftest test-nodispatch ()
|
(deftest test-nodispatch ()
|
||||||
(core:setup-services)
|
(core:setup-services)
|
||||||
(csys:send (message:create '(:csys :add :log :s1) :data 1))
|
;(csys:setup)
|
||||||
(csys:send (message:create '(:csys :add :log :s1) :data 3))
|
(csys:send (message:create '(:test :add :op :n1) :data 1))
|
||||||
(csys:send (message:create '(:csys :sub :log :s2) :data 4))
|
(csys:send (message:create '(:test :add :op :n1) :data 3))
|
||||||
(csys:send (message:create '(:csys :add :log :s2) :data 5))
|
(csys:send (message:create '(:test :sub :op :n2) :data 4))
|
||||||
(sleep 0.1)
|
(csys:send (message:create '(:test :add :op :n2) :data 5))
|
||||||
|
(sleep 0.2)
|
||||||
)
|
)
|
||||||
|
|
Loading…
Add table
Reference in a new issue