From 20ed5134e51f36e24760f7f6aa3bf87a5ca7dc55 Mon Sep 17 00:00:00 2001
From: Helmut Merz <helmutm@cy55.de>
Date: Sat, 18 Jul 2026 16:46:46 +0200
Subject: [PATCH] csys, work in progress: environ:actions

---
 csys/csys.lisp      | 23 ++++++++++++-----------
 csys/environ.lisp   | 10 +++++++---
 test/test-csys.lisp |  4 ++--
 3 files changed, 21 insertions(+), 16 deletions(-)

diff --git a/csys/csys.lisp b/csys/csys.lisp
index 6a3adf5..6637a4e 100644
--- a/csys/csys.lisp
+++ b/csys/csys.lisp
@@ -9,9 +9,10 @@
                     (:util :scopes/util)
                     (:alx :alexandria))
   (:export #:scope #:environ
-           #:neuron #:synapse #:std-proc #:update #:create
            #:make-prog
-           #:handle-action))
+           #:neuron #:std-proc #:create
+           #:handle-action
+           #:notify))
 
 (in-package :scopes/csys)
 
@@ -19,12 +20,12 @@
 
 (defclass scope ()
   ((value :accessor value :initarg :value :initform 0)
-   (params :accessor params :initarg :params :initform nil)     ; <- program
+   ;(params :accessor params :initarg :params :initform nil)     ; <- program
    (categ :accessor categ :initarg :categ :initform '(:csys :c00))
    (stage :accessor stage :initform :initial)
    (proc :accessor proc :initarg :proc :initform #'std-proc)
    (program :reader program :initarg :program :initform nil)
-   (actions :accessor actions :initarg :actions :initform nil)  ; <- program
+   ;(actions :accessor actions :initarg :actions :initform nil)  ; <- program
    (syns :accessor syns :initform nil)
    (environ :reader environ :initarg :environ)))
 
@@ -43,8 +44,8 @@
   (setf (proc scope) (funcall (program scope) scope))
   scope)
 
-(defun make-prog (fn)
-  (lambda (scope) fn))
+(defgeneric make-prog (spec)
+  (:method ((fn function)) (lambda (scope) fn)))
 
 ;;;; neurons (= async tasks) and synapses (= connections)
 
@@ -66,7 +67,7 @@
 (defun std-proc (msg scope)
   ;(util:lgi msg state syns env)
   (destructuring-bind (nmsg nscope) 
-        (handle-action msg scope :default #'remember)
+        (handle-action msg scope :default #'remember) ; + params, actions
     (forward nmsg (syns nscope))
     (update nscope)))
 
@@ -84,11 +85,11 @@
   (dolist (s syns) 
     (funcall s msg)))
 
-(defun handle-action (msg scope &key (default #'no-op))
+(defun handle-action (msg scope &key (default #'no-op) actions params)
   (let* ((key (message:action msg))
-         ;(act (select-action msg state default))
-         (act (gethash key (actions scope) default)))
-    (funcall act msg scope)))
+         ;(act (gethash key (actions scope) default))
+         (act (getf actions key default)))
+    (apply act msg scope params)))
 
 (defun notify-created (msg new scope)
   (let* ((head (list (message:domain msg) :created))
diff --git a/csys/environ.lisp b/csys/environ.lisp
index 94bdbde..3d34d72 100644
--- a/csys/environ.lisp
+++ b/csys/environ.lisp
@@ -6,16 +6,20 @@
                     (:csys :scopes/csys)
                     (:message :scopes/core/message)
                     )
-  (:export #:forward)
-  )
+  (:export #:actions
+           #:forward))
 
 (in-package :scopes/csys/environ)
 
 (defclass scope (csys:scope)
-  ((cells :reader cells :initarg :cells :initform (make-hash-table :test #'equal))))
+  ((cells :reader cells :initform (make-hash-table :test #'equal))))
 
 ;;;; action handlers, public callables
 
+(defun actions () 
+  '(:created #'cell-created
+    :default #'csys:notify))
+
 (defun cell-created (msg scope))
 
 (defun forward-message (head scope &key data customer)
diff --git a/test/test-csys.lisp b/test/test-csys.lisp
index edc4f7f..90bc097 100644
--- a/test/test-csys.lisp
+++ b/test/test-csys.lisp
@@ -35,8 +35,8 @@
   )
 
 (defun proc-env (msg scope)
-  (let ((t:*test-suite* (csys:environ scope))) 
-    (destructuring-bind (nmsg scope) (csys:handle-action msg scope)
+  (let ((t:*test-suite* (csys:environ scope))) (destructuring-bind (nmsg scope) 
+        (csys:handle-action msg scope :actions (environ:actions))
       (util:lgi nmsg)
       (actor:send (core:mailbox (tc:receiver t:*test-suite*)) nmsg))))