From c31421cee97c676f6cc7e8568bd7b6ed35433425 Mon Sep 17 00:00:00 2001 From: Helmut Merz Date: Sat, 25 Jul 2026 07:51:13 +0200 Subject: [PATCH] csys:value-add as first real action handler (with parameters) --- csys/csys.lisp | 53 +++++++++++++++++++++++++++++++-------------- test/test-csys.lisp | 8 +++++-- 2 files changed, 43 insertions(+), 18 deletions(-) diff --git a/csys/csys.lisp b/csys/csys.lisp index f462959..f9bf14c 100644 --- a/csys/csys.lisp +++ b/csys/csys.lisp @@ -12,8 +12,8 @@ #:make-program #:neuron #:std-proc #:eff-proc #:create-zero #:handle-action - #:no-op - #:notify)) + #:notify + #:no-op #:value-add)) (in-package :scopes/csys) @@ -74,23 +74,25 @@ (defun process (scope) (lambda (msg) (funcall (proc scope) msg scope))) -(defun std-proc (msg scope &key (default (remember)) actions params) - (util:mv-bind (nmsg (nscope scope)) - (handle-action msg scope :default default :actions actions :params params) - (when nmsg (forward nmsg (syns nscope))) - (update nscope))) +(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 eff-proc (msg scope &key params actions) - (util:mv-bind (nmsg (nscope scope)) - (handle-action msg scope :default (no-op) :actions actions :params params) - (setf (nth 1 (shape:head nmsg)) :effect) - (when nmsg (notify nmsg 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) + (setf (nth 1 (shape:head nmsg)) :effect) + (when nmsg (notify nmsg nscope)) + (update nscope)))) -(defun handle-action (msg scope &key (default (no-op)) actions params) +(defun handle-action (msg scope &key (default (no-op)) actions) (let* ((key (message:action msg)) (act (getf actions key (getf actions :default default)))) - (apply act msg scope params))) + (funcall act msg scope))) (defun forward (msg syns) (dolist (s syns) @@ -115,8 +117,27 @@ (lambda (msg scope) (setf (value scope) (shape:data-value msg :value)) (values msg scope))) + +(defun value-add (&key (bias 0) (threshold 0)) + (lambda (msg scope) + (let* ((val (getf (shape:data msg) :value)) + (newval (+ val (value scope)))) + (if (>= newval threshold) + (let* ((head (new-msg-head msg scope)) + (msg (message:create head :data (list :value newval)))) + (setf (value scope) bias) + (values msg scope)) + (progn + (setf (value scope) newval) + (values nil scope)))))) (defun create () (lambda (msg scope) (let ((new (neuron (apply #'reset-scope scope (shape:data msg))))) - (notify-created msg new scope)))) + (notify-created msg new scope) + nil))) + +;;;; helpers + +(defun new-msg-head (msg scope) + (list (message:domain msg) (message:action msg) (cadr (categ scope)))) diff --git a/test/test-csys.lisp b/test/test-csys.lisp index 02d42b0..e920b33 100644 --- a/test/test-csys.lisp +++ b/test/test-csys.lisp @@ -41,6 +41,9 @@ (when nmsg (actor:send (core:mailbox (tc:receiver t:*test-suite*)) nmsg))))) +(defun actions () + (list :value (csys:value-add))) + (defun run () (let ((t:*test-suite* (make-instance 'tc:test-suite :name "csys"))) (load (t:test-path "config-csys" "etc")) @@ -63,11 +66,12 @@ env)) (deftest test-basic-0 () - (let ((env (setup-test (csys:make-program #'csys:eff-proc))) + (let ((env (setup-test (csys:make-program (csys:eff-proc :actions (actions))))) + ;(env (setup-test (csys:make-program (csys:eff-proc)))) ;(env (setup-test (test-program)) (rcvr (tc:receiver t:*test-suite*))) (sleep 0.1) - (tc:expect rcvr (message:create '(:csys :effect :c00 "0-0") :data '(:value 1))) + (tc:expect rcvr (message:create '(:csys :effect :c00) :data '(:value 1))) (actor:send env (message:create '(:csys :value :c00 "0-0") :data '(:value 1))) (sleep 0.1) (core:shutdown)))