From 3782305853f824c395bbf95f4564cfd2ef18ee20 Mon Sep 17 00:00:00 2001 From: Helmut Merz Date: Sun, 8 Mar 2026 14:52:33 +0100 Subject: [PATCH] csys: env: + proc register; provide special neuron processor for effectors --- csys/csys.lisp | 33 +++++++++++++++++++-------------- test/test-csys.lisp | 25 +++++++++++-------------- 2 files changed, 30 insertions(+), 28 deletions(-) diff --git a/csys/csys.lisp b/csys/csys.lisp index fe0720c..4effd75 100644 --- a/csys/csys.lisp +++ b/csys/csys.lisp @@ -10,12 +10,12 @@ (:shape :scopes/shape) (:util :scopes/util) (:alx :alexandria)) - (:export #:environment #:*environment* #:effectors + (:export #:environment #:*environment* #:procs #:init #:send #:send-message #:neuron #:synapse #:make-neuron #:update-neuron - #:handle-action)) + #:make-eff-proc #:handle-action)) (in-package :scopes/csys) @@ -25,15 +25,17 @@ ((actions :reader actions :initarg :actions :initform (make-hash-table)) (sensors :reader sensors :initarg :sensors :initform (make-hash-table :test #'equal)) - (effectors :reader effectors :initarg :effectors - :initform (make-hash-table :test #'equal)))) + (procs :reader procs :initarg :procs + :initform (make-hash-table :test #'equal)))) (defvar *environment* (make-instance 'environment)) -(defun init (zero) +(defun init () (setf (gethash :sensor (actions *environment*)) #'create-sensor) - (setf (gethash '(:init :zero) (sensors *environment*)) (list zero)) - (setf (gethash :default (effectors *environment*)) (list zero))) + (setf (gethash :default (procs *environment*)) #'std-proc) + (let* ((eff-proc (gethash '(:effect :default) (procs *environment*) #'std-proc)) + (zero (make-neuron nil :proc eff-proc))) + (setf (gethash '(:init :zero) (sensors *environment*)) (list zero)))) ;;;; sensors: neurons receiving messages from environment, addressable via message head @@ -57,10 +59,6 @@ (defun do-log (msg state syns env) (util:lgi msg)) -(defun find-effectors (key &optional (default-key :default) (env *environment*)) - (let ((effs (effectors env))) - (gethash key effs (gethash default-key effs)))) - ;;;; neurons (= behavior factories) and synapses (connection factories) (defun neuron (proc &optional state syns (env *environment*)) @@ -71,9 +69,10 @@ (lambda (msg) (actor:send rcvr (funcall op msg)))) -(defun make-neuron (syn-target &key (proc #'std-proc) state - (syn-op #'identity) (env *environment*)) - (let ((syns (if syn-target (list (synapse syn-target syn-op)) nil))) +(defun make-neuron (syn-target &key proc state + (syn-op #'identity) (env *environment*)) + (let ((proc (or proc (gethash :default (procs env) #'std-proc))) + (syns (if syn-target (list (synapse syn-target syn-op)) nil))) (actor:create (neuron proc state syns env)))) (defun update-neuron (proc state syns &optional (env *environment*)) @@ -88,6 +87,12 @@ (forward nmsg nsyns) (update-neuron #'std-proc nst nsyns env))) +(defun make-eff-proc (handler) + (lambda (msg state syns env) + ;(util:lgi msg) + (funcall handler msg) + (handle-action msg state syns env :default #'remember))) + (defun forward (msg syns) (dolist (s syns) (funcall s msg))) diff --git a/test/test-csys.lisp b/test/test-csys.lisp index 2fcb408..8632b0a 100644 --- a/test/test-csys.lisp +++ b/test/test-csys.lisp @@ -23,15 +23,13 @@ (defclass test-env (csys:environment) ((test-suite :reader test-suite :initarg :test-suite))) -(defun probe (msg state syns env) - (let ((t:*test-suite* (test-suite env)) - (val (shape:data msg))) +(defun eff-handler (state &optional (env csys:*environment*)) + (lambda (msg) (util:lgi msg state) - (destructuring-bind (msg state syns) - (csys:handle-action msg state syns env) + (let ((t:*test-suite* (test-suite env)) + (val (shape:data msg))) (unless (consp val) - (let ((nst (in-seq val state :remove t))) - (csys:update-neuron #'probe nst syns env)))))) + (setf state (in-seq val state :remove t)))))) (defun add (msg state syns env) (list msg (+ (shape:data msg) state) syns env)) @@ -41,21 +39,20 @@ (defun run () (async:init) (let* ((t:*test-suite* (make-instance 't:test-suite :name "csys")) - (csys:*environment* (make-instance 'test-env :test-suite t:*test-suite*)) - (probe (csys:make-neuron nil :proc #'probe :state '(1 3 4 5) - :env csys:*environment*))) + (csys:*environment* (make-instance 'test-env :test-suite t:*test-suite*))) (load (t:test-path "config-csys" "etc")) (core:setup-services) (unwind-protect (progn - (test-init probe)) + (test-init)) (sleep 0.1) (async:finish) (t:show-result)))) -(deftest test-init (probe) - ;(setf (gethash '(:std :d0) (csys:effectors csys:*environment*)) probe) - (csys:init probe) +(deftest test-init () + (setf (gethash '(:effect :default) (csys:procs csys:*environment*)) + (csys:make-eff-proc (eff-handler '(1 3 4 5)))) + (csys:init) (csys:send-message '(:csys :sensor :init :zero) '(:std :s1)) (csys:send-message '(:csys :sensor :init :zero) '(:std :s2)) (sleep 0.1)