csys: + gen-proc: generic neuron proc, handling composition of actions

csys/csys.lisp

@@ -11,7 +11,7 @@
   (:export #:*domain*
            #:scope #:environ
            #:make-program #:create-zero
-           #:neuron #:std-proc #:eff-proc
+           #:neuron #:gen-proc #:std-proc #:eff-proc
            #:handle-action #:basic-actions #:forward #:notify
            #:no-op #:printer #:value-add #:create #:connect
            #:modify-value #:add #:multiply
@@ -104,34 +104,41 @@
 
 (defun merge-actions (&optional act+ (base (basic-actions)))
   (util:plist-merge base act+))
+
+(defun gen-proc (actions &key default before after)
+  (lambda (msg scope)
+     (let* ((key (message:action msg))
+            (acts (getf actions key (getf actions :default default))))
+       (dolist (act (alx:flatten (cons before (cons acts (list after)))))
+         (when act 
+           (util:mv-bind (nmsg (nscope scope)) (funcall act msg scope)
+             (setf msg nmsg scope nscope)))))
+    (update scope)))
   
 (defun std-proc (&rest args &key actions &allow-other-keys)
   (let ((actions (or actions (merge-actions args))))
-    (lambda (msg scope) 
+    (gen-proc actions 
-      (util:mv-bind (nmsg (nscope scope)) 
+      :after (lambda (msg scope) (forward msg scope) msg))))
-          (handle-action msg scope :actions actions)
-        (when nmsg (forward nmsg (syns nscope)))
-        (update nscope)))))
 
 (defun eff-proc (&rest args &key actions &allow-other-keys)
   (let ((actions (or actions (merge-actions args))))
-    (lambda (msg scope) 
+    (flet ((forward-eff (msg scope)
-      (util:mv-bind (nmsg (nscope scope)) 
+            (when msg 
-          (handle-action msg scope :default (no-op) :actions actions)
+              (setf (nth 1 (shape:head msg)) :effect)
-        (when nmsg 
+              (forward msg scope)
-          (setf (nth 1 (shape:head nmsg)) :effect)
+              (unless (syns scope) (notify msg scope)))
-          (forward nmsg (syns nscope))
+            msg))
-          (unless (syns nscope) (notify nmsg nscope)))
+      (gen-proc actions :after #'forward-eff))))
-        (update nscope)))))
 
 (defun handle-action (msg scope &key (default (no-op)) actions)
   (let* ((key (message:action msg))
          (act (getf actions key (getf actions :default default))))
     (funcall act msg scope)))
 
-(defun forward (msg syns)
+(defun forward (msg scope)
-  (dolist (s syns) 
+  (when msg
-    (funcall s msg)))
+    (dolist (s (syns scope)) 
+      (funcall s msg))))
 
 (defun notify (msg scope)
   (setf (actor:customer msg) actor:*self*)

csys/environ.lisp

@@ -138,7 +138,7 @@
                          (env *env*) &allow-other-keys)
   (let ((head (list domain :create)))
     (when (listp rcvr)
-      (setf head (append head (cdr rcvr)))
+      (setf head (append head rcvr))
       (setf rcvr nil))
     (setf args (alx:remove-from-plist args :domain :env))
     (send-message head args :customer rcvr :env env)))

test/test-core.lisp

@@ -102,10 +102,14 @@
   (let ((pl '(:a 0)))
     (== (util:plist-add pl :b 1) '(:b 1 :a 0))
     (== pl '(:b 1 :a 0)))
-  (util:mv-bind (a (b :not-set) c) (values 42 2)
+  (let ((x 1) (b 99)) 
-    (== a 42)
+    (util:mv-bind (a (b :not-set) c) (values 42 2)
-    (== b 2)
+      (== a 42)
-    (== c nil))
+      (== b 2)
+      (== c nil)
+      (setf x a))
+    (== b 99)
+    (== x 42))
   (util:load-dotenv (t:test-path ".test.env"))
   (== (util:getenv "SCOPES_USER") "user-from-env-file")
   (== (util:getenv "SCOPES_PASSWORD") "very_secret"))

test/test-csys.lisp

@@ -130,7 +130,7 @@
 (deftest test-gene-0 ()
   (let ((environ:*env* (setup (gene:config-g0)))
         (rcvr (tc:receiver t:*test-suite*)))
-    (environ:send-create '(:csys :c00 #(0 0)) :cat :e10 :connect :succ :value 2)
+    (environ:send-create '(:c00 #(0 0)) :cat :e10 :connect :succ :value 2)
     (sleep 0.01)
     (environ:send-value '(:c00 #(0 0)) 2)
     ;(environ:send-value '(:c00 #(0 0)) 2)