csys, work in progress: set up program and proc

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)))

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)
+(defun scope (&optional (program (make-prog #'std-proc)) &rest args)
-  (apply #'make-instance 'scope :program program 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)
 

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
 

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 ()

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)
     ))

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)
+(defgeneric query (idx pat)
-  (:method ((idx index) key)
+  (:method ((idx index) pat)
-    (gethash key (data idx))))
+    (if (equal pat "*")
+      (alx:flatten (alx:hash-table-values (data idx)))
+      (gethash pat (data idx)))))