From 0a39d11addaa95b87899ae7643b64f6b97987202 Mon Sep 17 00:00:00 2001 From: Helmut Merz Date: Wed, 29 Jul 2026 08:21:15 +0200 Subject: [PATCH] csys: add send-create shortcut --- csys/csys.lisp | 13 ++++++++++++- csys/environ.lisp | 4 ++-- test/test-csys.lisp | 18 ++++++------------ 3 files changed, 20 insertions(+), 15 deletions(-) diff --git a/csys/csys.lisp b/csys/csys.lisp index 339ce00..ba809bb 100644 --- a/csys/csys.lisp +++ b/csys/csys.lisp @@ -14,7 +14,7 @@ #:handle-action #:forward #:notify #:basic-actions #:no-op #:value-add #:create #:connect #:multiply - #:send-connect)) + #:send-create #:send-connect)) (in-package :scopes/csys) @@ -52,6 +52,8 @@ (setf (proc scope) (funcall (program scope) scope)) scope) +;;;; system initialization + (defgeneric make-program (spec) (:method ((proc function)) (lambda (scope) proc)) (:method ((spec list)) @@ -181,11 +183,20 @@ ;;;; public shortcuts +(defun send-create (rcvr &rest args &key (domain :csys) (cat :c00) name connect op) + (let ((args+ (if name + `(:addr ,(list domain cat name)) + `(:categ ,(list domain cat))))) + (setf args (alx:remove-from-plist :domain :cat :name)) + (actor:send rcvr + (message:create (list domain :create) :data (append args+ args))))) + (defun send-connect (rcvr target &key op (domain :csys)) (actor:send rcvr (message:create (list domain :connect) :data (list :target target :op op)))) + ;;;; internal helpers (defun new-msg-head (msg scope) diff --git a/csys/environ.lisp b/csys/environ.lisp index 3640f5b..6fe7230 100644 --- a/csys/environ.lisp +++ b/csys/environ.lisp @@ -36,9 +36,9 @@ (new (getf data :new))) (when addr (register-cell (cells scope) addr new)) - ;;;send :next message / create more cells: + ;(csys:send-message new (list (message:domain msg) :next) :data data) (actor:send new - (message:create (list (message:domain msg) :next) :data (shape:data msg))) + (message:create (list (message:domain msg) :next) :data data)) nil)) (defun forward (msg scope) diff --git a/test/test-csys.lisp b/test/test-csys.lisp index 8667717..3e56ee5 100644 --- a/test/test-csys.lisp +++ b/test/test-csys.lisp @@ -70,22 +70,15 @@ ':default (csys:std-proc :actions (csys:basic-actions))))) (defun actions-zero-initial () - (let ((acts (csys:basic-actions))) - (setf (getf acts :next) (next-zero-initial)) - acts)) + (util:plist-merge (list :next (next-zero-initial)) + (csys:basic-actions))) (defun next-zero-initial () (lambda (msg scope) - (let ((self actor:*self*) - (cr '(:csys :create :c00 "0-0")) - (conn '(:csys :connect :c00 "0-0"))) - (actor:send self - (message:create cr :data '(:categ (:csys :e01) :connect :succ))) - (actor:send self - (message:create cr :data '(:addr (:csys :s01 "0-1") :connect :pred))) + (let ((self actor:*self*)) + (csys:send-create self :cat :e01 :connect :succ) + (csys:send-create self :cat :s01 :name "0-1" :connect :pred) (csys:send-connect self self :op (csys:multiply -1)) - ;(actor:send self - ; (message:create conn :data (list :target self :op (csys:multiply -1)))) ;; switch :active nil))) @@ -96,6 +89,7 @@ (rcvr (tc:receiver t:*test-suite*))) (sleep 0.1) ;(tc:expect rcvr (message:create '(:csys :effect :e01) :data '(:value 1))) + ;(environ:send-value 1 :cat :s01 :name "0-1") (actor:send env (message:create '(:csys :value :s01 "0-1") :data '(:value 1))) (actor:send env (message:create '(:csys :value :s01 "0-1") :data '(:value 2))) (sleep 0.1)