new package util/index, to be used for csys:environ cell registry
This commit is contained in:
parent
877f23a5d4
commit
8e784b5960
4 changed files with 51 additions and 1 deletions
|
|
@ -11,10 +11,23 @@
|
||||||
|
|
||||||
(in-package :scopes/csys/environ)
|
(in-package :scopes/csys/environ)
|
||||||
|
|
||||||
|
(defclass scope (csys:scope)
|
||||||
|
(cells :reader cells :initarg :cells :initform (make-hash-table :test #'equal)))
|
||||||
|
|
||||||
|
;;;; action handlers, public callables
|
||||||
|
|
||||||
|
(defun cell-created (msg scope))
|
||||||
|
|
||||||
(defun forward-message (head scope &key data customer)
|
(defun forward-message (head scope &key data customer)
|
||||||
(forward (message:create head :data data :customer customer) scope))
|
(forward (message:create head :data data :customer customer) scope))
|
||||||
|
|
||||||
(defun forward (msg scope)
|
(defun forward (msg scope)
|
||||||
(dolist (cell (find-cells (message:addr msg) scope))
|
(dolist (cell (find-cells (cells scope) (message:addr msg)))
|
||||||
(actor:send cell msg)))
|
(actor:send cell msg)))
|
||||||
|
|
||||||
|
;;;; helpers
|
||||||
|
|
||||||
|
(defun register-cell (reg addr cell))
|
||||||
|
|
||||||
|
(defun find-cells (reg addr))
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -25,6 +25,7 @@
|
||||||
(:file "util/util")
|
(:file "util/util")
|
||||||
(:file "util/async" :depends-on ("util/util"))
|
(:file "util/async" :depends-on ("util/util"))
|
||||||
(:file "util/crypt" :depends-on ("util/util"))
|
(:file "util/crypt" :depends-on ("util/util"))
|
||||||
|
(:file "util/index")
|
||||||
(:file "util/iter")
|
(:file "util/iter")
|
||||||
(:file "testing" :depends-on ("util/util")))
|
(:file "testing" :depends-on ("util/util")))
|
||||||
:long-description "scopes/core: The core packages of the scopes project."
|
:long-description "scopes/core: The core packages of the scopes project."
|
||||||
|
|
|
||||||
|
|
@ -8,6 +8,7 @@
|
||||||
(:config :scopes/config)
|
(:config :scopes/config)
|
||||||
(:core :scopes/core)
|
(:core :scopes/core)
|
||||||
(:crypt :scopes/util/crypt)
|
(:crypt :scopes/util/crypt)
|
||||||
|
(:index :scopes/util/index)
|
||||||
(:iter :scopes/util/iter)
|
(:iter :scopes/util/iter)
|
||||||
(:logging :scopes/logging)
|
(:logging :scopes/logging)
|
||||||
(:message :scopes/core/message)
|
(:message :scopes/core/message)
|
||||||
|
|
@ -66,6 +67,7 @@
|
||||||
(progn
|
(progn
|
||||||
(test-util)
|
(test-util)
|
||||||
(test-util-crypt)
|
(test-util-crypt)
|
||||||
|
(test-util-index)
|
||||||
(test-util-iter)
|
(test-util-iter)
|
||||||
(test-shape)
|
(test-shape)
|
||||||
(core:setup-services)
|
(core:setup-services)
|
||||||
|
|
@ -116,6 +118,15 @@
|
||||||
(== (iter:next it) nil)
|
(== (iter:next it) nil)
|
||||||
(== (string (iter:value it)) "A")))
|
(== (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))
|
||||||
|
))
|
||||||
|
|
||||||
(deftest test-shape ()
|
(deftest test-shape ()
|
||||||
(let ((rec (make-instance 'shape:record :head '(:t1))))
|
(let ((rec (make-instance 'shape:record :head '(:t1))))
|
||||||
(== (shape:head rec) '(:t1 nil))
|
(== (shape:head rec) '(:t1 nil))
|
||||||
|
|
|
||||||
25
util/index.lisp
Normal file
25
util/index.lisp
Normal file
|
|
@ -0,0 +1,25 @@
|
||||||
|
;;;; cl-scopes/util/index
|
||||||
|
|
||||||
|
;;;; smart string-based indexes e.g. for queryable registries
|
||||||
|
|
||||||
|
(defpackage :scopes/util/index
|
||||||
|
(:use :common-lisp)
|
||||||
|
(:export #:create #:put #:query))
|
||||||
|
|
||||||
|
(in-package :scopes/util/index)
|
||||||
|
|
||||||
|
(defclass index ()
|
||||||
|
((data :reader data :initform (make-hash-table :test #'equal))))
|
||||||
|
|
||||||
|
(defun create ()
|
||||||
|
(make-instance 'index))
|
||||||
|
|
||||||
|
(defgeneric put (idx key value)
|
||||||
|
(:method ((idx index) key value)
|
||||||
|
(let* ((data (data idx))
|
||||||
|
(cur (gethash key data)))
|
||||||
|
(setf (gethash key data) (cons value cur)))))
|
||||||
|
|
||||||
|
(defgeneric query (idx key)
|
||||||
|
(:method ((idx index) key)
|
||||||
|
(gethash key (data idx))))
|
||||||
Loading…
Add table
Reference in a new issue