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

csys: program basic-1 (2 sensors, 2 effectors) working

Browse source
This commit is contained in:
Helmut Merz 2026-08-04 10:46:20 +02:00
parent 9a80b76eeb
commit 69a9c425dd
5 changed files with 25 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
core/message.lisp
View file

@ -40,8 +40,10 @@
(list (car head) (cadr head))))
(defun addr (msg)
(let ((head (shape:head msg)))
(cons (car head) (cddr head))))
(let* ((head (shape:head msg)))
(if (caddr head)
(cons (car head) (cddr head))
nil)))
(defun categ (msg)
(let ((head (shape:head msg)))

3
csys/csys.lisp
View file

@ -183,7 +183,8 @@
;;;; public shortcuts
(defun send-create (cell &rest args &key (domain :csys) (cat :c00) loc connect op)
(defun send-create (cell &rest args &key (domain :csys)
(cat :c00) loc connect op &allow-other-keys)
(let ((args+ (if loc
`(:addr ,(list domain cat loc))
`(:categ ,(list domain cat)))))

10
csys/environ.lisp
View file

@ -28,7 +28,7 @@
:notify (csys:no-op)
:effect (csys:no-op)
:value #'forward
:connect #'forward
:connect #'forward-connect
:default (csys:no-op :no-forward t)))
(defun cell-created (msg scope)
@ -53,6 +53,12 @@
(util:lgw "no addr and no :to field in message" msg scope)))))
nil)
(defun forward-connect (msg scope)
(let* ((data (shape:data msg))
(tgt (car (find-cells (cells scope) (getf data :target)))))
(setf (getf data :target) tgt)
(forward (message:create (shape:head msg) :data data) scope)))
;;;; public shortcuts
(defun send-value (env val &key (domain :csys) (cat :c00) (loc ""))
@ -61,7 +67,7 @@
(defun send-connect (env &rest args &key (domain :csys) addr to target op)
(let ((head (list domain :connect)))
(actor:send env (message:create head args))))
(actor:send env (message:create head :data args))))
;;;; internal helpers

2
csys/program.lisp
View file

@ -60,7 +60,7 @@
(defun b1-next-one-basic ()
(lambda (msg scope)
(let ((self actor:*self*)
(env (env scope)))
(env (csys:environ scope)))
(environ:send-connect env :to self :target '(:csys :e00 "1-0")
:op (csys:multiply -1))
(environ:send-connect env :to self :target '(:csys :e00 "1-1"))

10
test/test-csys.lisp
View file

@ -31,6 +31,7 @@
(defun setup-config ()
(config:add :test-receiver :setup #'tc:setup)
(config:add-action '(:csys :effect :e01) (value-in '(1 2)))
(config:add-action '(:csys :effect :e00) (value-in '(1 2)))
;(config:add-action '(:csys :effect) #'tc:check-message)
(config:add-action '(:csys) (constantly nil)))
@ -48,6 +49,7 @@
(async:init)
(unwind-protect
(test-basic-0)
(test-basic-1)
(sleep 0.1)
(tc:check-expected)
(t:show-result))))
@ -72,3 +74,11 @@
(environ:send-value env 2 :cat :s01 :loc "0-1")
(sleep 0.1)
(core:shutdown)))
(deftest test-basic-1 ()
(let ((env (setup-test (program:basic-1) :zero-cat :s00)))
(sleep 0.1)
(environ:send-value env 1 :cat :s00 :loc "0-1")
;(environ:send-value env 2 :cat :s00 :loc "0-1")
(sleep 0.1)
(core:shutdown)))