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

csys, work in progress: environ:send-connect-pred

Browse source
This commit is contained in:
Helmut Merz 2026-09-26 10:24:56 +02:00
parent 5fcfaf6fd4
commit cd85171f22
2 changed files with 25 additions and 13 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
csys/csys.lisp
View file

@ -183,7 +183,7 @@
nil)))
(defun connect ()
;; TODO: target may be a list => check if already connected
;; TODO: checks: already connected? category OK? other conditions?
(lambda (msg scope)
(let* ((data (shape:data msg))
(syn (synapse (getf data :target) (getf data :op))))

34
csys/environ.lisp
View file

@ -98,13 +98,18 @@
nil)
(defun forward-connect (msg scope)
(let* ((data (shape:data msg))
(let* ((head (shape:head msg))
(data (shape:data msg))
(tgt (getf data :target))
(cust (actor:customer msg)))
(cond
((null tgt) (setf (getf data :target) (find-cells-near scope cust)))
((listp tgt) (setf (getf data :target) (find-cell scope tgt))))
(forward (message:create (shape:head msg) :data data :customer cust) scope)))
(when (listp tgt)
(setf tgt (find-cell scope tgt))
(setf (getf data :target) tgt))
(if (or cust (message:addr msg))
(forward (message:create head :data data :customer cust) scope)
(let ((rcvrs (find-cells-near scope tgt)))
(dolist (rcvr rcvrs)
(actor:send rcvr (message:create head :data data)))))))
;;;; public shortcuts
@ -126,12 +131,18 @@
(when op (util:plist-add data :op op))
(send-message head data :customer cust :env env)))
(defun send-connect-pred (target &key (domain csys:*domain*) (env *env*) op cat)
(let ((head (cons domain :connect))
(data (list :target target)))
(when op (util:plist-add data :op op))
(when cat (util:plist-add data :cat cat))
(send-message head data :env env)))
;;;; internal helpers
(defun register-cell (scope addr cell)
(destructuring-bind (dom cat loc) addr
(let* ((reg (spaces scope))
(spc (getf reg dom)))
(let ((spc (getf (spaces scope) dom)))
(space:put spc loc cell)
(setf (gethash cell (cells scope)) addr))))
@ -145,9 +156,10 @@
cell)))
(defun find-cells-near (scope cell &key (dist 2))
(destructuring-bind (&optional dom cat loc) (getf cell (cells scope))
(let ((addr (gethash cell (cells scope))))
(destructuring-bind (&optional dom cat loc) addr
(when (null loc)
(error "cell not found or loc missing! scope: ~s, cell: ~s" scope cell))
(let ((space (getf dom (spaces scope))))
(space:neighbors space loc :dist dist))))
(error "cell not found or loc missing! cells: ~s, cell: ~s, addr: ~s"
(cells scope) cell addr))
(space:neighbors (getf (spaces scope) dom) loc :dist dist))))