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

csys, work in progress: environ setup: create zero neuron

Browse source
This commit is contained in:
Helmut Merz 2026-07-18 17:38:34 +02:00
parent 20ed5134e5
commit e3308dbf80
3 changed files with 18 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
csys/csys.lisp
View file

@ -35,8 +35,8 @@
(defun reset-scope (scope &rest args) (defun reset-scope (scope &rest args)
(let ((sc (apply #'scope (or (getf args :program) (program scope)) (let ((sc (apply #'scope (or (getf args :program) (program scope))
:categ (or (getf args :categ) (categ scope)) :categ (getf args :categ (categ scope))
:environ (or (getf args :environ) (environ scope)) :environ (getf args :environ (environ scope))
args))) args)))
(set-proc sc))) (set-proc sc)))
@ -72,7 +72,7 @@
(update nscope))) (update nscope)))
(defun create (msg scope) (defun create (msg scope)
(let ((new (neuron (apply #'reset scope (shape:data msg))))) (let ((new (neuron (apply #'reset-scope scope (shape:data msg)))))
(notify-created msg new scope))) (notify-created msg new scope)))
(defun do-log (msg scope) (defun do-log (msg scope)
@ -88,12 +88,12 @@
(defun handle-action (msg scope &key (default #'no-op) actions params) (defun handle-action (msg scope &key (default #'no-op) actions params)
(let* ((key (message:action msg)) (let* ((key (message:action msg))
;(act (gethash key (actions scope) default)) ;(act (gethash key (actions scope) default))
(act (getf actions key default))) (act (getf actions key (getf actions :default default))))
(apply act msg scope params))) (apply act msg scope params)))
(defun notify-created (msg new scope) (defun notify-created (msg new scope)
(let* ((head (list (message:domain msg) :created)) (let* ((head (list (message:domain msg) :created))
(data (util:plist-merge (shape:data scope) '(:new new :parent actor:*self*))) (data (util:plist-merge (shape:data msg) '(:new new :parent actor:*self*)))
(msg1 (message:create head :data data))) (msg1 (message:create head :data data)))
(notify msg1 scope)) (notify msg1 scope))
) )

8
csys/environ.lisp
View file

@ -5,7 +5,7 @@
(:local-nicknames (:actor :scopes/core/actor) (:local-nicknames (:actor :scopes/core/actor)
(:csys :scopes/csys) (:csys :scopes/csys)
(:message :scopes/core/message) (:message :scopes/core/message)
) (:shape :scopes/shape))
(:export #:actions (:export #:actions
#:forward)) #:forward))
@ -20,7 +20,11 @@
'(:created #'cell-created '(:created #'cell-created
:default #'csys:notify)) :default #'csys:notify))
(defun cell-created (msg scope)) (defun cell-created (msg scope)
(let* ((data (shape:data msg))
(addr (getf data :addr)))
(when addr
(register-cell (cells scope) addr (getf data :new)))))
(defun forward-message (head scope &key data customer) (defun forward-message (head scope &key data customer)
(forward (message:create head :data data :customer customer) scope)) (forward (message:create head :data data :customer customer) scope))

9
test/test-csys.lisp
View file

@ -35,7 +35,8 @@
) )
(defun proc-env (msg scope) (defun proc-env (msg scope)
(let ((t:*test-suite* (csys:environ scope))) (destructuring-bind (nmsg scope) (let ((t:*test-suite* (csys:environ scope)))
(destructuring-bind (nmsg scope)
(csys:handle-action msg scope :actions (environ:actions)) (csys:handle-action msg scope :actions (environ:actions))
(util:lgi nmsg) (util:lgi nmsg)
(actor:send (core:mailbox (tc:receiver t:*test-suite*)) nmsg)))) (actor:send (core:mailbox (tc:receiver t:*test-suite*)) nmsg))))
@ -58,7 +59,11 @@
;(csys:add-action '(:csys :sensor) #'csys:create-sensor) ;(csys:add-action '(:csys :sensor) #'csys:create-sensor)
(let* ((prog (csys:make-prog #'proc-env)) (let* ((prog (csys:make-prog #'proc-env))
(env (csys:neuron (csys:scope prog (env (csys:neuron (csys:scope prog
:environ (tc:receiver t:*test-suite*))))) :environ (tc:receiver t:*test-suite*))))
(msg (message:create '(:csys :create)
:data `(:addr (:csys :c00 "0-0")
:categ :c00
:environ ,env))))
;(csys:create) ; or: (environ:setup program:basic-0 #'proc-env) ;(csys:create) ; or: (environ:setup program:basic-0 #'proc-env)
)) ))