Compare commits
2 commits
a52617136d
...
6facc4f22e
| Author | SHA1 | Date | |
|---|---|---|---|
| 6facc4f22e | |||
| b773e0aedb |
3 changed files with 21 additions and 12 deletions
|
|
@ -76,14 +76,14 @@
|
||||||
(defun std-proc (msg scope &key (default #'remember) params actions)
|
(defun std-proc (msg scope &key (default #'remember) params actions)
|
||||||
(util:mv-bind (nmsg (nscope scope))
|
(util:mv-bind (nmsg (nscope scope))
|
||||||
(handle-action msg scope :default default :actions actions :params params)
|
(handle-action msg scope :default default :actions actions :params params)
|
||||||
(forward nmsg (syns nscope))
|
(when nmsg (forward nmsg (syns nscope)))
|
||||||
(update nscope)))
|
(update nscope)))
|
||||||
|
|
||||||
(defun eff-proc (msg scope &key params actions)
|
(defun eff-proc (msg scope &key params actions)
|
||||||
(util:mv-bind (nmsg (nscope scope))
|
(util:mv-bind (nmsg (nscope scope))
|
||||||
(handle-action msg scope :default #'no-op :actions actions :params params)
|
(handle-action msg scope :default (no-op) :actions actions :params params)
|
||||||
(setf (nth 1 (shape:head nmsg)) :notify)
|
(setf (nth 1 (shape:head nmsg)) :effect)
|
||||||
(notify nmsg nscope)
|
(when nmsg (notify nmsg nscope))
|
||||||
(update nscope)))
|
(update nscope)))
|
||||||
|
|
||||||
(defun create (msg scope)
|
(defun create (msg scope)
|
||||||
|
|
@ -100,7 +100,7 @@
|
||||||
(dolist (s syns)
|
(dolist (s syns)
|
||||||
(funcall s msg)))
|
(funcall s msg)))
|
||||||
|
|
||||||
(defun handle-action (msg scope &key (default #'no-op) actions params)
|
(defun handle-action (msg scope &key (default (no-op)) actions params)
|
||||||
(let* ((key (message:action msg))
|
(let* ((key (message:action msg))
|
||||||
(act (getf actions key (getf actions :default default))))
|
(act (getf actions key (getf actions :default default))))
|
||||||
(apply act msg scope params)))
|
(apply act msg scope params)))
|
||||||
|
|
@ -113,7 +113,9 @@
|
||||||
|
|
||||||
;;;; predefined neuron actions
|
;;;; predefined neuron actions
|
||||||
|
|
||||||
(defun no-op (msg scope) msg)
|
(defun no-op (&key stop)
|
||||||
|
(lambda (msg scope)
|
||||||
|
(unless stop msg)))
|
||||||
|
|
||||||
(defun remember (msg scope)
|
(defun remember (msg scope)
|
||||||
(setf (value scope) (shape:data-value msg :value))
|
(setf (value scope) (shape:data-value msg :value))
|
||||||
|
|
|
||||||
|
|
@ -25,8 +25,10 @@
|
||||||
|
|
||||||
(defun actions ()
|
(defun actions ()
|
||||||
(list :created #'cell-created
|
(list :created #'cell-created
|
||||||
:notify #'csys:no-op
|
:notify (csys:no-op)
|
||||||
:default #'forward))
|
:effect (csys:no-op)
|
||||||
|
:value #'forward
|
||||||
|
:default (csys:no-op :stop t)))
|
||||||
|
|
||||||
(defun cell-created (msg scope)
|
(defun cell-created (msg scope)
|
||||||
(let* ((data (shape:data msg))
|
(let* ((data (shape:data msg))
|
||||||
|
|
@ -38,7 +40,7 @@
|
||||||
(defun forward (msg scope)
|
(defun forward (msg scope)
|
||||||
(dolist (cell (find-cells (cells scope) (message:addr msg)))
|
(dolist (cell (find-cells (cells scope) (message:addr msg)))
|
||||||
(actor:send cell msg))
|
(actor:send cell msg))
|
||||||
msg)
|
nil)
|
||||||
|
|
||||||
;;;; helpers
|
;;;; helpers
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -29,7 +29,8 @@
|
||||||
|
|
||||||
(defun setup-config ()
|
(defun setup-config ()
|
||||||
(config:add :test-receiver :setup #'tc:setup)
|
(config:add :test-receiver :setup #'tc:setup)
|
||||||
(config:add-action '(:csys :notify :c00 "0-0") (value-in '(1)))
|
;(config:add-action '(:csys :effect :c00 "0-0") (value-in '(1)))
|
||||||
|
(config:add-action '(:csys :effect) #'tc:check-message)
|
||||||
(config:add-action '(:csys) (constantly nil))
|
(config:add-action '(:csys) (constantly nil))
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
@ -38,7 +39,8 @@
|
||||||
(util:mv-bind (nmsg (scope scope))
|
(util:mv-bind (nmsg (scope scope))
|
||||||
(csys:handle-action msg scope :actions (environ:actions))
|
(csys:handle-action msg scope :actions (environ:actions))
|
||||||
(util:lgi nmsg (tc:receiver t:*test-suite*))
|
(util:lgi nmsg (tc:receiver t:*test-suite*))
|
||||||
(actor:send (core:mailbox (tc:receiver t:*test-suite*)) nmsg))))
|
(when nmsg
|
||||||
|
(actor:send (core:mailbox (tc:receiver t:*test-suite*)) nmsg)))))
|
||||||
|
|
||||||
(defun run ()
|
(defun run ()
|
||||||
(let ((t:*test-suite* (make-instance 'tc:test-suite :name "csys")))
|
(let ((t:*test-suite* (make-instance 'tc:test-suite :name "csys")))
|
||||||
|
|
@ -47,6 +49,7 @@
|
||||||
(unwind-protect
|
(unwind-protect
|
||||||
(test-basic-0)
|
(test-basic-0)
|
||||||
(sleep 0.1)
|
(sleep 0.1)
|
||||||
|
(tc:check-expected)
|
||||||
(t:show-result))))
|
(t:show-result))))
|
||||||
|
|
||||||
;;;; test: initialization
|
;;;; test: initialization
|
||||||
|
|
@ -62,8 +65,10 @@
|
||||||
env))
|
env))
|
||||||
|
|
||||||
(deftest test-basic-0 ()
|
(deftest test-basic-0 ()
|
||||||
(let ((env (setup-test (csys:make-program #'csys:eff-proc))))
|
(let ((env (setup-test (csys:make-program #'csys:eff-proc)))
|
||||||
|
(rcvr (tc:receiver t:*test-suite*)))
|
||||||
(sleep 0.1)
|
(sleep 0.1)
|
||||||
|
(tc:expect rcvr (message:create '(:csys :effect :c00 "0-0") :data '(:value 1)))
|
||||||
(actor:send env (message:create '(:csys :value :c00 "0-0") :data '(:value 1)))
|
(actor:send env (message:create '(:csys :value :c00 "0-0") :data '(:value 1)))
|
||||||
(sleep 0.1)
|
(sleep 0.1)
|
||||||
(core:shutdown)))
|
(core:shutdown)))
|
||||||
|
|
|
||||||
Loading…
Add table
Reference in a new issue