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

csys:*domain*: provide default value for domain settings

Browse source
This commit is contained in:
Helmut Merz 2026-08-10 11:02:22 +02:00
parent 0cca279545
commit 40d1ea84e3
2 changed files with 9 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
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,7 +203,7 @@
(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 ()

6
csys/environ.lisp
View file

@ -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))))