diff --git a/core/message.lisp b/core/message.lisp index 62bfdda..a815a93 100644 --- a/core/message.lisp +++ b/core/message.lisp @@ -6,7 +6,7 @@ (:shape :scopes/shape) (:util :scopes/util)) (:export #:message-meta #:message #:create - #:action #:addr #:categ #:domain)) + #:action #:addr #:categ #:domain #:dom-act)) (in-package :scopes/core/message) @@ -29,7 +29,13 @@ (defmethod actor:content ((msg message)) (list (shape:head-plist msg) (shape:data msg))) +(defun domain (msg) + (car (shape:head msg))) + (defun action (msg) + (cadr (shape:head msg))) + +(defun dom-act (msg) (let ((head (shape:head msg))) (list (car head) (cadr head)))) @@ -40,6 +46,3 @@ (defun categ (msg) (let ((head (shape:head msg))) (list (car head) (caddr head)))) - -(defun domain (msg) - (car (shape:head msg))) diff --git a/csys/csys.lisp b/csys/csys.lisp index fb9b2d9..6a3adf5 100644 --- a/csys/csys.lisp +++ b/csys/csys.lisp @@ -10,6 +10,7 @@ (:alx :alexandria)) (:export #:scope #:environ #:neuron #:synapse #:std-proc #:update #:create + #:make-prog #:handle-action)) (in-package :scopes/csys) @@ -18,23 +19,32 @@ (defclass scope () ((value :accessor value :initarg :value :initform 0) - (params :accessor params :initarg :params :initform nil) + (params :accessor params :initarg :params :initform nil) ; <- program (categ :accessor categ :initarg :categ :initform '(:csys :c00)) (stage :accessor stage :initform :initial) (proc :accessor proc :initarg :proc :initform #'std-proc) (program :reader program :initarg :program :initform nil) - (actions :accessor actions :initarg :actions :initform nil) + (actions :accessor actions :initarg :actions :initform nil) ; <- program (syns :accessor syns :initform nil) (environ :reader environ :initarg :environ))) -(defun scope (&optional (program #'std-proc) &rest args) - (apply #'make-instance 'scope :program program args)) +(defun scope (&optional (program (make-prog #'std-proc)) &rest args) + (let ((sc (apply #'make-instance 'scope :program program args))) + (set-proc sc))) (defun reset-scope (scope &rest args) - (apply #'scope (or (getf args :program) (program scope)) + (let ((sc (apply #'scope (or (getf args :program) (program scope)) :categ (or (getf args :categ) (categ scope)) :environ (or (getf args :environ) (environ scope)) - args)) + args))) + (set-proc sc))) + +(defun set-proc (scope) + (setf (proc scope) (funcall (program scope) scope)) + scope) + +(defun make-prog (fn) + (lambda (scope) fn)) ;;;; neurons (= async tasks) and synapses (= connections) diff --git a/csys/environ.lisp b/csys/environ.lisp index 0c03726..94bdbde 100644 --- a/csys/environ.lisp +++ b/csys/environ.lisp @@ -6,13 +6,13 @@ (:csys :scopes/csys) (:message :scopes/core/message) ) - (:export #:forward #:forward-message) + (:export #:forward) ) (in-package :scopes/csys/environ) (defclass scope (csys:scope) - (cells :reader cells :initarg :cells :initform (make-hash-table :test #'equal))) + ((cells :reader cells :initarg :cells :initform (make-hash-table :test #'equal)))) ;;;; action handlers, public callables diff --git a/test/test-core.lisp b/test/test-core.lisp index 5f5432b..de7a6af 100644 --- a/test/test-core.lisp +++ b/test/test-core.lisp @@ -125,6 +125,7 @@ (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 () diff --git a/test/test-csys.lisp b/test/test-csys.lisp index ea4a7e1..edc4f7f 100644 --- a/test/test-csys.lisp +++ b/test/test-csys.lisp @@ -56,7 +56,8 @@ (core:setup-services) (setf (tc:receiver t:*test-suite*) (core:find-service :test-receiver)) ;(csys:add-action '(:csys :sensor) #'csys:create-sensor) - (let ((env (csys:neuron (csys:scope #'proc-env + (let* ((prog (csys:make-prog #'proc-env)) + (env (csys:neuron (csys:scope prog :environ (tc:receiver t:*test-suite*))))) ;(csys:create) ; or: (environ:setup program:basic-0 #'proc-env) )) diff --git a/util/index.lisp b/util/index.lisp index c2467b3..ce427c7 100644 --- a/util/index.lisp +++ b/util/index.lisp @@ -4,6 +4,7 @@ (defpackage :scopes/util/index (:use :common-lisp) + (:local-nicknames (:alx :alexandria)) (:export #:create #:put #:query)) (in-package :scopes/util/index) @@ -20,6 +21,8 @@ (cur (gethash key data))) (setf (gethash key data) (cons value cur))))) -(defgeneric query (idx key) - (:method ((idx index) key) - (gethash key (data idx)))) +(defgeneric query (idx pat) + (:method ((idx index) pat) + (if (equal pat "*") + (alx:flatten (alx:hash-table-values (data idx))) + (gethash pat (data idx)))))