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

csys:value-add as first real action handler (with parameters)

Browse source
This commit is contained in:
Helmut Merz 2026-07-25 07:51:13 +02:00
parent 42195f0cef
commit c31421cee9
2 changed files with 43 additions and 18 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

53
csys/csys.lisp
View file

@ -12,8 +12,8 @@
#:make-program #:make-program
#:neuron #:std-proc #:eff-proc #:create-zero #:neuron #:std-proc #:eff-proc #:create-zero
#:handle-action #:handle-action
#:no-op #:notify
#:notify)) #:no-op #:value-add))
(in-package :scopes/csys) (in-package :scopes/csys)
@ -74,23 +74,25 @@
(defun process (scope) (defun process (scope)
(lambda (msg) (funcall (proc scope) msg scope))) (lambda (msg) (funcall (proc scope) msg scope)))
(defun std-proc (msg scope &key (default (remember)) actions params) (defun std-proc (&key (default (remember)) actions)
(util:mv-bind (nmsg (nscope scope)) (lambda (msg scope)
(handle-action msg scope :default default :actions actions :params params) (util:mv-bind (nmsg (nscope scope))
(when nmsg (forward nmsg (syns nscope))) (handle-action msg scope :default default :actions actions)
(update nscope))) (when nmsg (forward nmsg (syns nscope)))
(update nscope))))
(defun eff-proc (msg scope &key params actions) (defun eff-proc (&key actions)
(util:mv-bind (nmsg (nscope scope)) (lambda (msg scope)
(handle-action msg scope :default (no-op) :actions actions :params params) (util:mv-bind (nmsg (nscope scope))
(setf (nth 1 (shape:head nmsg)) :effect) (handle-action msg scope :default (no-op) :actions actions)
(when nmsg (notify nmsg nscope)) (setf (nth 1 (shape:head nmsg)) :effect)
(update nscope))) (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)) (let* ((key (message:action msg))
(act (getf actions key (getf actions :default default)))) (act (getf actions key (getf actions :default default))))
(apply act msg scope params))) (funcall act msg scope)))
(defun forward (msg syns) (defun forward (msg syns)
(dolist (s syns) (dolist (s syns)
@ -115,8 +117,27 @@
(lambda (msg scope) (lambda (msg scope)
(setf (value scope) (shape:data-value msg :value)) (setf (value scope) (shape:data-value msg :value))
(values msg scope))) (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 () (defun create ()
(lambda (msg scope) (lambda (msg scope)
(let ((new (neuron (apply #'reset-scope scope (shape:data msg))))) (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))))

8
test/test-csys.lisp
View file

@ -41,6 +41,9 @@
(when nmsg (when nmsg
(actor:send (core:mailbox (tc:receiver t:*test-suite*)) nmsg))))) (actor:send (core:mailbox (tc:receiver t:*test-suite*)) nmsg)))))
(defun actions ()
(list :value (csys:value-add)))
(defun run () (defun run ()
(let ((t:*test-suite* (make-instance 'tc:test-suite :name "csys"))) (let ((t:*test-suite* (make-instance 'tc:test-suite :name "csys")))
(load (t:test-path "config-csys" "etc")) (load (t:test-path "config-csys" "etc"))
@ -63,11 +66,12 @@
env)) env))
(deftest test-basic-0 () (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)) ;(env (setup-test (test-program))
(rcvr (tc:receiver t:*test-suite*))) (rcvr (tc:receiver t:*test-suite*)))
(sleep 0.1) (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))) (actor:send env (message:create '(:csys :value :c00 "0-0") :data '(:value 1)))
(sleep 0.1) (sleep 0.1)
(core:shutdown))) (core:shutdown)))