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

util:plist-merge, use in csys:notify-created

Browse source
This commit is contained in:
Helmut Merz 2026-07-13 09:10:21 +02:00
parent a20170368b
commit e816a13d41
3 changed files with 24 additions and 20 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
csys/csys.lisp
View file

@ -9,8 +9,7 @@
(:util :scopes/util)
(:alx :alexandria))
(:export #:scope #:environ
#:send #:send-message
#:neuron #:synapse #:std-proc #:update
#:neuron #:synapse #:std-proc #:update #:create
#:handle-action))
(in-package :scopes/csys)
@ -59,6 +58,7 @@
(update nscope)))
(defun create (msg scope)
;todo: use message data for modifying new scope
(let ((new (neuron (reset scope))))
(notify-created msg new scope)))
@ -79,8 +79,8 @@
(funcall act msg scope)))
(defun notify-created (msg new scope)
(let* ((head (list (car (shape:head msg)) :created))
(data (list :new new :old actor:*self*)) ; todo: update existing data
(let* ((head (list (message:domain msg) :created))
(data (util:plist-merge (shape:data scope) '(:new new :parent actor:*self*)))
(msg1 (message:create head :data data)))
(notify msg1 scope))
)

30
test/test-csys.lisp
View file

@ -34,7 +34,7 @@
(config:add-action '(:csys) (constantly nil))
)
(defun env-proc (msg scope)
(defun proc-env (msg scope)
(let ((t:*test-suite* (csys:environ scope)))
(destructuring-bind (nmsg scope) (csys:handle-action msg scope)
(util:lgi nmsg)
@ -45,35 +45,35 @@
(load (t:test-path "config-csys" "etc"))
(async:init)
(unwind-protect
(test-basic-1)
(test-basic-0)
(sleep 0.1)
(t:show-result))))
;;;; test: initialization
(defun setup-test-basic-1 ()
(defun setup-test-basic-0 ()
(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 ((env (csys:neuron (csys:scope #'env-proc
:environ (tc:receiver t:*test-suite*))))
;(csys:add-sensor '(:csys :init :zero) zero)
)))
(let ((env (csys:neuron (csys:scope #'proc-env
:environ (tc:receiver t:*test-suite*)))))
;(csys:create) ; or: (environ:setup program:basic-0 #'proc-env)
))
(deftest test-basic-1 ()
(setup-test-basic-1)
(deftest test-basic-0 ()
(setup-test-basic-0)
(sleep 0.1)
(core:shutdown)
)
(deftest x-test-init ()
(csys:send-message '(:csys :sensor :init :zero) '(:std :s1))
(csys:send-message '(:csys :sensor :init :zero) '(:std :s2))
;(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)
;(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)
)

6
util/util.lisp
View file

@ -10,7 +10,7 @@
#:ptr
#:rfill #:rtrim
#:loop-plist #:filter-plist #:map-plist
#:plist-pairs #:plist-equal #:plist-add
#:plist-pairs #:plist-equal #:plist-add #:plist-merge
#:flatten-str #:from-keyword #:to-keyword #:to-integer #:to-string
#:from-bytes #:to-bytes #:b64-decode #:b64-encode #:from-b64 #:to-b64
#:absolute-dir #:check-dir #:ensure-dir #:home-path #:path-from-string
@ -82,6 +82,10 @@
(defun plist-pairs (pl)
(loop-plist pl k v collect (list k v)))
(defun plist-merge (pl1 pl2)
(loop-plist pl2 k v do (setf (getf pl1 k nil) v))
pl1)
(defun plist-equal (l1 l2)
(unless (= (length l1) (length l2))
(return-from plist-equal nil))