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

Compare commits

base: cco:6facc4f22e57049f9dc2b753dd46f0dd60c6786c
Branches Tags
cco:master
..
compare: cco:a52617136d9f2beffeea1a40dd8514541b30bad2
Branches Tags
cco:master

No commits in common. "6facc4f22e57049f9dc2b753dd46f0dd60c6786c" and "a52617136d9f2beffeea1a40dd8514541b30bad2" have entirely different histories.
6facc4f22e ... a52617136d

3 changed files with 12 additions and 21 deletions
Show stats Expand all files Collapse all files

14
csys/csys.lisp
View file

@ -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)
(when nmsg (forward nmsg (syns nscope))) (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)) :effect) (setf (nth 1 (shape:head nmsg)) :notify)
(when nmsg (notify nmsg nscope)) (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,9 +113,7 @@
;;;; predefined neuron actions ;;;; predefined neuron actions
(defun no-op (&key stop) (defun no-op (msg scope) msg)
(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))

8
csys/environ.lisp
View file

@ -25,10 +25,8 @@
(defun actions () (defun actions ()
(list :created #'cell-created (list :created #'cell-created
:notify (csys:no-op) :notify #'csys:no-op
:effect (csys:no-op) :default #'forward))
: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))
@ -40,7 +38,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))
nil) msg)
;;;; helpers ;;;; helpers

11
test/test-csys.lisp
View file

@ -29,8 +29,7 @@
(defun setup-config () (defun setup-config ()
(config:add :test-receiver :setup #'tc:setup) (config:add :test-receiver :setup #'tc:setup)
;(config:add-action '(:csys :effect :c00 "0-0") (value-in '(1))) (config:add-action '(:csys :notify :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))
) )
@ -39,8 +38,7 @@
(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*))
(when nmsg (actor:send (core:mailbox (tc:receiver t:*test-suite*)) 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")))
@ -49,7 +47,6 @@
(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
@ -65,10 +62,8 @@
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)))