From 83f1bab7a8aac11e5e6965bc55f33d48be274140 Mon Sep 17 00:00:00 2001
From: Helmut Merz <helmutm@cy55.de>
Date: Wed, 5 Aug 2026 07:52:41 +0200
Subject: [PATCH] csys: simplify action definitions via *-proc with
 basic-actions as default

---
 csys/csys.lisp      | 38 ++++++++++++++++++++++----------------
 csys/program.lisp   | 32 ++++++++++----------------------
 test/test-csys.lisp |  4 ++--
 3 files changed, 34 insertions(+), 40 deletions(-)

diff --git a/csys/csys.lisp b/csys/csys.lisp
index fb7efd3..bafbbe6 100644
--- a/csys/csys.lisp
+++ b/csys/csys.lisp
@@ -12,7 +12,8 @@
            #:make-program #:create-zero
            #:neuron #:std-proc #:eff-proc
            #:handle-action #:forward #:notify
-           #:basic-actions #:no-op #:value-add #:create #:connect
+           #:basic-actions #:merge-actions
+           #:no-op #:value-add #:create #:connect
            #:multiply
            #:send-create #:send-connect))
 
@@ -98,21 +99,26 @@
 
 ;;;; message handlers, proc steps
 
-(defun std-proc (&key (default (remember)) actions)
-  (lambda (msg scope) 
-    (util:mv-bind (nmsg (nscope scope)) 
-        (handle-action msg scope :default default :actions actions)
-      (when nmsg (forward nmsg (syns nscope)))
-      (update nscope))))
+(defun merge-actions (&optional act+ (base (basic-actions)))
+  (util:plist-merge base act+))
+  
+(defun std-proc (&rest args &key actions &allow-other-keys)
+  (let ((actions (or actions (merge-actions args))))
+    (lambda (msg scope) 
+      (util:mv-bind (nmsg (nscope scope)) 
+          (handle-action msg scope :actions actions)
+        (when nmsg (forward nmsg (syns nscope)))
+        (update nscope)))))
 
-(defun eff-proc (&key actions)
-  (lambda (msg scope) 
-    (util:mv-bind (nmsg (nscope scope)) 
-        (handle-action msg scope :default (no-op) :actions actions)
-      (when nmsg 
-        (setf (nth 1 (shape:head nmsg)) :effect)
-        (notify nmsg nscope))
-      (update nscope))))
+(defun eff-proc (&rest args &key actions &allow-other-keys)
+  (let ((actions (or actions (merge-actions args))))
+    (lambda (msg scope) 
+      (util:mv-bind (nmsg (nscope scope)) 
+          (handle-action msg scope :default (no-op) :actions actions)
+        (when nmsg 
+          (setf (nth 1 (shape:head nmsg)) :effect)
+          (notify nmsg nscope))
+        (update nscope)))))
 
 (defun handle-action (msg scope &key (default (no-op)) actions)
   (let* ((key (message:action msg))
@@ -133,7 +139,7 @@
         :create (create)
         :connect (connect)
         :next (no-op :no-forward t)))
- 
+
 (defun no-op (&key no-forward) 
   (lambda (msg scope) 
     (unless no-forward msg)))
diff --git a/csys/program.lisp b/csys/program.lisp
index 5c4d5d3..cdee4c5 100644
--- a/csys/program.lisp
+++ b/csys/program.lisp
@@ -14,15 +14,11 @@
 
 (defun basic-0 ()
   (csys:make-program
-    (list '(:c00 :initial) (csys:std-proc :actions (b0-actions-zero-initial))
-          '(:e01 :initial) (csys:eff-proc :actions (csys:basic-actions))
-          ':default (csys:std-proc :actions (csys:basic-actions)))))
+    (list '(:c00 :initial) (csys:std-proc :next (b0-next-zero))
+          '(:e01 :initial) (csys:eff-proc)
+          ':default (csys:std-proc))))
 
-(defun b0-actions-zero-initial () 
-  (util:plist-merge (csys:basic-actions) 
-                    (list :next (b0-next-zero-initial))))
-
-(defun b0-next-zero-initial ()
+(defun b0-next-zero ()
   (lambda (msg scope) 
     (let ((self actor:*self*))
       (csys:send-create self :cat :e01 :connect :succ)
@@ -35,16 +31,12 @@
 
 (defun basic-1 ()
   (csys:make-program
-    (list '(:s00 :initial) (csys:std-proc :actions (b1-zero-actions-initial))
-          '(:s00 :basic) (csys:std-proc :actions (b1-one-actions-basic))
-          '(:e00 :default) (csys:eff-proc :actions (csys:basic-actions))
-          ':default (csys:std-proc :actions (csys:basic-actions)))))
+    (list '(:s00 :initial) (csys:std-proc :next (b1-next-zero))
+          '(:s00 :basic) (csys:std-proc :next (b1-next-one))
+          '(:e00 :default) (csys:eff-proc)
+          ':default (csys:std-proc))))
 
-(defun b1-zero-actions-initial ()
-  (util:plist-merge (csys:basic-actions) 
-                    (list :next (b1-next-zero-initial))))
-
-(defun b1-next-zero-initial ()
+(defun b1-next-zero ()
   (lambda (msg scope) 
     (let ((self actor:*self*))
       (csys:send-create self :cat :e00 :loc "1-0" :connect :succ)
@@ -53,11 +45,7 @@
       ;; switch :active
       nil)))
  
-(defun b1-one-actions-basic ()
-  (util:plist-merge (csys:basic-actions) 
-                    (list :next (b1-next-one-basic))))
-
-(defun b1-next-one-basic ()
+(defun b1-next-one ()
   (lambda (msg scope) 
     (let ((self actor:*self*)
           (env (csys:environ scope)))
diff --git a/test/test-csys.lisp b/test/test-csys.lisp
index 101d846..1350720 100644
--- a/test/test-csys.lisp
+++ b/test/test-csys.lisp
@@ -78,7 +78,7 @@
 (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")
+    (environ:send-value env 1 :cat :s00 :loc "0-0")
+    (environ:send-value env 2 :cat :s00 :loc "0-1")
     (sleep 0.1)
     (core:shutdown)))