csys: start with just one :zero neuron that creates two sensors (:s1 and :s2)

This commit is contained in:
Helmut Merz 2026-03-02 17:25:39 +01:00
parent abdd00f1ad
commit 78be34bfae
4 changed files with 44 additions and 33 deletions

View file

@ -5,7 +5,7 @@
(:local-nicknames (:async :scopes/util/async) (:local-nicknames (:async :scopes/util/async)
(:shape :scopes/shape) (:shape :scopes/shape)
(:util :scopes/util)) (:util :scopes/util))
(:export #:start #:stop #:create #:send #:become (:export #:start #:stop #:create #:send #:become #:*self*
#:customer-message #:message #:content #:customer #:set-content #:customer-message #:message #:content #:customer #:set-content
#:*logger* #:*root* #:*logger* #:*root*
#:echo #:inc #:lgi #:echo #:inc #:lgi

View file

@ -11,7 +11,8 @@
(:util :scopes/util) (:util :scopes/util)
(:alx :alexandria)) (:alx :alexandria))
(:export #:environment #:*environment* #:actions #:set-action (:export #:environment #:*environment* #:actions #:set-action
#:send #:send-message #:*sensors* #:init-zero
#:send #:send-message
#:neuron #:synapse #:neuron #:synapse
#:std-proc)) #:std-proc))
@ -20,42 +21,39 @@
;;;; 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))
(sensors :reader sensors :initarg :sensors
:initform (make-hash-table :test #'equal))))
(defvar *environment* (make-instance 'environment)) (defvar *environment* (make-instance 'environment))
(defun action (env key) (defun action (env key &optional default)
(gethash key (actions env))) (gethash key (actions env) default))
(defun set-action (env key act) (defun set-action (env key act)
(setf (gethash key (actions env)) act)) (setf (gethash key (actions env)) act))
;;;; sensors: automatically created actors (neuron), addressable via message head ;;;; sensors: automatically created actors (neuron), addressable via message head
(defvar *sensors* (make-hash-table :test #'equal)) (defun init-zero (probe)
(set-action *environment* :sensor #'create-sensor)
(let ((zero (actor:create (neuron #'std-proc 0 (list (synapse probe))))))
(setf (gethash '(:init :zero) (sensors *environment*)) (list zero))))
(defun send-message (head data &key customer) (defun send-message (head data &key customer)
(send (message:create head :data data :customer customer))) (send (message:create head :data data :customer customer)))
(defun send (msg) (defun send (msg)
(if (eq (shape:head-value msg :domain) :csys) (if (eq (shape:head-value msg :domain) :csys)
(dolist (sn (find-create-sensors msg)) (dolist (sn (find-sensors msg))
(actor:send sn msg)) (actor:send sn msg))
(core:handle-message core:*root* msg))) (core:handle-message core:*root* msg)))
(defun find-create-sensors (msg) (defun find-sensors (msg)
(let* ((key (cddr (shape:head msg))) (let* ((key (cddr (shape:head msg)))
(sns (gethash key *sensors*))) (sns (gethash key (sensors *environment*))))
;(format t "~&~a ~a" key sns)
(util:lgi key sns) (util:lgi key sns)
(or sns sns))
(let* ((mx (message:create
(list :csys :sensor (shape:head-value msg :class))))
(hdlrs (core:select mx (core:actions core:*root*))))
(if hdlrs
(let ((tsks (mapcar #'actor:create hdlrs)))
(setf (gethash key *sensors*) tsks))
(util:lgw "no action selected" msg))))))
;;;; neurons (= behavior factories) and synapses (connection factories) ;;;; neurons (= behavior factories) and synapses (connection factories)
@ -81,12 +79,24 @@
(funcall s msg))) (funcall s msg)))
(defun handle-action (msg state syns env &key default) (defun handle-action (msg state syns env &key default)
(let ((act (or (action env (shape:head-value msg :action)) default))) (let* ((key (shape:head-value msg :action))
(or (and act (funcall act msg state syns env)) (act (action env key default)))
(list msg state syns)))) (funcall act msg state syns env)
;(or (and act (funcall act msg state syns env))
;(list msg state syns)))
))
;;;; predefined neuron actions ;;;; predefined neuron actions
(defun no-op (msg state syns env)
(list msg (shape:data msg) syns))
(defun remember (msg state syns env) (defun remember (msg state syns env)
(list msg (shape:data msg) syns)) (list msg (shape:data msg) syns))
(defun create-sensor (msg state syns env)
(let ((key (shape:data msg))
(sensor (actor:create
(neuron #'std-proc 0 (list (synapse actor:*self*))))))
(setf (gethash key (sensors env)) (list sensor))
(list msg state syns)))

View file

@ -4,11 +4,6 @@
(config:root) (config:root)
(config:add-action '(:csys :sensor :std)
(csys:neuron #'csys:std-proc 0
(list (csys:synapse *probe*))
))
(config:add :logger :class 'logging:config (config:add :logger :class 'logging:config
:loglevel (config:from-env :loglevel :info) :loglevel (config:from-env :loglevel :info)
:logfile (t:test-path "scopes-test.log" "log") :logfile (t:test-path "scopes-test.log" "log")

View file

@ -24,9 +24,11 @@
((test-suite :reader test-suite :initarg :test-suite))) ((test-suite :reader test-suite :initarg :test-suite)))
(defun probe (msg state syns env) (defun probe (msg state syns env)
(let ((t:*test-suite* (test-suite env))) (let ((t:*test-suite* (test-suite env))
(let ((state (in-seq (shape:data msg) state :remove t))) (val (shape:data msg)))
(actor:become (csys:neuron #'probe state syns env))))) (unless (consp val)
(let ((nst (in-seq val state :remove t)))
(actor:become (csys:neuron #'probe nst syns env))))))
(defvar *probe* nil) (defvar *probe* nil)
@ -38,20 +40,24 @@
(defun run () (defun run ()
(async:init) (async:init)
(let* ((t:*test-suite* (make-instance 't:test-suite :name "csys")) (let* ((t:*test-suite* (make-instance 't:test-suite :name "csys"))
(csys:*sensors* (make-hash-table :test #'equal))
(csys:*environment* (make-instance 'test-env :test-suite t:*test-suite*)) (csys:*environment* (make-instance 'test-env :test-suite t:*test-suite*))
(*probe* (actor:create (*probe* (actor:create
(csys:neuron #'probe '(1 3 4 5) nil csys:*environment*)))) (csys:neuron #'probe '(1 3 4 5)
nil csys:*environment*))))
(load (t:test-path "config-csys" "etc")) (load (t:test-path "config-csys" "etc"))
(core:setup-services) (core:setup-services)
(unwind-protect (unwind-protect
(progn (progn
(test-basic)) (test-init))
(sleep 0.1) (sleep 0.1)
(async:finish) (async:finish)
(t:show-result)))) (t:show-result))))
(deftest test-basic () (deftest test-init ()
(csys:init-zero *probe*)
(csys:send-message '(:csys :sensor :init :zero) '(:std :s1))
(csys:send-message '(:csys :sensor :init :zero) '(:std :s2))
(sleep 0.1)
(csys:send-message '(:csys :add :std :s1) 1) (csys:send-message '(:csys :add :std :s1) 1)
(csys:send-message '(:csys :add :std :s1) 3) (csys:send-message '(:csys :add :std :s1) 3)
(csys:send-message '(:csys :sub :std :s2) 4) (csys:send-message '(:csys :sub :std :s2) 4)