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

csys: add-sensor; action id = domain + action; sensor id = domain + class + item

Browse source
This commit is contained in:
Helmut Merz 2026-04-06 14:07:44 +02:00
parent 133e6ebed9
commit 90fad03268
2 changed files with 13 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

20
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* #:add-action #:add-sensors (:export #:environment #:*environment* #:add-action #:add-sensor
#: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
@ -22,7 +22,7 @@
((actions :reader actions :initarg :actions ((actions :reader actions :initarg :actions
:initform (make-hash-table :test #'equal)) :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 :synchronized t))
(procs :reader procs :initarg :procs (procs :reader procs :initarg :procs
:initform (make-hash-table :test #'equal)))) :initform (make-hash-table :test #'equal))))
@ -33,9 +33,9 @@
;(util:lgi key fn *environment*) ;(util:lgi key fn *environment*)
(setf (gethash key (actions *environment*)) fn)) (setf (gethash key (actions *environment*)) fn))
(defun add-sensors (key sns) (defun add-sensor (key sn)
;(util:lgi key sns *environment*) (let ((sns (sensors *environment*)))
(setf (gethash key (sensors *environment*)) sns)) (setf (gethash key sns) (adjoin sn (gethash key sns)))))
;;;; neurons (= behavior factories) and synapses (connection factories) ;;;; neurons (= behavior factories) and synapses (connection factories)
@ -81,7 +81,8 @@
(actor:send sn msg))) (actor:send sn msg)))
(defun find-sensors (msg) (defun find-sensors (msg)
(let* ((key (cddr (shape:head msg))) (let* ((head (shape:head msg))
(key (cons (car head) (cddr head)))
(sns (gethash key (sensors *environment*)))) (sns (gethash key (sensors *environment*))))
;(util:lgi key sns *environment*) ;(util:lgi key sns *environment*)
sns)) sns))
@ -98,7 +99,8 @@
(funcall s msg))) (funcall s msg)))
(defun handle-action (msg state syns &key (default #'no-op)) (defun handle-action (msg state syns &key (default #'no-op))
(let* ((key (shape:head-value msg :action)) (let* ((head (shape:head msg))
(key (list (car head) (cadr head)))
(act (gethash key (actions *environment*) default))) (act (gethash key (actions *environment*) default)))
(funcall act msg state syns))) (funcall act msg state syns)))
@ -112,10 +114,10 @@
(list msg (shape:data msg) syns)) (list msg (shape:data msg) syns))
(defun create-sensor (msg state syns) (defun create-sensor (msg state syns)
(let* ((key (shape:data msg)) (let* ((key (cons (car (shape:head msg)) (shape:data msg)))
(sensor (make-neuron actor:*self* :state key)) (sensor (make-neuron actor:*self* :state key))
(nmsg (message:create (list :csys :created (car key) (cadr key))))) (nmsg (message:create (list :csys :created (car key) (cadr key)))))
(add-sensors key (list sensor)) (add-sensor key sensor)
(list nmsg state syns))) (list nmsg state syns)))
(defun add (msg state syns) (defun add (msg state syns)

4
test/test-csys.lisp
View file

@ -58,9 +58,9 @@
(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))
(csys:add-action :sensor #'csys:create-sensor) (csys:add-action '(:csys :sensor) #'csys:create-sensor)
(let ((zero (csys:make-neuron nil :proc #'eff-proc))) (let ((zero (csys:make-neuron nil :proc #'eff-proc)))
(csys:add-sensors '(:init :zero) (list zero)))) (csys:add-sensor '(:csys :init :zero) zero)))
(deftest test-init () (deftest test-init ()
(let ((csys:*environment* (make-instance 'test-env :test-suite t:*test-suite*))) (let ((csys:*environment* (make-instance 'test-env :test-suite t:*test-suite*)))