csys, work in progress: environ:actions

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

@@ -9,8 +9,10 @@
                     (:util :scopes/util)
                     (:alx :alexandria))
   (:export #:scope #:environ
-           #:neuron #:synapse #:std-proc #:update #:create
-           #:handle-action))
+           #:make-prog
+           #:neuron #:std-proc #:create
+           #:handle-action
+           #:notify))
 
 (in-package :scopes/csys)
 
@@ -18,23 +20,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)
+
+(defgeneric make-prog (spec)
+  (:method ((fn function)) (lambda (scope) fn)))
 
 ;;;; neurons (= async tasks) and synapses (= connections)
 
@@ -56,7 +67,7 @@
 (defun std-proc (msg scope)
   ;(util:lgi msg state syns env)
   (destructuring-bind (nmsg nscope) 
-        (handle-action msg scope :default #'remember)
+        (handle-action msg scope :default #'remember) ; + params, actions
     (forward nmsg (syns nscope))
     (update nscope)))
 
@@ -74,11 +85,11 @@
   (dolist (s syns) 
     (funcall s msg)))
 
-(defun handle-action (msg scope &key (default #'no-op))
+(defun handle-action (msg scope &key (default #'no-op) actions params)
   (let* ((key (message:action msg))
-         ;(act (select-action msg state default))
-         (act (gethash key (actions scope) default)))
-    (funcall act msg scope)))
+         ;(act (gethash key (actions scope) default))
+         (act (getf actions key default)))
+    (apply act msg scope params)))
 
 (defun notify-created (msg new scope)
   (let* ((head (list (message:domain msg) :created))

csys/environ.lisp

@@ -6,16 +6,20 @@
                     (:csys :scopes/csys)
                     (:message :scopes/core/message)
                     )
-  (:export #:forward #:forward-message)
-  )
+  (:export #:actions
+           #:forward))
 
 (in-package :scopes/csys/environ)
 
 (defclass scope (csys:scope)
-  (cells :reader cells :initarg :cells :initform (make-hash-table :test #'equal)))
+  ((cells :reader cells :initform (make-hash-table :test #'equal))))
 
 ;;;; action handlers, public callables
 
+(defun actions () 
+  '(:created #'cell-created
+    :default #'csys:notify))
+
 (defun cell-created (msg scope))
 
 (defun forward-message (head scope &key data customer)

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

@@ -35,8 +35,8 @@
   )
 
 (defun proc-env (msg scope)
-  (let ((t:*test-suite* (csys:environ scope))) 
-    (destructuring-bind (nmsg scope) (csys:handle-action msg scope)
+  (let ((t:*test-suite* (csys:environ scope))) (destructuring-bind (nmsg scope) 
+        (csys:handle-action msg scope :actions (environ:actions))
       (util:lgi nmsg)
       (actor:send (core:mailbox (tc:receiver t:*test-suite*)) nmsg))))
 
@@ -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)
-  (: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)))))