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

csys/environ: creation of eff contact cells upon env creation

Browse source
This commit is contained in:
Helmut Merz 2026-08-06 16:41:41 +02:00
parent a0e0774a77
commit 8d153001fd
3 changed files with 38 additions and 13 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

28
csys/environ.lisp
View file

@ -17,10 +17,13 @@
(defclass scope (csys:scope)
((cells :reader cells :initform (make-hash-table :test #'equal))))
(defun create (proc &optional (meta-env (csys:printer)))
;; + create contact cells (<- &key contact-cells)
(let ((prg (csys:make-program proc)))
(csys:neuron (csys:scope prg meta-env :cls 'scope :categ '(:env :c00)))))
(defun create (proc meta-env &key eff-contacts) ; (csys:printer)
;; + create contact cells (<- &key eff-contacts)
(let* ((prg (csys:make-program proc))
(scope (csys:scope prg meta-env :cls 'scope :categ '(:env :c00)))
(env (csys:neuron scope)))
(create-contact-cells eff-contacts env (cells scope))
env))
(defun simple-proc (msg scope)
(util:mv-bind (nmsg (scope scope))
@ -29,6 +32,23 @@
(when nmsg
(actor:send (env scope) nmsg))))
;;;; eff contact cells
(defclass contact-scope (csys:scope)
((loc :reader loc :initarg :loc)))
(defun create-contact-cells (eff-contacts env cells)
(util:loop-plist eff-contacts cat loc do
(let ((ct (csys:neuron
(csys:scope (csys:make-program #'proc-contact) env
:cls 'contact-scope
:categ (list :env cat) :loc loc))))
(register-cell cells (list :env cat loc) ct))))
(defun proc-contact (msg scope)
(setf (nth 3 (shape:head msg)) (loc scope))
(actor:send (env scope) msg))
;;;; action handlers
(defun actions ()

6
csys/program.lisp
View file

@ -6,7 +6,7 @@
(:csys :scopes/csys)
(:environ :scopes/csys/environ)
(:util :scopes/util))
(:export #:basic-0 #:basic-1))
(:export #:basic-0 #:config-basic-1))
(in-package :scopes/csys/program)
@ -29,6 +29,10 @@
;;;; basic-1: minimal cross-linked system
(defun config-basic-1 ()
(list (basic-1) :zero-cat :s00
:eff-contacts '(:e00 ("1-0" "1-1"))))
(defun basic-1 ()
(csys:make-program
(list '(:s00 :initial) (csys:std-proc :next (b1-next-zero))

13
test/test-csys.lisp
View file

@ -54,19 +54,20 @@
(tc:check-expected)
(t:show-result))))
(defun setup-test (prg &key (zero-cat :c00))
(defun setup-test (cfg)
(setup-config)
(core:setup-services)
(let* ((rcvr (core:find-service :test-receiver))
(env (environ:create #'proc-env t:*test-suite*)))
(destructuring-bind (prg &key (zero-cat :c00) eff-contacts) cfg
(let ((rcvr (core:find-service :test-receiver))
(env (environ:create #'proc-env t:*test-suite* :eff-contacts eff-contacts)))
(setf (tc:receiver t:*test-suite*) rcvr)
(csys:create-zero prg env :categ (list :csys zero-cat))
env))
env)))
;;;; test definitions
(deftest test-basic-0 ()
(let ((env (setup-test (program:basic-0))))
(let ((env (setup-test (list (program:basic-0)))))
;(rcvr (tc:receiver t:*test-suite*))
(sleep 0.1)
;(tc:expect rcvr (message:create '(:csys :effect :e01) :data '(:value 1)))
@ -76,7 +77,7 @@
(core:shutdown)))
(deftest test-basic-1 ()
(let ((env (setup-test (program:basic-1) :zero-cat :s00)))
(let ((env (setup-test (program:config-basic-1))))
(sleep 0.1)
(environ:send-value env 1 :cat :s00 :loc "0-0")
(environ:send-value env 2 :cat :s00 :loc "0-1")