csys, shape/space: use new space package for location-based indexing, making util/index obsolete

This commit is contained in:
Helmut Merz 2026-09-02 15:15:06 +02:00
parent e6bccc140a
commit ca678e5bdc
4 changed files with 23 additions and 30 deletions

View file

@ -4,9 +4,9 @@
(:use :common-lisp)
(:local-nicknames (:actor :scopes/core/actor)
(:csys :scopes/csys)
(:index :scopes/util/index)
(:message :scopes/core/message)
(:shape :scopes/shape)
(:space :scopes/shape/space)
(:util :scopes/util))
(:export #:*env*
#:create #:simple-setup #:simple-proc
@ -22,7 +22,7 @@
(defun create (proc meta-env &key eff-contacts (spaces '(:env :csys)))
(let* ((prg (csys:make-program proc))
(spcs (loop for d in spaces append (list d (index:create))))
(spcs (loop for d in spaces append (list d (space:create))))
(scope (csys:scope prg meta-env :cls 'scope :categ '(:env :c00) :spaces spcs))
(env (csys:neuron scope)))
(create-contact-cells eff-contacts env (spaces scope))
@ -125,19 +125,13 @@
(defun register-cell (reg addr cell)
(destructuring-bind (dom cat &optional (loc "")) addr
(let ((idx (getf reg dom)))
(index:put idx loc cell))))
(space:put idx loc cell))))
(defun find-cells (reg addr &key no-warn)
(destructuring-bind (dom cat &optional (loc "")) addr
(let* ((idx (getf reg dom))
(cells (when idx (index:query idx loc))))
(unless (or no-warn cells)
(util:lgw "not found" addr reg idx))
cells)))
(defun find-cell (reg addr &key no-warn)
(let ((cells (find-cells reg addr :no-warn no-warn)))
(when (> (length cells) 1)
(util:lgw "more than one cell found" addr reg cells))
(car cells)))
(destructuring-bind (dom cat loc) addr
(let* ((idx (getf reg dom))
(cell (space:fetch idx loc)))
(unless (or no-warn cell)
(util:lgw "not found" addr reg idx))
cell)))

View file

@ -21,10 +21,10 @@
(:file "forge/forge" :depends-on ("util/iter" "util/util"))
(:file "logging" :depends-on ("config" "util/util"))
(:file "shape/shape")
(:file "shape/space")
(:file "util/util")
(:file "util/async" :depends-on ("util/util"))
(:file "util/crypt" :depends-on ("util/util"))
(:file "util/index")
(:file "util/iter")
(:file "testing" :depends-on ("util/util")))
:long-description "scopes/core: The core packages of the scopes project."

View file

@ -4,7 +4,7 @@
(defpackage :scopes/shape/space
(:use :common-lisp)
(:local-nicknames (:alx :alexandria))
(:export #:create #:put #:get #:query))
(:export #:create #:put #:fetch #:query))
(in-package :scopes/shape/space)
@ -14,7 +14,7 @@
(defun put (space key value)
(setf (gethash key space) value))
(defun get (space key)
(defun fetch (space key)
(gethash key space))
(defun query (space pattern)

View file

@ -9,11 +9,11 @@
(:config :scopes/config)
(:core :scopes/core)
(:crypt :scopes/util/crypt)
(:index :scopes/util/index)
(:iter :scopes/util/iter)
(:logging :scopes/logging)
(:message :scopes/core/message)
(:shape :scopes/shape)
(:space :scopes/shape/space)
(:util :scopes/util)
(:t :scopes/testing))
(:export #:run #:user #:password
@ -68,9 +68,9 @@
(progn
(test-util)
(test-util-crypt)
(test-util-index)
(test-util-iter)
(test-shape)
(test-space)
(core:setup-services)
(test-util-async)
(test-actor)
@ -123,16 +123,6 @@
(== (iter:next it) nil)
(== (string (iter:value it)) "A")))
(deftest test-util-index ()
(let ((idx (index:create)))
(index:put idx "1-1" 42)
(index:put idx "1-2" 46)
(index:put idx "1-1" 43)
(== (index:query idx "1-1") '(43 42))
(== (index:query idx "1-2") '(46))
(== (index:query idx "*") '(46 43 42))
))
(deftest test-shape ()
(let ((rec (make-instance 'shape:record :head '(:t1))))
(== (shape:head rec) '(:t1 nil))
@ -142,6 +132,15 @@
(== (shape:head-plist-str rec) '(:taskid "t1" :username "u1"))
))
(deftest test-space ()
(let ((idx (space:create)))
(space:put idx "1-1" 42)
(space:put idx "1-2" 46)
(space:put idx "1-1" 43)
(== (space:fetch idx "1-1") 43)
(== (space:fetch idx "1-2") 46)
))
(deftest test-util-async ()
(let ((mb (async:make-task nil)))
(async:submit-task mb (lambda () (sleep 0.1) :done))