csys action handlers: always defined as closures; + some minor clean-ups and rearrangements

This commit is contained in:
Helmut Merz 2026-07-24 19:54:35 +02:00
parent 6facc4f22e
commit 42195f0cef
3 changed files with 27 additions and 28 deletions

View file

@ -53,8 +53,9 @@
(let* ((domain (car categ))
(addr (list domain (cadr categ) name))
(msg (message:create (list domain :create) :data (list :addr addr)))
(scope (scope prg env :categ categ)))
(create msg scope)))
(scope (scope prg env :categ categ))
(zero (neuron scope)))
(notify-created msg zero scope)))
;;;; neurons (= async tasks) and synapses (= connections)
@ -73,7 +74,7 @@
(defun process (scope)
(lambda (msg) (funcall (proc scope) msg scope)))
(defun std-proc (msg scope &key (default #'remember) params actions)
(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)))
@ -86,24 +87,17 @@
(when nmsg (notify nmsg nscope))
(update nscope)))
(defun create (msg scope)
(let ((new (neuron (apply #'reset-scope scope (shape:data msg)))))
(notify-created msg new scope)))
(defun do-log (msg scope)
(util:lgi msg))
(defun notify (msg scope)
(actor:send (environ scope) msg))
(defun handle-action (msg scope &key (default (no-op)) actions params)
(let* ((key (message:action msg))
(act (getf actions key (getf actions :default default))))
(apply act msg scope params)))
(defun forward (msg syns)
(dolist (s syns)
(funcall s msg)))
(defun handle-action (msg scope &key (default (no-op)) actions params)
(let* ((key (message:action msg))
(act (getf actions key (getf actions :default default))))
(apply act msg scope params)))
(defun notify (msg scope)
(actor:send (environ scope) msg))
(defun notify-created (msg new scope)
(let* ((head (list (message:domain msg) :created))
@ -111,12 +105,18 @@
(msg1 (message:create head :data data)))
(notify msg1 scope)))
;;;; predefined neuron actions
;;;; action handlers
(defun no-op (&key stop)
(defun no-op (&key no-forward)
(lambda (msg scope)
(unless stop msg)))
(unless no-forward msg)))
(defun remember (msg scope)
(defun remember ()
(lambda (msg scope)
(setf (value scope) (shape:data-value msg :value))
(values msg scope))
(values msg scope)))
(defun create ()
(lambda (msg scope)
(let ((new (neuron (apply #'reset-scope scope (shape:data msg)))))
(notify-created msg new scope))))

View file

@ -21,14 +21,14 @@
(let ((prg (csys:make-program proc)))
(csys:neuron (csys:scope prg meta-env :cls 'scope :categ '(:env :c00)))))
;;;; action handlers, public callables
;;;; action handlers
(defun actions ()
(list :created #'cell-created
:notify (csys:no-op)
:effect (csys:no-op)
:value #'forward
:default (csys:no-op :stop t)))
:default (csys:no-op :no-forward t)))
(defun cell-created (msg scope)
(let* ((data (shape:data msg))

View file

@ -31,8 +31,7 @@
(config:add :test-receiver :setup #'tc:setup)
;(config:add-action '(:csys :effect :c00 "0-0") (value-in '(1)))
(config:add-action '(:csys :effect) #'tc:check-message)
(config:add-action '(:csys) (constantly nil))
)
(config:add-action '(:csys) (constantly nil)))
(defun proc-env (msg scope)
(let ((t:*test-suite* (csys:environ scope)))
@ -60,12 +59,12 @@
(let* ((recv (core:find-service :test-receiver))
(env (environ:create #'proc-env t:*test-suite*)))
(setf (tc:receiver t:*test-suite*) recv)
;(csys:create-zero (test-program) env)
(csys:create-zero prg env)
env))
(deftest test-basic-0 ()
(let ((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)))