From d9eb8ac69200742e2e179d2ac1865e568af40b4d Mon Sep 17 00:00:00 2001 From: Helmut Merz Date: Sat, 25 Jul 2026 22:06:07 +0200 Subject: [PATCH] get rid of now obsolete legacy folder --- csys/csys.lisp | 6 +- csys/environ.lisp | 6 +- legacy/csys/config-csys.lisp | 11 --- legacy/csys/csys.lisp | 126 ----------------------------------- legacy/csys/scopes-csys.asd | 20 ------ legacy/csys/test-csys.lisp | 76 --------------------- test/test-csys.lisp | 10 +-- 7 files changed, 12 insertions(+), 243 deletions(-) delete mode 100644 legacy/csys/config-csys.lisp delete mode 100644 legacy/csys/csys.lisp delete mode 100644 legacy/csys/scopes-csys.asd delete mode 100644 legacy/csys/test-csys.lisp diff --git a/csys/csys.lisp b/csys/csys.lisp index f9bf14c..76c5ea7 100644 --- a/csys/csys.lisp +++ b/csys/csys.lisp @@ -13,7 +13,7 @@ #:neuron #:std-proc #:eff-proc #:create-zero #:handle-action #:notify - #:no-op #:value-add)) + #:basic-actions #:no-op #:value-add #:create)) (in-package :scopes/csys) @@ -109,6 +109,10 @@ ;;;; action handlers +(defun basic-actions () + (list :value (value-add) + :create (create))) + (defun no-op (&key no-forward) (lambda (msg scope) (unless no-forward msg))) diff --git a/csys/environ.lisp b/csys/environ.lisp index 73d564e..c3f6be3 100644 --- a/csys/environ.lisp +++ b/csys/environ.lisp @@ -32,9 +32,11 @@ (defun cell-created (msg scope) (let* ((data (shape:data msg)) - (addr (getf data :addr))) + (addr (getf data :addr)) + (new (getf data :new))) (when addr - (register-cell (cells scope) addr (getf data :new))) + (register-cell (cells scope) addr new)) + ;send startup message / create more cells msg)) (defun forward (msg scope) diff --git a/legacy/csys/config-csys.lisp b/legacy/csys/config-csys.lisp deleted file mode 100644 index 2777e60..0000000 --- a/legacy/csys/config-csys.lisp +++ /dev/null @@ -1,11 +0,0 @@ -;;;; 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) - diff --git a/legacy/csys/csys.lisp b/legacy/csys/csys.lisp deleted file mode 100644 index 06a91b7..0000000 --- a/legacy/csys/csys.lisp +++ /dev/null @@ -1,126 +0,0 @@ -;;;; 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)) - diff --git a/legacy/csys/scopes-csys.asd b/legacy/csys/scopes-csys.asd deleted file mode 100644 index d546c70..0000000 --- a/legacy/csys/scopes-csys.asd +++ /dev/null @@ -1,20 +0,0 @@ -;;;; cl-scopes/scopes-csys.asd - -(in-package #:asdf-user) - -(defsystem :scopes-csys - :author "cyberconcepts.org Team " - :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))) diff --git a/legacy/csys/test-csys.lisp b/legacy/csys/test-csys.lisp deleted file mode 100644 index 855a8a1..0000000 --- a/legacy/csys/test-csys.lisp +++ /dev/null @@ -1,76 +0,0 @@ -;;;; 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) - )) diff --git a/test/test-csys.lisp b/test/test-csys.lisp index e920b33..25fa587 100644 --- a/test/test-csys.lisp +++ b/test/test-csys.lisp @@ -29,7 +29,7 @@ (defun setup-config () (config:add :test-receiver :setup #'tc:setup) - ;(config:add-action '(:csys :effect :c00 "0-0") (value-in '(1))) + ;(config:add-action '(:csys :effect :c00) (value-in '(1))) (config:add-action '(:csys :effect) #'tc:check-message) (config:add-action '(:csys) (constantly nil))) @@ -41,9 +41,6 @@ (when nmsg (actor:send (core:mailbox (tc:receiver t:*test-suite*)) nmsg))))) -(defun actions () - (list :value (csys:value-add))) - (defun run () (let ((t:*test-suite* (make-instance 'tc:test-suite :name "csys"))) (load (t:test-path "config-csys" "etc")) @@ -54,8 +51,6 @@ (tc:check-expected) (t:show-result)))) -;;;; test: initialization - (defun setup-test (prg) (setup-config) (core:setup-services) @@ -65,9 +60,10 @@ (csys:create-zero prg env) env)) +(defun actions () (csys:basic-actions)) + (deftest test-basic-0 () (let ((env (setup-test (csys:make-program (csys:eff-proc :actions (actions))))) - ;(env (setup-test (csys:make-program (csys:eff-proc)))) ;(env (setup-test (test-program)) (rcvr (tc:receiver t:*test-suite*))) (sleep 0.1)