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

simplify environ:send-value calls

Browse source
This commit is contained in:
Helmut Merz 2026-08-08 16:26:34 +02:00
parent 4d37117339
commit e53f09e3d6
3 changed files with 14 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
csys/csys.lisp
View file

@ -117,7 +117,7 @@
(when nmsg (when nmsg
(setf (nth 1 (shape:head nmsg)) :effect) (setf (nth 1 (shape:head nmsg)) :effect)
(forward nmsg (syns nscope)) (forward nmsg (syns nscope))
(notify nmsg nscope)) (unless (syns nscope) (notify nmsg nscope)))
(update nscope))))) (update nscope)))))
(defun handle-action (msg scope &key (default (no-op)) actions) (defun handle-action (msg scope &key (default (no-op)) actions)

11
csys/environ.lisp
View file

@ -8,12 +8,15 @@
(:message :scopes/core/message) (:message :scopes/core/message)
(:shape :scopes/shape) (:shape :scopes/shape)
(:util :scopes/util)) (:util :scopes/util))
(:export #:create #:simple-proc (:export #:*env*
#:create #:simple-proc
#:actions #:actions
#:send-value #:send-connect)) #:send-value #:send-connect))
(in-package :scopes/csys/environ) (in-package :scopes/csys/environ)
(defvar *env* nil)
(defclass scope (csys:scope) (defclass scope (csys:scope)
((cells :reader cells :initform (make-hash-table :test #'equal)))) ((cells :reader cells :initform (make-hash-table :test #'equal))))
@ -92,9 +95,9 @@
;;;; public shortcuts ;;;; public shortcuts
(defun send-value (env val &key (domain :csys) (cat :c00) (loc "")) (defun send-value (cat-loc val &key (domain :csys) (env *env*))
(let ((head (list domain :value cat loc))) (let ((head (cons domain (cons :value cat-loc))))
(actor:send env (message:create head :data `(:value ,val))))) (actor:send env (message:create head :data `(:value ,val)))))
(defun send-connect (env &rest args &key (domain :csys) addr to target op) (defun send-connect (env &rest args &key (domain :csys) addr to target op)
(let ((head (list domain :connect))) (let ((head (list domain :connect)))

12
test/test-csys.lisp
View file

@ -67,19 +67,19 @@
;;;; test definitions ;;;; test definitions
(deftest test-basic-0 () (deftest test-basic-0 ()
(let ((env (setup-test (list (program:basic-0))))) (let ((environ:*env* (setup-test (list (program:basic-0)))))
;(rcvr (tc:receiver t:*test-suite*)) ;(rcvr (tc:receiver t:*test-suite*))
(sleep 0.1) (sleep 0.1)
;(tc:expect rcvr (message:create '(:csys :effect :e01) :data '(:value 1))) ;(tc:expect rcvr (message:create '(:csys :effect :e01) :data '(:value 1)))
(environ:send-value env 1 :cat :s01 :loc "0-1") (environ:send-value '(:s01 "0-1") 1)
(environ:send-value env 2 :cat :s01 :loc "0-1") (environ:send-value '(:s01 "0-1") 2)
(sleep 0.1) (sleep 0.1)
(core:shutdown))) (core:shutdown)))
(deftest test-basic-1 () (deftest test-basic-1 ()
(let ((env (setup-test (program:config-basic-1)))) (let ((environ:*env* (setup-test (program:config-basic-1))))
(sleep 0.1) (sleep 0.1)
(environ:send-value env 1 :cat :s00 :loc "0-0") (environ:send-value '(:s00 "0-0") 1)
(environ:send-value env 2 :cat :s00 :loc "0-1") (environ:send-value '(:s00 "0-1") 2)
(sleep 0.1) (sleep 0.1)
(core:shutdown))) (core:shutdown)))