Compare commits
2 commits
e816a13d41
...
8e784b5960
| Author | SHA1 | Date | |
|---|---|---|---|
| 8e784b5960 | |||
| 877f23a5d4 |
5 changed files with 62 additions and 10 deletions
|
|
@ -23,7 +23,7 @@
|
||||||
(stage :accessor stage :initform :initial)
|
(stage :accessor stage :initform :initial)
|
||||||
(proc :accessor proc :initarg :proc :initform #'std-proc)
|
(proc :accessor proc :initarg :proc :initform #'std-proc)
|
||||||
(program :reader program :initarg :program :initform nil)
|
(program :reader program :initarg :program :initform nil)
|
||||||
(actions :reader actions :initarg :actions :initform nil)
|
(actions :accessor actions :initarg :actions :initform nil)
|
||||||
(syns :accessor syns :initform nil)
|
(syns :accessor syns :initform nil)
|
||||||
(environ :reader environ :initarg :environ)))
|
(environ :reader environ :initarg :environ)))
|
||||||
|
|
||||||
|
|
@ -31,7 +31,10 @@
|
||||||
(apply #'make-instance 'scope :program program args))
|
(apply #'make-instance 'scope :program program args))
|
||||||
|
|
||||||
(defun reset-scope (scope &rest args)
|
(defun reset-scope (scope &rest args)
|
||||||
(apply #'scope (program scope) :environ (environ scope) args))
|
(apply #'scope (or (getf args :program) (program scope))
|
||||||
|
:categ (or (getf args :categ) (categ scope))
|
||||||
|
:environ (or (getf args :environ) (environ scope))
|
||||||
|
args))
|
||||||
|
|
||||||
;;;; neurons (= async tasks) and synapses (= connections)
|
;;;; neurons (= async tasks) and synapses (= connections)
|
||||||
|
|
||||||
|
|
@ -58,8 +61,7 @@
|
||||||
(update nscope)))
|
(update nscope)))
|
||||||
|
|
||||||
(defun create (msg scope)
|
(defun create (msg scope)
|
||||||
;todo: use message data for modifying new scope
|
(let ((new (neuron (apply #'reset scope (shape:data msg)))))
|
||||||
(let ((new (neuron (reset scope))))
|
|
||||||
(notify-created msg new scope)))
|
(notify-created msg new scope)))
|
||||||
|
|
||||||
(defun do-log (msg scope)
|
(defun do-log (msg scope)
|
||||||
|
|
|
||||||
|
|
@ -6,15 +6,28 @@
|
||||||
(:csys :scopes/csys)
|
(:csys :scopes/csys)
|
||||||
(:message :scopes/core/message)
|
(:message :scopes/core/message)
|
||||||
)
|
)
|
||||||
(:export #:send #:send-message)
|
(:export #:forward #:forward-message)
|
||||||
)
|
)
|
||||||
|
|
||||||
(in-package :scopes/csys/environ)
|
(in-package :scopes/csys/environ)
|
||||||
|
|
||||||
(defun send-message (head data &key customer)
|
(defclass scope (csys:scope)
|
||||||
(send (message:create head :data data :customer customer)))
|
(cells :reader cells :initarg :cells :initform (make-hash-table :test #'equal)))
|
||||||
|
|
||||||
(defun send (msg)
|
;;;; action handlers, public callables
|
||||||
(dolist (sn (find-sensors msg))
|
|
||||||
(actor:send sn msg)))
|
(defun cell-created (msg scope))
|
||||||
|
|
||||||
|
(defun forward-message (head scope &key data customer)
|
||||||
|
(forward (message:create head :data data :customer customer) scope))
|
||||||
|
|
||||||
|
(defun forward (msg scope)
|
||||||
|
(dolist (cell (find-cells (cells scope) (message:addr 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