csys: env: + proc register; provide special neuron processor for effectors

csys/csys.lisp

@@ -10,12 +10,12 @@
                     (:shape :scopes/shape)
                     (:util :scopes/util)
                     (:alx :alexandria))
-  (:export #:environment #:*environment* #:effectors
+  (:export #:environment #:*environment* #:procs
            #:init
            #:send #:send-message
            #:neuron #:synapse
            #:make-neuron #:update-neuron 
-           #:handle-action))
+           #:make-eff-proc #:handle-action))
 
 (in-package :scopes/csys)
 
@@ -25,15 +25,17 @@
   ((actions :reader actions :initarg :actions :initform (make-hash-table))
    (sensors :reader sensors :initarg :sensors 
             :initform (make-hash-table :test #'equal))
-   (effectors :reader effectors :initarg :effectors
-              :initform (make-hash-table :test #'equal))))
+   (procs :reader procs :initarg :procs
+          :initform (make-hash-table :test #'equal))))
 
 (defvar *environment* (make-instance 'environment))
 
-(defun init (zero)
+(defun init ()
   (setf (gethash :sensor (actions *environment*)) #'create-sensor)
-  (setf (gethash '(:init :zero) (sensors *environment*)) (list zero))
-  (setf (gethash :default (effectors *environment*)) (list zero)))
+  (setf (gethash :default (procs *environment*)) #'std-proc)
+  (let* ((eff-proc (gethash '(:effect :default) (procs *environment*) #'std-proc))
+         (zero (make-neuron nil :proc eff-proc))) 
+    (setf (gethash '(:init :zero) (sensors *environment*)) (list zero))))
 
 ;;;; sensors: neurons receiving messages from environment, addressable via message head
 
@@ -57,10 +59,6 @@
 (defun do-log (msg state syns env)
   (util:lgi msg))
 
-(defun find-effectors (key &optional (default-key :default) (env *environment*))
-  (let ((effs (effectors env)))
-    (gethash key effs (gethash default-key effs))))
-
 ;;;; neurons (= behavior factories) and synapses (connection factories)
 
 (defun neuron (proc &optional state syns (env *environment*))
@@ -71,9 +69,10 @@
   (lambda (msg)
     (actor:send rcvr (funcall op msg))))
 
-(defun make-neuron (syn-target &key (proc #'std-proc) state 
-                               (syn-op #'identity) (env *environment*))
-  (let ((syns (if syn-target (list (synapse syn-target syn-op)) nil)))
+(defun make-neuron (syn-target &key proc state 
+                                    (syn-op #'identity) (env *environment*))
+  (let ((proc (or proc (gethash :default (procs env) #'std-proc)))
+        (syns (if syn-target (list (synapse syn-target syn-op)) nil)))
     (actor:create (neuron proc state syns env))))
 
 (defun update-neuron (proc state syns &optional (env *environment*))
@@ -88,6 +87,12 @@
     (forward nmsg nsyns)
     (update-neuron #'std-proc nst nsyns env)))
 
+(defun make-eff-proc (handler)
+  (lambda (msg state syns env)
+    ;(util:lgi msg)
+    (funcall handler msg)
+    (handle-action msg state syns env :default #'remember)))
+
 (defun forward (msg syns)
   (dolist (s syns) 
     (funcall s msg)))

test/test-csys.lisp

@@ -23,15 +23,13 @@
 (defclass test-env (csys:environment)
   ((test-suite :reader test-suite :initarg :test-suite)))
 
-(defun probe (msg state syns env)
-  (let ((t:*test-suite* (test-suite env))
-        (val (shape:data msg)))
+(defun eff-handler (state &optional (env csys:*environment*))
+  (lambda (msg)
     (util:lgi msg state)
-    (destructuring-bind (msg state syns) 
-      (csys:handle-action msg state syns env)
+    (let ((t:*test-suite* (test-suite env))
+          (val (shape:data msg)))
       (unless (consp val)
-        (let ((nst (in-seq val state :remove t)))
-          (csys:update-neuron #'probe nst syns env))))))
+        (setf state (in-seq val state :remove t))))))
 
 (defun add (msg state syns env)
   (list msg (+ (shape:data msg) state) syns env))
@@ -41,21 +39,20 @@
 (defun run ()
   (async:init)
   (let* ((t:*test-suite* (make-instance 't:test-suite :name "csys"))
-         (csys:*environment* (make-instance 'test-env :test-suite t:*test-suite*))
-         (probe (csys:make-neuron nil :proc #'probe :state '(1 3 4 5)
-                                      :env csys:*environment*)))
+         (csys:*environment* (make-instance 'test-env :test-suite t:*test-suite*)))
     (load (t:test-path "config-csys" "etc"))
     (core:setup-services)
     (unwind-protect
       (progn
-        (test-init probe))
+        (test-init))
       (sleep 0.1)
       (async:finish)
       (t:show-result))))
 
-(deftest test-init (probe)
-  ;(setf (gethash '(:std :d0) (csys:effectors csys:*environment*)) probe)
-  (csys:init probe)
+(deftest test-init ()
+  (setf (gethash '(:effect :default) (csys:procs csys:*environment*)) 
+        (csys:make-eff-proc (eff-handler '(1 3 4 5))))
+  (csys:init)
   (csys:send-message '(:csys :sensor :init :zero) '(:std :s1))
   (csys:send-message '(:csys :sensor :init :zero) '(:std :s2))
   (sleep 0.1)