csys: use new gen-proc also in test and environ code

csys/csys.lisp

@@ -12,7 +12,7 @@
            #:scope #:environ
            #:make-program #:create-zero
            #:neuron #:gen-proc #:std-proc #:eff-proc
-           #:handle-action #:basic-actions #:forward #:notify
+           #:basic-actions #:forward #:notify
            #:no-op #:printer #:value-add #:create #:connect
            #:modify-value #:add #:multiply
            #:send-message #:send-create #:send-connect #:send-switch))
@@ -118,7 +118,7 @@
 (defun std-proc (&rest args &key actions &allow-other-keys)
   (let ((actions (or actions (merge-actions args))))
     (gen-proc actions 
-      :after (lambda (msg scope) (forward msg scope) msg))))
+      :after (lambda (msg scope) (forward msg scope)))))
 
 (defun eff-proc (&rest args &key actions &allow-other-keys)
   (let ((actions (or actions (merge-actions args))))
@@ -126,19 +126,14 @@
              (when msg 
                (setf (nth 1 (shape:head msg)) :effect)
                (forward msg scope)
-              (unless (syns scope) (notify msg scope)))
-            msg))
+               (unless (syns scope) (notify msg scope)))))
       (gen-proc actions :after #'forward-eff))))
 
-(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 scope)
   (when msg
     (dolist (s (syns scope)) 
-      (funcall s msg))))
+      (funcall s msg)))
+  msg)
 
 (defun notify (msg scope)
   (setf (actor:customer msg) actor:*self*)

csys/environ.lisp

@@ -32,18 +32,15 @@
 
 (defun simple-setup (cfg)
   (destructuring-bind (prg &key std contacts) cfg
-    (let* ((env (create #'simple-proc (csys:printer) :contacts contacts))
+    (let* ((env (create (simple-proc) (csys:printer) :contacts contacts))
            (zero-val (getf std :bias 0))
            (zero-cat (getf std :cat :c00)))
       (csys:create-zero prg env :categ (list csys:*domain* zero-cat) :value zero-val)
       env)))
 
 (defun simple-proc (msg scope)
-  (util:mv-bind (nmsg (scope scope)) 
-      (csys:handle-action msg scope :actions (actions))
-    (util:lgi msg nmsg)
-    (when nmsg
-      (actor:send (csys:environ scope) nmsg))))
+  (csys:gen-proc (actions) 
+    :after (lambda (msg scope) (actor:send (csys:environ scope) msg))))
 
 ;;;; eff contact cells
 

test/test-csys.lisp

@@ -41,12 +41,13 @@
   (config:add-action '(:csys) #'tc:collect))
 
 (defun proc-env (msg scope)
-  (let ((t:*test-suite* (csys:environ scope))) 
-    (util:mv-bind (nmsg (scope scope)) 
-        (csys:handle-action msg scope :actions (environ:actions))
-      (util:lgi msg nmsg)
-      (when nmsg
-        (actor:send (core:mailbox (tc:receiver t:*test-suite*)) nmsg)))))
+  (let* ((t:*test-suite* (csys:environ scope))
+         (proc 
+           (csys:gen-proc (environ:actions)
+             :after (lambda (msg scope) 
+               (when msg
+                 (actor:send (core:mailbox (tc:receiver t:*test-suite*)) msg)))))) 
+    (funcall proc msg scope)))
 
 (defun run ()
   (let ((t:*test-suite* (make-instance 'tc:test-suite :name "csys")))

util/util.lisp

@@ -99,7 +99,7 @@
   `(setf ,pl (cons ,k (cons ,v ,pl))))
 
 (defmacro mv-bind (vars vform &body body)
-  `(destructuring-bind ,(cons (car vars) (cons '&optional (cdr vars))) 
+  `(destructuring-bind ,(cons '&optional (cons (car vars) (cdr vars))) 
        (multiple-value-list ,vform) ,@body))
 
 (defun with-iterator (it fn)