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

csys, work in progress: use space for finding free locationsor cells to connect to

Browse source
This commit is contained in:
Helmut Merz 2026-09-25 13:17:16 +02:00
parent 2fe73c3632
commit 5fcfaf6fd4
3 changed files with 16 additions and 14 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
csys/csys.lisp
View file

@ -39,15 +39,15 @@
(defmethod initialize-instance :after ((sc scope) &key &allow-other-keys) (defmethod initialize-instance :after ((sc scope) &key &allow-other-keys)
(set-proc sc)) (set-proc sc))
(defun reset-scope (scp &rest args) (defun reset-scope (scope &rest args)
(let* ((addr (getf args :addr)) (let* ((addr (getf args :addr))
(categ (if addr (categ (if addr
(list (car addr) (cadr addr)) (list (car addr) (cadr addr))
(getf args :categ (categ scp))))) (getf args :categ (categ scope)))))
(setf args (alx:remove-from-plist args :categ :addr)) (setf args (alx:remove-from-plist args :categ :addr))
(apply #'scope (apply #'scope
(getf args :program (program scp)) (getf args :program (program scope))
(getf args :environ (environ scp)) (getf args :environ (environ scope))
:categ categ :categ categ
args))) args)))
@ -231,9 +231,7 @@
(defun send-create (cell &rest args &key (domain *domain*) (defun send-create (cell &rest args &key (domain *domain*)
(cat :c00) loc connect op &allow-other-keys) (cat :c00) loc connect op &allow-other-keys)
(let ((args+ (if loc (let ((args+ `(:addr ,(list domain cat loc))))
`(:addr ,(list domain cat loc))
`(:categ ,(list domain cat)))))
(setf args (alx:remove-from-plist args :domain :cat :loc)) (setf args (alx:remove-from-plist args :domain :cat :loc))
(send-message cell (list domain :create) (append args+ args)))) (send-message cell (list domain :create) (append args+ args))))

16
csys/environ.lisp
View file

@ -76,7 +76,7 @@
(defun cell-created (msg scope) (defun cell-created (msg scope)
(let* ((data (shape:data msg)) (let* ((data (shape:data msg))
(addr (getf data :addr (getf data :categ))) (addr (getf data :addr))
(new (getf data :new))) (new (getf data :new)))
(when addr (when addr
(register-cell scope addr new)) (register-cell scope addr new))
@ -98,12 +98,11 @@
nil) nil)
(defun forward-connect (msg scope) (defun forward-connect (msg scope)
;; TODO: target may be nil => replace with list of candidates
(let* ((data (shape:data msg)) (let* ((data (shape:data msg))
(tgt (getf data :target)) (tgt (getf data :target))
(cust (actor:customer msg))) (cust (actor:customer msg)))
(cond (cond
((null tgt) (setf (getf data :target) (find-cell-near scope cust))) ((null tgt) (setf (getf data :target) (find-cells-near scope cust)))
((listp tgt) (setf (getf data :target) (find-cell scope tgt)))) ((listp tgt) (setf (getf data :target) (find-cell scope tgt))))
(forward (message:create (shape:head msg) :data data :customer cust) scope))) (forward (message:create (shape:head msg) :data data :customer cust) scope)))
@ -130,14 +129,14 @@
;;;; internal helpers ;;;; internal helpers
(defun register-cell (scope addr cell) (defun register-cell (scope addr cell)
(destructuring-bind (dom cat &optional (loc "")) addr (destructuring-bind (dom cat loc) addr
(let* ((reg (spaces scope)) (let* ((reg (spaces scope))
(spc (getf reg dom))) (spc (getf reg dom)))
(space:put spc loc cell) (space:put spc loc cell)
(setf (gethash cell (cells scope)) addr)))) (setf (gethash cell (cells scope)) addr))))
(defun find-cell (scope addr &key no-warn) (defun find-cell (scope addr &key no-warn)
(destructuring-bind (dom cat &optional loc) addr (destructuring-bind (dom cat loc) addr
(let* ((reg (spaces scope)) (let* ((reg (spaces scope))
(spc (getf reg dom)) (spc (getf reg dom))
(cell (space:fetch spc loc))) (cell (space:fetch spc loc)))
@ -145,5 +144,10 @@
(util:lgw "not found" addr reg spc)) (util:lgw "not found" addr reg spc))
cell))) cell)))
(defun find-cell-near (scope cell)) (defun find-cells-near (scope cell &key (dist 2))
(destructuring-bind (&optional dom cat loc) (getf cell (cells scope))
(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))))

2
csys/program/basic.lisp
View file

@ -23,7 +23,7 @@
(defun b0-next-zero () (defun b0-next-zero ()
(lambda (msg scope) (lambda (msg scope)
(let ((self actor:*self*)) (let ((self actor:*self*))
(csys:send-create self :cat :e00 :connect :succ) (csys:send-create self :cat :e00 :loc #(1 0) :connect :succ)
(csys:send-create self :cat :s00 :loc #(0 1) :connect :pred) (csys:send-create self :cat :s00 :loc #(0 1) :connect :pred)
(csys:send-connect self self :op (csys:multiply -1)) (csys:send-connect self self :op (csys:multiply -1))
(csys:send-switch self :active) (csys:send-switch self :active)