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

csys: provide add-action and add-sensors methods

Browse source
This commit is contained in:
Helmut Merz 2026-04-05 07:25:44 +02:00
parent a4eda71b8d
commit 8bf7e8ae0c
2 changed files with 25 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

25
csys/csys.lisp
View file

@ -8,7 +8,7 @@
(:shape :scopes/shape) (:shape :scopes/shape)
(:util :scopes/util) (:util :scopes/util)
(:alx :alexandria)) (:alx :alexandria))
(:export #:environment #:*environment* #:actions #:procs #:sensors (:export #:environment #:*environment* #:add-action #:add-sensors
#:send #:send-message #:send #:send-message
#:neuron #:synapse #:std-proc #:neuron #:synapse #:std-proc
#:make-neuron #:update-neuron #:create-sensor #:make-neuron #:update-neuron #:create-sensor
@ -19,13 +19,23 @@
;;;; environment: common information, with list of globally available actions ;;;; environment: common information, with list of globally available actions
(defclass environment () (defclass environment ()
((actions :reader actions :initarg :actions :initform (make-hash-table)) ((actions :reader actions :initarg :actions
:initform (make-hash-table :test #'equal))
(sensors :reader sensors :initarg :sensors (sensors :reader sensors :initarg :sensors
:initform (make-hash-table :test #'equal)) :initform (make-hash-table :test #'equal))
(procs :reader procs :initarg :procs (procs :reader procs :initarg :procs
:initform (make-hash-table :test #'equal)))) :initform (make-hash-table :test #'equal))))
(defvar *environment* (make-instance 'environment)) ;(defvar *environment* (make-instance 'environment))
(defvar *environment* nil)
(defun add-action (key fn &optional (env *environment*))
;(util:lgi key fn env)
(setf (gethash key (actions env)) fn))
(defun add-sensors (key sns &optional (env *environment*))
;(util:lgi key sns env)
(setf (gethash key (sensors env)) sns))
;;;; neurons (= behavior factories) and synapses (connection factories) ;;;; neurons (= behavior factories) and synapses (connection factories)
@ -47,7 +57,7 @@
(actor:become (neuron proc state syns env))) (actor:become (neuron proc state syns env)))
(defun std-proc (msg state syns env) (defun std-proc (msg state syns env)
;(util:lgi msg state) ;(util:lgi msg state syns env)
(destructuring-bind (nmsg nst nsyns) (destructuring-bind (nmsg nst nsyns)
(handle-action msg state syns env :default #'remember) (handle-action msg state syns env :default #'remember)
(forward nmsg nsyns) (forward nmsg nsyns)
@ -73,7 +83,7 @@
(defun find-sensors (msg) (defun find-sensors (msg)
(let* ((key (cddr (shape:head msg))) (let* ((key (cddr (shape:head msg)))
(sns (gethash key (sensors *environment*)))) (sns (gethash key (sensors *environment*))))
;(util:lgi key sns) ;(util:lgi key sns *environment*)
sns)) sns))
;;;; effector procs for pseudo-neurons embedded in environment ;;;; effector procs for pseudo-neurons embedded in environment
@ -103,9 +113,10 @@
(defun create-sensor (msg state syns env) (defun create-sensor (msg state syns env)
(let* ((key (shape:data msg)) (let* ((key (shape:data msg))
(sensor (make-neuron actor:*self* :state key)) (sensor (make-neuron actor:*self* :state key :env env))
(nmsg (message:create (list :csys :created (car key) (cadr key))))) (nmsg (message:create (list :csys :created (car key) (cadr key)))))
(setf (gethash key (sensors env)) (list sensor)) ;(setf (gethash key (sensors env)) (list sensor))
(add-sensors key (list sensor) env)
(list nmsg state syns))) (list nmsg state syns)))
(defun add (msg state syns env) (defun add (msg state syns env)

17
test/test-csys.lisp
View file

@ -54,18 +54,17 @@
;;;; test: initialization ;;;; test: initialization
(defun init () (defun setup-test-init ()
(setf (gethash :sensor (csys:actions csys:*environment*)) #'csys:create-sensor)
(let ((zero (csys:make-neuron nil :proc #'eff-proc)))
(setf (gethash '(:init :zero) (csys:sensors csys:*environment*)) (list zero))))
(deftest test-init ()
(let ((csys:*environment* (make-instance 'test-env :test-suite t:*test-suite*)))
;(setup-xxx)
(setup-config) (setup-config)
(core:setup-services) (core:setup-services)
(setf (tc:receiver t:*test-suite*) (core:find-service :test-receiver)) (setf (tc:receiver t:*test-suite*) (core:find-service :test-receiver))
(init) ; end of setup (csys:add-action :sensor #'csys:create-sensor)
(let ((zero (csys:make-neuron nil :proc #'eff-proc)))
(csys:add-sensors '(:init :zero) (list zero))))
(deftest test-init ()
(let ((csys:*environment* (make-instance 'test-env :test-suite t:*test-suite*)))
(setup-test-init)
(csys:send-message '(:csys :sensor :init :zero) '(:std :s1)) (csys:send-message '(:csys :sensor :init :zero) '(:std :s1))
(csys:send-message '(:csys :sensor :init :zero) '(:std :s2)) (csys:send-message '(:csys :sensor :init :zero) '(:std :s2))
(sleep 0.1) (sleep 0.1)