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

csys/environ:forward-create: with finding free location

Browse source
This commit is contained in:
Helmut Merz 2026-10-06 16:19:20 +02:00
parent e923218cd6
commit 98cd349133
1 changed files with 22 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

33
csys/environ.lisp
View file

@ -88,17 +88,23 @@
nil)) nil))
(defun forward (msg scope) (defun forward (msg scope)
(let ((addr (message:addr msg))) (let ((rcvr (or (actor:customer msg)
(if addr (find-cell scope (message:addr msg)))))
(let ((cell (find-cell scope (message:addr msg)))) (actor:send rcvr msg))
(actor:send cell msg))
(let ((rcvr (actor:customer msg)))
(if rcvr
(actor:send rcvr msg)
(util:lgw "no addr and no customer in message" msg scope)))))
nil) nil)
(defun forward-create (msg scope)) (defun forward-create (msg scope)
(let* ((addr (message:addr msg))
(rcvr (or (actor:customer msg) (find-cell scope addr)))
(head (shape:head msg))
(data (shape:data msg))
(dom (car head))
(spc (getf (spaces scope) dom)))
(unless addr
(setf addr (gethash rcvr (cells scope))))
(util:plist-add data :loc (car (space:free-loc-at spc (caddr addr))))
(csys:send-message rcvr head data))
nil)
(defun forward-connect (msg scope) (defun forward-connect (msg scope)
(let* ((head (shape:head msg)) (let* ((head (shape:head msg))
@ -112,7 +118,8 @@
(forward (message:create head :data data :customer cust) scope) (forward (message:create head :data data :customer cust) scope)
(let ((rcvrs (find-cells-near scope tgt))) (let ((rcvrs (find-cells-near scope tgt)))
(dolist (rcvr rcvrs) (dolist (rcvr rcvrs)
(actor:send rcvr (message:create head :data data))))))) (actor:send rcvr (message:create head :data data))))))
nil)
;;;; public shortcuts ;;;; public shortcuts
@ -123,9 +130,13 @@
(let ((head (cons domain (cons :value cat-loc)))) (let ((head (cons domain (cons :value cat-loc))))
(send-message head `(:value ,val) :env env))) (send-message head `(:value ,val) :env env)))
(defun send-create (rcvr &key (domain "csys:*domain*") (env *env*) connect op) (defun send-create (rcvr &key (domain "csys:*domain*") (env *env*) cat connect op)
(let ((head (cons domain :create)) (let ((head (cons domain :create))
data) data)
(when (listp rcvr)
(setf head (append head (cdr rcvr)))
(setf rcvr nil))
(when cat (util:plist-add data :cat cat))
(when connect (util:plist-add data :connect connect)) (when connect (util:plist-add data :connect connect))
(when op (util:plist-add data :op op)) (when op (util:plist-add data :op op))
(send-message head data :customer rcvr :env env))) (send-message head data :customer rcvr :env env)))