environ:send-message: use customer instead of :to data field for receiver

This commit is contained in:
Helmut Merz 2026-09-24 12:36:49 +02:00
parent 94a444cde3
commit d910366dac
4 changed files with 17 additions and 15 deletions

View file

@ -32,7 +32,7 @@
(defgeneric update-content (msg fn)
(:documentation "Create a new message with content returned by calling `fn`
with the content of the input `msg`.")
on the content of the input `msg`.")
(:method (msg fn) (funcall fn msg))
(:method ((msg message) fn)
(message (funcall fn (content msg)) (customer msg))))

View file

@ -27,10 +27,11 @@
(shape:head msg) (actor:customer msg) (shape:data msg)))
(defmethod actor:content ((msg message))
(list (shape:head-plist msg) (shape:data msg)))
(list (shape:head msg) (shape:data msg)))
(defmethod actor:update-content ((msg message) fn)
(create (shape:head msg) :data (fn (shape:data msg)) :customer (actor:customer msg)))
(defmethod update-content ((msg message) fn)
(destructuring-bind (head data) (funcall fn (actor:content msg))
(create head :data data :customer (actor:customer msg))))
(defun domain (msg)
(car (shape:head msg)))

View file

@ -90,24 +90,25 @@
(if addr
(let ((cell (find-cell (spaces scope) (message:addr msg))))
(actor:send cell msg))
(let ((rcvr (getf (shape:data msg) :to)))
(let ((rcvr (actor:customer msg)))
(if rcvr
(actor:send rcvr msg)
(util:lgw "no addr and no :to field in message" msg scope)))))
(util:lgw "no addr and no customer in message" msg scope)))))
nil)
(defun forward-connect (msg scope)
;; TODO: target may be nil => replace with list of candidates
(let* ((data (shape:data msg))
(tgt (getf data :target)))
(tgt (getf data :target))
(cust (actor:customer msg)))
(when (listp tgt)
(setf (getf data :target) (find-cell (spaces scope) tgt)))
(forward (message:create (shape:head msg) :data data) scope)))
(forward (message:create (shape:head msg) :data data :customer cust) scope)))
;;;; public shortcuts
(defun send-message (head data &key (env *env*))
(actor:send env (message:create head :data data)))
(defun send-message (head data &key customer (env *env*))
(actor:send env (message:create head :data data :customer customer)))
(defun send-value (cat-loc val &key (domain csys:*domain*) (env *env*))
(let ((head (cons domain (cons :value cat-loc))))
@ -117,12 +118,13 @@
;; TODO: use msg.customer instead of :to in data
(let* ((cat-loc (when (listp rcvr) rcvr))
(head (cons domain (cons :connect cat-loc)))
(data (unless cat-loc (list :to rcvr))))
(when op (util:plist-add data :op op))
(cust (unless cat-loc rcvr))
data)
(when (and (listp target) (< (length target) 3))
(setf target (cons domain target)))
(util:plist-add data :target target)
(send-message head data :env env)))
(setf data (list :target target))
(when op (util:plist-add data :op op))
(send-message head data :customer cust :env env)))
;;;; internal helpers

View file

@ -16,7 +16,6 @@
(defun put (spc loc obj)
(let ((current (gethash loc spc)))
(if current
;(util:lgw "location already occupied" spc loc current obj)
(error "location already occupied! space: ~s, loc: ~s, current: ~s, new: ~s"
spc loc current obj)
(setf (gethash loc spc) obj))))