csys: basic set-up of neurons and synapses with action handling

core/actor.lisp

@@ -60,7 +60,10 @@
 (defun ac-step (tsk bhv msg)
   (let ((*self* tsk))
     (handler-case (funcall bhv msg)
-      (error (error) (util:lg :error "behavior" msg error)))))
+      (error (err) 
+             ;(util:lg :error "behavior" msg err)
+             (invoke-debugger err))
+      )))
 
 ;;;; the core (classical, i.e. Hewitt) actor API
 

csys/csys.lisp

@@ -10,13 +10,33 @@
                     (:shape :scopes/shape)
                     (:util :scopes/util)
                     (:alx :alexandria))
-  (:export #:send #:*sensors* #:neuron 
-           #:nprint))
+  (:export #:environment #:*environment* #:actions #:set-action
+           #:send #:send-message #:*sensors* 
+           #:neuron #:synapse
+           #:logger))
 
 (in-package :scopes/csys)
 
+;;;; environment: common information, with list of generally available actions
+
+(defclass environment ()
+  ((actions :reader actions :initarg :actions :initform (make-hash-table))))
+
+(defvar *environment* (make-instance 'environment))
+
+(defun action (env key)
+  (gethash key (actions env)))
+
+(defun set-action (env key act)
+  (setf (gethash key (actions env)) act))
+
+;;;; sensors: automatically created actors (neuron), addressable via message head
+
 (defvar *sensors* (make-hash-table :test #'equal))
 
+(defun send-message (head data &key customer)
+  (send (message:create head :data data :customer customer)))
+
 (defun send (msg)
   (if (eq (shape:head-value msg :domain) :csys)
     (dolist (sn (find-create-sensors msg)) 
@@ -36,13 +56,29 @@
               (setf (gethash key *sensors*) tsks))
             (util:lgw "no action selected" msg))))))
 
-;;;; neurons (= behavior generators)
+;;;; neurons (= behavior generators) and synapses (connection generators)
 
-(defun neuron (proc &optional state syns env)
-  (lambda (msg) (funcall proc msg state syns env)))
+(defun neuron (proc &optional state syns (env *environment*))
+  (lambda (msg) 
+    (funcall proc msg state syns env)))
 
-;;;; predefined neuron processors
+(defun synapse (rcvr &optional (op #'identity))
+  (lambda (msg)
+    (actor:send rcvr (funcall op msg))))
 
-(defun nprint (msg state syns env)
+;;;; predefined neuron processors and helper / utility funtions
+
+(defun logger (msg state syns env)
   (util:lgi msg state)
-  (actor:become (neuron #'nprint (shape:data msg) syns env)))
+  (destructuring-bind (msg state syns) (handle-action msg state syns env)
+    (forward msg syns)
+    (actor:become (neuron #'logger (shape:data msg) syns env))))
+
+(defun forward (msg syns)
+  (dolist (s syns) 
+    (funcall s msg)))
+
+(defun handle-action (msg state syns env)
+  (let ((act (action env (shape:head-value msg :action))))
+    (or (and act (funcall act msg state syns env))
+        (list msg state syns))))

test/etc/config-csys.lisp

@@ -4,8 +4,7 @@
 
 (config:root)
 
-(config:add-action '(:csys :sensor :log) 
-                   (csys:neuron #'csys:nprint :testing))
+(config:add-action '(:csys :sensor :log) (csys:neuron #'csys:logger :testing))
 
 (config:add :logger  :class 'logging:config
             :loglevel (config:from-env :loglevel :info)

test/test-csys.lisp

@@ -33,9 +33,9 @@
 
 (deftest test-nodispatch ()
   (core:setup-services)
-  (csys:send (message:create '(:csys :add :log :s1) :data 1))
-  (csys:send (message:create '(:csys :add :log :s1) :data 3))
-  (csys:send (message:create '(:csys :sub :log :s2) :data 4))
-  (csys:send (message:create '(:csys :add :log :s2) :data 5))
+  (csys:send-message '(:csys :add :log :s1) 1)
+  (csys:send-message '(:csys :add :log :s1) 3)
+  (csys:send-message '(:csys :sub :log :s2) 4)
+  (csys:send-message '(:csys :add :log :s2) 5)
   (sleep 0.1)
 )