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

work in progress: csys refactoring (old version in 'legacy')

Browse source
This commit is contained in:
Helmut Merz 2026-07-11 13:07:50 +02:00
parent 205f96d917
commit 8471173a99
8 changed files with 306 additions and 97 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

113
csys/csys.lisp
View file

@ -8,90 +8,51 @@
(:shape :scopes/shape)
(:util :scopes/util)
(:alx :alexandria))
(:export #:environment #:*environment* #:add-action #:add-sensor
(:export #:scope #:environ
#:send #:send-message
#:neuron #:synapse #:std-proc
#:make-neuron #:update-neuron #:create-sensor
#:neuron #:synapse #:std-proc #:update
#:handle-action))
(in-package :scopes/csys)
;;;; environment: common information, with list of globally available actions
;;;; scope: information a neuron has access to
(defclass environment ()
((actions :reader actions :initarg :actions
:initform (make-hash-table :test #'equal))
(sensors :reader sensors :initarg :sensors
:initform (make-hash-table :test #'equal :synchronized t))
(procs :reader procs :initarg :procs
:initform (make-hash-table :test #'equal))))
(defclass scope ()
((value :reader value :initarg :value :initform 0)
(stage :reader stage :initform :initial)
(syns :reader syns :initform nil)
(program :reader program :initarg :program :initform nil)
(actions :reader actions :initarg :actions :initform nil)
(environ :reader environ :initarg :environ)))
;(defvar *environment* (make-instance 'environment))
(defvar *environment* nil)
(defun scope (&optional (program #'std-proc) &rest args)
(apply #'make-instance 'scope :program program args))
(defun add-action (key fn)
;(util:lgi key fn *environment*)
(setf (gethash key (actions *environment*)) fn))
;;;; neurons (= async tasks) and synapses (= connections)
(defun add-sensor (key sn)
(pushnew sn (gethash key (sensors *environment*))))
;;;; neurons (= behavior factories) and synapses (connection factories)
(defun neuron (proc &optional state syns (env *environment*))
(lambda (msg)
(let ((*environment* env))
(funcall proc msg state syns))))
(defun neuron (scope)
(actor:create
(lambda (msg) (funcall msg scope))))
(defun synapse (rcvr &optional (op #'identity))
(lambda (msg)
(actor:send rcvr (funcall op msg))))
(defun make-neuron (syn-target &key proc state (syn-op #'identity))
(let ((proc (or proc (gethash :default (procs *environment*) #'std-proc)))
(syns (if syn-target (list (synapse syn-target syn-op)) nil)))
(actor:create (neuron proc state syns))))
(defun update (scope)
(actor:become
(lambda (msg) (funcall msg scope))))
(defun update-neuron (proc state syns)
(actor:become (neuron proc state syns)))
(defun std-proc (msg state syns &key (next #'std-proc))
(defun std-proc (msg scope)
;(util:lgi msg state syns env)
(destructuring-bind (nmsg nst nsyns)
(handle-action msg state syns :default #'remember)
(forward nmsg nsyns)
(update-neuron (next-proc nst next) nst nsyns)))
(destructuring-bind (nmsg nscope)
(handle-action msg scope :default #'remember)
(forward nmsg (syns nscope))
(update nscope)))
;;;; neuron state methods
(defgeneric next-proc (state &optional default)
(:method (state &optional (default #'std-proc)) default))
(defgeneric value (state)
(:method (state) state))
(defun program (msg state syns)
(let ((stages (list #'std-proc)))
(funcall (car stages) msg state syns)))
;;;; sensors: neurons receiving messages from environment, addressable via message head
(defun send-message (head data &key customer)
(send (message:create head :data data :customer customer)))
(defun send (msg)
(dolist (sn (find-sensors msg))
(actor:send sn msg)))
(defun find-sensors (msg)
(let* ((key (message:object-key msg))
(sns (gethash key (sensors *environment*))))
;(util:lgi key sns *environment*)
sns))
;;;; effector procs for pseudo-neurons embedded in environment
(defun do-log (msg state syns)
(defun do-log (msg scope)
(util:lgi msg))
;;;; helper / utility funtions
@ -100,27 +61,17 @@
(dolist (s syns)
(funcall s msg)))
(defun handle-action (msg state syns &key (default #'no-op))
(defun handle-action (msg scope &key (default #'no-op))
(let* ((key (message:action-key msg))
(act (gethash key (actions *environment*) default)))
(funcall act msg state syns)))
;(act (select-action msg state default))
(act (gethash key (actions scope) default)))
(funcall act msg scope)))
;;;; predefined neuron actions
(defun no-op (msg state syns)
(list msg state syns))
(defun no-op (msg scope)
(list msg scope))
(defun remember (msg state syns)
(defun remember (msg scope)
;(list msg (make-neuron-state (shape:data msg) syns))
(list msg (shape:data msg) syns))
(defun create-sensor (msg state syns)
(let* ((key (cons (car (shape:head msg)) (shape:data msg)))
(sensor (make-neuron actor:*self* :state key))
(nmsg (message:create (list :csys :created (car key) (cadr key)))))
(add-sensor key sensor)
(list nmsg state syns)))
(defun add (msg state syns)
(list msg (+ (shape:data msg) state) syns))

20
csys/environ.lisp Normal file
View file

@ -0,0 +1,20 @@
;;;; cl-scopes/csys/environ - communication system environment
(defpackage :scopes/csys/environ
(:use :common-lisp)
(:local-nicknames (:actor :scopes/core/actor)
(:csys :scopes/csys)
(:message :scopes/core/message)
)
(:export #:send #:send-message)
)
(in-package :scopes/csys/environ)
(defun send-message (head data &key customer)
(send (message:create head :data data :customer customer)))
(defun send (msg)
(dolist (sn (find-sensors msg))
(actor:send sn msg)))

11
legacy/csys/config-csys.lisp Normal file
View file

@ -0,0 +1,11 @@
;;;; cl-scopes/test/etc/config-csys - configuration for `scopes-csys` tests
(in-package :scopes/test-csys)
(config:root)
(config:add :logger :class 'logging:config
:loglevel (config:from-env :loglevel :info)
:logfile (t:test-path "scopes-test.log" "log")
:console nil)

126
legacy/csys/csys.lisp Normal file
View file

@ -0,0 +1,126 @@
;;;; cl-scopes/csys - concurrent cybernetic communication systems
(defpackage :scopes/csys
(:use :common-lisp)
(:local-nicknames (:actor :scopes/core/actor)
(:config :scopes/config)
(:message :scopes/core/message)
(:shape :scopes/shape)
(:util :scopes/util)
(:alx :alexandria))
(:export #:environment #:*environment* #:add-action #:add-sensor
#:send #:send-message
#:neuron #:synapse #:std-proc
#:make-neuron #:update-neuron #:create-sensor
#:handle-action))
(in-package :scopes/csys)
;;;; environment: common information, with list of globally available actions
(defclass environment ()
((actions :reader actions :initarg :actions
:initform (make-hash-table :test #'equal))
(sensors :reader sensors :initarg :sensors
:initform (make-hash-table :test #'equal :synchronized t))
(procs :reader procs :initarg :procs
:initform (make-hash-table :test #'equal))))
;(defvar *environment* (make-instance 'environment))
(defvar *environment* nil)
(defun add-action (key fn)
;(util:lgi key fn *environment*)
(setf (gethash key (actions *environment*)) fn))
(defun add-sensor (key sn)
(pushnew sn (gethash key (sensors *environment*))))
;;;; neurons (= behavior factories) and synapses (connection factories)
(defun neuron (proc &optional state syns (env *environment*))
(lambda (msg)
(let ((*environment* env))
(funcall proc msg state syns))))
(defun synapse (rcvr &optional (op #'identity))
(lambda (msg)
(actor:send rcvr (funcall op msg))))
(defun make-neuron (syn-target &key proc state (syn-op #'identity))
(let ((proc (or proc (gethash :default (procs *environment*) #'std-proc)))
(syns (if syn-target (list (synapse syn-target syn-op)) nil)))
(actor:create (neuron proc state syns))))
(defun update-neuron (proc state syns)
(actor:become (neuron proc state syns)))
(defun std-proc (msg state syns &key (next #'std-proc))
;(util:lgi msg state syns env)
(destructuring-bind (nmsg nst nsyns)
(handle-action msg state syns :default #'remember)
(forward nmsg nsyns)
(update-neuron (next-proc nst next) nst nsyns)))
;;;; neuron state methods
(defgeneric next-proc (state &optional default)
(:method (state &optional (default #'std-proc)) default))
(defgeneric value (state)
(:method (state) state))
(defun program (msg state syns)
(let ((stages (list #'std-proc)))
(funcall (car stages) msg state syns)))
;;;; sensors: neurons receiving messages from environment, addressable via message head
(defun send-message (head data &key customer)
(send (message:create head :data data :customer customer)))
(defun send (msg)
(dolist (sn (find-sensors msg))
(actor:send sn msg)))
(defun find-sensors (msg)
(let* ((key (message:object-key msg))
(sns (gethash key (sensors *environment*))))
;(util:lgi key sns *environment*)
sns))
;;;; effector procs for pseudo-neurons embedded in environment
(defun do-log (msg state syns)
(util:lgi msg))
;;;; helper / utility funtions
(defun forward (msg syns)
(dolist (s syns)
(funcall s msg)))
(defun handle-action (msg state syns &key (default #'no-op))
(let* ((key (message:action-key msg))
(act (gethash key (actions *environment*) default)))
(funcall act msg state syns)))
;;;; predefined neuron actions
(defun no-op (msg state syns)
(list msg state syns))
(defun remember (msg state syns)
;(list msg (make-neuron-state (shape:data msg) syns))
(list msg (shape:data msg) syns))
(defun create-sensor (msg state syns)
(let* ((key (cons (car (shape:head msg)) (shape:data msg)))
(sensor (make-neuron actor:*self* :state key))
(nmsg (message:create (list :csys :created (car key) (cadr key)))))
(add-sensor key sensor)
(list nmsg state syns)))
(defun add (msg state syns)
(list msg (+ (shape:data msg) state) syns))

20
legacy/csys/scopes-csys.asd Normal file
View file

@ -0,0 +1,20 @@
;;;; cl-scopes/scopes-csys.asd
(in-package #:asdf-user)
(defsystem :scopes-csys
:author "cyberconcepts.org Team <team@cyberconcepts.org>"
:license "MIT"
:version "0.0.1"
:homepage "https://www.cyberconcepts.org"
:description "Concurrent cybernetic communications systems."
:depends-on (:scopes-core)
:components ((:file "csys/csys"))
:long-description "scopes/csys: Concurrent cybernetic communication systems."
:in-order-to ((test-op (test-op "scopes-csys/test"))))
(defsystem :scopes-csys/test
:depends-on (:scopes-csys :scopes-core/test)
:components ((:file "test/test-csys"))
:perform (test-op (o c)
(symbol-call :scopes/test-csys :run)))

76
legacy/csys/test-csys.lisp Normal file
View file

@ -0,0 +1,76 @@
;;;; cl-scopes/test-csys - testing for the scopes-csys system.
(defpackage :scopes/test-csys
(:use :common-lisp)
(:local-nicknames (:alx :alexandria)
(:actor :scopes/core/actor)
(:async :scopes/util/async)
(:config :scopes/config)
(:core :scopes/core)
(:csys :scopes/csys)
(:logging :scopes/logging)
(:message :scopes/core/message)
(:shape :scopes/shape)
(:util :scopes/util)
(:t :scopes/testing)
(:tc :scopes/test-core))
(:export #:run)
(:import-from :scopes/testing #:deftest #:== #:!= #:in-seq))
(in-package :scopes/test-csys)
;;;; testing environment
(defclass test-env (csys:environment)
((test-suite :reader test-suite :initarg :test-suite)))
(defun check-seq (seq)
(lambda (ctx msg)
(let ((t:*test-suite* (tc:suite ctx)))
(t:in-seq (shape:data msg) seq))))
(defun setup-config ()
(config:add :test-receiver :setup #'tc:setup)
(config:add-action '(:csys :sub) (check-seq '(4)))
(config:add-action '(:csys :add) (check-seq '(1 3 5)))
(config:add-action '(:csys) (constantly nil))
)
(defun eff-proc (msg state syns)
(let ((t:*test-suite* (test-suite csys:*environment*)))
(destructuring-bind (nmsg nst nsyns)
(csys:handle-action msg state syns)
(util:lgi nmsg)
(actor:send (core:mailbox (tc:receiver t:*test-suite*)) nmsg))))
(defun run ()
(let ((t:*test-suite* (make-instance 'tc:test-suite :name "csys")))
(load (t:test-path "config-csys" "etc"))
(async:init)
(unwind-protect
(test-init)
(sleep 0.1)
(t:show-result))))
;;;; test: initialization
(defun setup-test-init ()
(setup-config)
(core:setup-services)
(setf (tc:receiver t:*test-suite*) (core:find-service :test-receiver))
(csys:add-action '(:csys :sensor) #'csys:create-sensor)
(let ((zero (csys:make-neuron nil :proc #'eff-proc)))
(csys:add-sensor '(:csys :init :zero) 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 :s2))
(sleep 0.1)
(csys:send-message '(:csys :add :std :s1) 1)
(csys:send-message '(:csys :add :std :s1) 3)
(csys:send-message '(:csys :sub :std :s2) 4)
(csys:send-message '(:csys :add :std :s2) 5)
(core:shutdown)
))

3
scopes-csys.asd
View file

@ -9,7 +9,8 @@
:homepage "https://www.cyberconcepts.org"
:description "Concurrent cybernetic communications systems."
:depends-on (:scopes-core)
:components ((:file "csys/csys"))
:components ((:file "csys/csys")
(:file "csys/environ" :depends-on ("csys/csys")))
:long-description "scopes/csys: Concurrent cybernetic communication systems."
:in-order-to ((test-op (test-op "scopes-csys/test"))))

34
test/test-csys.lisp
View file

@ -8,6 +8,7 @@
(:config :scopes/config)
(:core :scopes/core)
(:csys :scopes/csys)
(:environ :scopes/csys/environ)
(:logging :scopes/logging)
(:message :scopes/core/message)
(:shape :scopes/shape)
@ -21,9 +22,6 @@
;;;; testing environment
(defclass test-env (csys:environment)
((test-suite :reader test-suite :initarg :test-suite)))
(defun check-seq (seq)
(lambda (ctx msg)
(let ((t:*test-suite* (tc:suite ctx)))
@ -36,10 +34,9 @@
(config:add-action '(:csys) (constantly nil))
)
(defun eff-proc (msg state syns)
(let ((t:*test-suite* (test-suite csys:*environment*)))
(destructuring-bind (nmsg nst nsyns)
(csys:handle-action msg state syns)
(defun env-proc (msg scope)
(let ((t:*test-suite* (csys:environ scope)))
(destructuring-bind (nmsg scope) (csys:handle-action msg scope)
(util:lgi nmsg)
(actor:send (core:mailbox (tc:receiver t:*test-suite*)) nmsg))))
@ -48,22 +45,29 @@
(load (t:test-path "config-csys" "etc"))
(async:init)
(unwind-protect
(test-init)
(test-basic-1)
(sleep 0.1)
(t:show-result))))
;;;; test: initialization
(defun setup-test-init ()
(defun setup-test-basic-1 ()
(setup-config)
(core:setup-services)
(setf (tc:receiver t:*test-suite*) (core:find-service :test-receiver))
(csys:add-action '(:csys :sensor) #'csys:create-sensor)
(let ((zero (csys:make-neuron nil :proc #'eff-proc)))
(csys:add-sensor '(:csys :init :zero) zero)))
;(csys:add-action '(:csys :sensor) #'csys:create-sensor)
(let ((env (csys:neuron (csys:scope #'env-proc
:environ (tc:receiver t:*test-suite*))))
;(csys:add-sensor '(:csys :init :zero) zero)
)))
(deftest test-init ()
(let ((csys:*environment* (make-instance 'test-env :test-suite t:*test-suite*)))
(deftest test-basic-1 ()
(setup-test-basic-1)
(sleep 0.1)
(core:shutdown)
)
(deftest x-test-init ()
(setup-test-init)
(csys:send-message '(:csys :sensor :init :zero) '(:std :s1))
(csys:send-message '(:csys :sensor :init :zero) '(:std :s2))
@ -73,4 +77,4 @@
(csys:send-message '(:csys :sub :std :s2) 4)
(csys:send-message '(:csys :add :std :s2) 5)
(core:shutdown)
))
)