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

Compare commits

base: cco:94b35fcefd3afea70f51bf35ba60896e03e35ed2
Branches Tags
cco:master
...
compare: cco:0c47aec77d27e822aca14ed0cebb58ac96e46902
Branches Tags
cco:master

3 commits
94b35fcefd ... 0c47aec77d

Author SHA1 Message Date
Helmut Merz
0c47aec77d csys:program: move program.lisp to program/basic.lisp 2026-08-10 11:30:51 +02:00
Helmut Merz
40d1ea84e3 csys:*domain*: provide default value for domain settings 2026-08-10 11:03:21 +02:00
Helmut Merz
0cca279545 csys/program, tests: consistent naming of categories in basic-0 and basic-1 2026-08-10 08:47:52 +02:00
6 changed files with 41 additions and 36 deletions
Show stats Expand all files Collapse all files

13
csys/csys.lisp
View file

@ -8,7 +8,8 @@
(:shape :scopes/shape) (:shape :scopes/shape)
(:util :scopes/util) (:util :scopes/util)
(:alx :alexandria)) (:alx :alexandria))
(:export #:scope #:environ (:export #:*domain*
#:scope #:environ
#:make-program #:create-zero #:make-program #:create-zero
#:neuron #:std-proc #:eff-proc #:neuron #:std-proc #:eff-proc
#:handle-action #:basic-actions #:forward #:notify #:handle-action #:basic-actions #:forward #:notify
@ -18,6 +19,8 @@
(in-package :scopes/csys) (in-package :scopes/csys)
(defvar *domain* :csys)
;;;; scope: information a neuron has access to ;;;; scope: information a neuron has access to
(defclass scope () (defclass scope ()
@ -192,7 +195,7 @@
(defun send-message (cell head data) (defun send-message (cell head data)
(actor:send cell (message:create head :data data))) (actor:send cell (message:create head :data data)))
(defun send-create (cell &rest args &key (domain :csys) (defun send-create (cell &rest args &key (domain *domain*)
(cat :c00) loc connect op &allow-other-keys) (cat :c00) loc connect op &allow-other-keys)
(let ((args+ (if loc (let ((args+ (if loc
`(:addr ,(list domain cat loc)) `(:addr ,(list domain cat loc))
@ -200,11 +203,13 @@
(setf args (alx:remove-from-plist args :domain :cat :loc)) (setf args (alx:remove-from-plist args :domain :cat :loc))
(send-message cell (list domain :create) (append args+ args)))) (send-message cell (list domain :create) (append args+ args))))
(defun send-connect (cell target &key op (domain :csys)) (defun send-connect (cell target &key op (domain *domain*))
(send-message cell (list domain :connect) (list :target target :op op))) (send-message cell (list domain :connect) (list :target target :op op)))
(defun printer () (defun printer ()
(actor:create (lambda (msg) (print msg)))) (actor:create
(lambda (msg)
(format t "~&~s~%" msg))))
;;;; internal helpers ;;;; internal helpers

8
csys/environ.lisp
View file

@ -20,7 +20,7 @@
(defclass scope (csys:scope) (defclass scope (csys:scope)
((cells :reader cells :initform (make-hash-table :test #'equal)))) ((cells :reader cells :initform (make-hash-table :test #'equal))))
(defun create (proc meta-env &key eff-contacts) ; meta-env example: (csys:printer) (defun create (proc meta-env &key eff-contacts)
(let* ((prg (csys:make-program proc)) (let* ((prg (csys:make-program proc))
(scope (csys:scope prg meta-env :cls 'scope :categ '(:env :c00))) (scope (csys:scope prg meta-env :cls 'scope :categ '(:env :c00)))
(env (csys:neuron scope))) (env (csys:neuron scope)))
@ -30,7 +30,7 @@
(defun simple-setup (cfg) (defun simple-setup (cfg)
(destructuring-bind (prg &key (zero-cat :c00) eff-contacts) cfg (destructuring-bind (prg &key (zero-cat :c00) eff-contacts) cfg
(let ((env (create #'simple-proc (csys:printer) :eff-contacts eff-contacts))) (let ((env (create #'simple-proc (csys:printer) :eff-contacts eff-contacts)))
(csys:create-zero prg env :categ (list :csys zero-cat)) (csys:create-zero prg env :categ (list csys:*domain* zero-cat))
env))) env)))
(defun simple-proc (msg scope) (defun simple-proc (msg scope)
@ -101,11 +101,11 @@
;;;; public shortcuts ;;;; public shortcuts
(defun send-value (cat-loc val &key (domain :csys) (env *env*)) (defun send-value (cat-loc val &key (domain csys:*domain*) (env *env*))
(let ((head (cons domain (cons :value cat-loc)))) (let ((head (cons domain (cons :value cat-loc))))
(actor:send env (message:create head :data `(:value ,val))))) (actor:send env (message:create head :data `(:value ,val)))))
(defun send-connect (env &rest args &key (domain :csys) addr to target op) (defun send-connect (env &rest args &key (domain csys:*domain*) addr to target op)
(let ((head (list domain :connect))) (let ((head (list domain :connect)))
(actor:send env (message:create head :data args)))) (actor:send env (message:create head :data args))))

32
csys/program.lisp → csys/program/basic.lisp
View file

@ -1,6 +1,6 @@
;;;; cl-scopes/csys/program - common and general csys program definitions ;;;; cl-scopes/csys/program/basic - common and general csys program definitions
(defpackage :scopes/csys/program (defpackage :scopes/csys/program/basic
(:use :common-lisp) (:use :common-lisp)
(:local-nicknames (:actor :scopes/core/actor) (:local-nicknames (:actor :scopes/core/actor)
(:csys :scopes/csys) (:csys :scopes/csys)
@ -8,21 +8,21 @@
(:util :scopes/util)) (:util :scopes/util))
(:export #:basic-0 #:config-basic-1)) (:export #:basic-0 #:config-basic-1))
(in-package :scopes/csys/program) (in-package :scopes/csys/program/basic)
;;;; basic-0: minimal recursive system ;;;; basic-0: minimal recursive system
(defun basic-0 () (defun basic-0 ()
(csys:make-program (csys:make-program
(list '(:c00 :initial) (csys:std-proc :next (b0-next-zero)) (list '(:c00 :initial) (csys:std-proc :next (b0-next-zero))
'(:e01 :initial) (csys:eff-proc) '(:e00 :initial) (csys:eff-proc)
':default (csys:std-proc)))) ':default (csys:std-proc))))
(defun b0-next-zero () (defun b0-next-zero ()
(lambda (msg scope) (lambda (msg scope)
(let ((self actor:*self*)) (let ((self actor:*self*))
(csys:send-create self :cat :e01 :connect :succ) (csys:send-create self :cat :e00 :connect :succ)
(csys:send-create self :cat :s01 :loc "0-1" :connect :pred) (csys:send-create self :cat :s00 :loc "0-1" :connect :pred)
(csys:send-connect self self :op (csys:multiply -1)) (csys:send-connect self self :op (csys:multiply -1))
;; switch :active ;; switch :active
nil))) nil)))
@ -30,23 +30,23 @@
;;;; basic-1: minimal cross-linked system ;;;; basic-1: minimal cross-linked system
(defun config-basic-1 () (defun config-basic-1 ()
(list (basic-1) :zero-cat :s00 (list (basic-1) :zero-cat :s01
:eff-contacts '(:e00 ("1-0" "1-1")))) :eff-contacts '(:e01 ("1-0" "1-1"))))
(defun basic-1 () (defun basic-1 ()
(csys:make-program (csys:make-program
(list '(:s00 :initial) (csys:std-proc :next (b1-next-zero)) (list '(:s01 :initial) (csys:std-proc :next (b1-next-zero))
'(:s00 :basic) (csys:std-proc :next (b1-next-one)) '(:s01 :basic) (csys:std-proc :next (b1-next-one))
'(:e00 :default) (csys:eff-proc :value (csys:value-add :bias 2)) '(:e01 :default) (csys:eff-proc :value (csys:value-add :bias 2))
':default (csys:std-proc)))) ':default (csys:std-proc))))
(defun b1-next-zero () (defun b1-next-zero ()
(lambda (msg scope) (lambda (msg scope)
(let ((self actor:*self*)) (let ((self actor:*self*))
(csys:send-create self :cat :e00 :loc "1-0" :value 2 :connect :succ) (csys:send-create self :cat :e01 :loc "1-0" :value 2 :connect :succ)
(csys:send-create self :cat :e00 :loc "1-1" :value 2 (csys:send-create self :cat :e01 :loc "1-1" :value 2
:connect :succ :op (csys:multiply -1)) :connect :succ :op (csys:multiply -1))
(csys:send-create self :cat :s00 :loc "0-1" :stage :basic) (csys:send-create self :cat :s01 :loc "0-1" :stage :basic)
;; switch :active ;; switch :active
nil))) nil)))
@ -54,8 +54,8 @@
(lambda (msg scope) (lambda (msg scope)
(let ((self actor:*self*) (let ((self actor:*self*)
(env (csys:environ scope))) (env (csys:environ scope)))
(environ:send-connect env :to self :target '(:csys :e00 "1-0") (environ:send-connect env :to self :target '(:csys :e01 "1-0")
:op (csys:multiply -1)) :op (csys:multiply -1))
(environ:send-connect env :to self :target '(:csys :e00 "1-1")) (environ:send-connect env :to self :target '(:csys :e01 "1-1"))
;; switch :active ;; switch :active
nil))) nil)))

3
scopes-csys.asd
View file

@ -11,8 +11,7 @@
:depends-on (:scopes-core) :depends-on (:scopes-core)
:components ((:file "csys/csys") :components ((:file "csys/csys")
(:file "csys/environ" :depends-on ("csys/csys")) (:file "csys/environ" :depends-on ("csys/csys"))
(:file "csys/program" :depends-on ("csys/csys" "csys/environ")) (:file "csys/program/basic" :depends-on ("csys/csys" "csys/environ")))
)
:long-description "scopes/csys: Concurrent cybernetic communication systems." :long-description "scopes/csys: Concurrent cybernetic communication systems."
:in-order-to ((test-op (test-op "scopes-csys/test")))) :in-order-to ((test-op (test-op "scopes-csys/test"))))

4
scratch.lisp
View file

@ -8,11 +8,11 @@
;;;; csys stuff ;;;; csys stuff
(add-package-local-nickname :basic :scopes/csys/program/basic)
(add-package-local-nickname :environ :scopes/csys/environ) (add-package-local-nickname :environ :scopes/csys/environ)
(add-package-local-nickname :program :scopes/csys/program)
(scopes/util/async:init) (scopes/util/async:init)
(setf environ:*env* (environ:simple-setup (program:config-basic-1))) (setf environ:*env* (environ:simple-setup (basic:config-basic-1)))
;(environ:send-value '(:s00 "0-1") 2) ;(environ:send-value '(:s00 "0-1") 2)

17
test/test-csys.lisp
View file

@ -5,6 +5,7 @@
(:local-nicknames (:alx :alexandria) (:local-nicknames (:alx :alexandria)
(:actor :scopes/core/actor) (:actor :scopes/core/actor)
(:async :scopes/util/async) (:async :scopes/util/async)
(:basic :scopes/csys/program/basic)
(:config :scopes/config) (:config :scopes/config)
(:core :scopes/core) (:core :scopes/core)
(:csys :scopes/csys) (:csys :scopes/csys)
@ -30,8 +31,8 @@
(defun setup-config () (defun setup-config ()
(config:add :test-receiver :setup #'tc:setup) (config:add :test-receiver :setup #'tc:setup)
(config:add-action '(:csys :effect :e01) (value-in '(1 2))) (config:add-action '(:csys :effect :e00) (value-in '(1 2)))
(config:add-action '(:csys :effect :e00) (value-in '(1 2 3 4))) (config:add-action '(:csys :effect :e01) (value-in '(1 2 3 4)))
;(config:add-action '(:csys :effect) #'tc:check-message) ;(config:add-action '(:csys :effect) #'tc:check-message)
(config:add-action '(:csys) (constantly nil))) (config:add-action '(:csys) (constantly nil)))
@ -67,19 +68,19 @@
;;;; test definitions ;;;; test definitions
(deftest test-basic-0 () (deftest test-basic-0 ()
(let ((environ:*env* (setup-test (list (program:basic-0))))) (let ((environ:*env* (setup-test (list (basic:basic-0)))))
;(rcvr (tc:receiver t:*test-suite*)) ;(rcvr (tc:receiver t:*test-suite*))
(sleep 0.1) (sleep 0.1)
;(tc:expect rcvr (message:create '(:csys :effect :e01) :data '(:value 1))) ;(tc:expect rcvr (message:create '(:csys :effect :e01) :data '(:value 1)))
(environ:send-value '(:s01 "0-1") 1) (environ:send-value '(:s00 "0-1") 1)
(environ:send-value '(:s01 "0-1") 2) (environ:send-value '(:s00 "0-1") 2)
(sleep 0.1) (sleep 0.1)
(core:shutdown))) (core:shutdown)))
(deftest test-basic-1 () (deftest test-basic-1 ()
(let ((environ:*env* (setup-test (program:config-basic-1)))) (let ((environ:*env* (setup-test (basic:config-basic-1))))
(sleep 0.1) (sleep 0.1)
(environ:send-value '(:s00 "0-0") 1) (environ:send-value '(:s01 "0-0") 1)
(environ:send-value '(:s00 "0-1") 2) (environ:send-value '(:s01 "0-1") 2)
(sleep 0.1) (sleep 0.1)
(core:shutdown))) (core:shutdown)))