From 8d153001fd9ee37e313b65d92284ec046039b07a Mon Sep 17 00:00:00 2001
From: Helmut Merz <helmutm@cy55.de>
Date: Thu, 6 Aug 2026 16:41:41 +0200
Subject: [PATCH] csys/environ: creation of eff contact cells upon env creation

---
 csys/environ.lisp   | 28 ++++++++++++++++++++++++----
 csys/program.lisp   |  6 +++++-
 test/test-csys.lisp | 17 +++++++++--------
 3 files changed, 38 insertions(+), 13 deletions(-)

diff --git a/csys/environ.lisp b/csys/environ.lisp
index c36197f..b06c41e 100644
--- a/csys/environ.lisp
+++ b/csys/environ.lisp
@@ -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 () 
diff --git a/csys/program.lisp b/csys/program.lisp
index 63f472f..4fcfd0c 100644
--- a/csys/program.lisp
+++ b/csys/program.lisp
@@ -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))
diff --git a/test/test-csys.lisp b/test/test-csys.lisp
index 1350720..cdc5189 100644
--- a/test/test-csys.lisp
+++ b/test/test-csys.lisp
@@ -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*)))
-    (setf (tc:receiver t:*test-suite*) rcvr)
-    (csys:create-zero prg env :categ (list :csys zero-cat))
-    env))
+  (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)))
 
 ;;;; 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")