environ:send-message: use customer instead of :to data field for receiver
This commit is contained in:
parent
94a444cde3
commit
d910366dac
4 changed files with 17 additions and 15 deletions
|
|
@ -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))))
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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))))
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue