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)
(set-proc sc))
(defun reset-scope (scp &rest args)
(defun reset-scope (scope &rest args)
(let* ((addr (getf args :addr))
(categ (if 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))
(apply #'scope
(getf args :program (program scp))
(getf args :environ (environ scp))
(getf args :program (program scope))
(getf args :environ (environ scope))
:categ categ
args)))
@ -231,9 +231,7 @@
(defun send-create (cell &rest args &key (domain *domain*)
(cat :c00) loc connect op &allow-other-keys)
(let ((args+ (if loc
`(:addr ,(list domain cat loc))
`(:categ ,(list domain cat)))))
(let ((args+ `(:addr ,(list domain cat loc))))
(setf args (alx:remove-from-plist args :domain :cat :loc))
(send-message cell (list domain :create) (append args+ args))))

16
csys/environ.lisp
View file

@ -76,7 +76,7 @@
(defun cell-created (msg scope)
(let* ((data (shape:data msg))
(addr (getf data :addr (getf data :categ)))
(addr (getf data :addr))
(new (getf data :new)))
(when addr
(register-cell scope addr new))
@ -98,12 +98,11 @@
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))
(cust (actor:customer msg)))
(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))))
(forward (message:create (shape:head msg) :data data :customer cust) scope)))
@ -130,14 +129,14 @@
;;;; internal helpers
(defun register-cell (scope addr cell)
(destructuring-bind (dom cat &optional (loc "")) addr
(destructuring-bind (dom cat loc) addr
(let* ((reg (spaces scope))
(spc (getf reg dom)))
(space:put spc loc cell)
(setf (gethash cell (cells scope)) addr))))
(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))
(spc (getf reg dom))
(cell (space:fetch spc loc)))
@ -145,5 +144,10 @@
(util:lgw "not found" addr reg spc))
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 ()
(lambda (msg scope)
(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-connect self self :op (csys:multiply -1))
(csys:send-switch self :active)