csys:value-add as first real action handler (with parameters)

csys/csys.lisp

@@ -12,8 +12,8 @@
            #:make-program
            #:neuron #:std-proc #:eff-proc #:create-zero
            #:handle-action
-           #:no-op
+           #:notify
-           #:notify))
+           #:no-op #:value-add))
 
 (in-package :scopes/csys)
 
@@ -74,23 +74,25 @@
 (defun process (scope)
   (lambda (msg) (funcall (proc scope) msg scope)))
 
-(defun std-proc (msg scope &key (default (remember)) actions params)
+(defun std-proc (&key (default (remember)) actions)
+  (lambda (msg scope) 
     (util:mv-bind (nmsg (nscope scope)) 
-      (handle-action msg scope :default default :actions actions :params params)
+        (handle-action msg scope :default default :actions actions)
       (when nmsg (forward nmsg (syns nscope)))
-    (update nscope)))
+      (update nscope))))
 
-(defun eff-proc (msg scope &key params actions)
+(defun eff-proc (&key actions)
+  (lambda (msg scope) 
     (util:mv-bind (nmsg (nscope scope)) 
-      (handle-action msg scope :default (no-op) :actions actions :params params)
+        (handle-action msg scope :default (no-op) :actions actions)
       (setf (nth 1 (shape:head nmsg)) :effect)
       (when nmsg (notify nmsg nscope))
-    (update nscope)))
+      (update nscope))))
 
-(defun handle-action (msg scope &key (default (no-op)) actions params)
+(defun handle-action (msg scope &key (default (no-op)) actions)
   (let* ((key (message:action msg))
          (act (getf actions key (getf actions :default default))))
-    (apply act msg scope params)))
+    (funcall act msg scope)))
 
 (defun forward (msg syns)
   (dolist (s syns) 
@@ -116,7 +118,26 @@
     (setf (value scope) (shape:data-value msg :value))
     (values msg scope)))
 
+(defun value-add (&key (bias 0) (threshold 0))
+  (lambda (msg scope)
+    (let* ((val (getf (shape:data msg) :value))
+           (newval (+ val (value scope))))
+      (if (>= newval threshold)
+        (let* ((head (new-msg-head msg scope))
+               (msg (message:create head :data (list :value newval))))
+          (setf (value scope) bias)
+          (values msg scope))
+        (progn
+          (setf (value scope) newval)
+          (values nil scope))))))
+ 
 (defun create () 
   (lambda (msg scope)
     (let ((new (neuron (apply #'reset-scope scope (shape:data msg)))))
-      (notify-created msg new scope))))
+      (notify-created msg new scope)
+      nil)))
+
+;;;; helpers
+
+(defun new-msg-head (msg scope)
+  (list (message:domain msg) (message:action msg) (cadr (categ scope))))

test/test-csys.lisp

@@ -41,6 +41,9 @@
       (when nmsg
         (actor:send (core:mailbox (tc:receiver t:*test-suite*)) nmsg)))))
 
+(defun actions ()
+  (list :value (csys:value-add)))
+
 (defun run ()
   (let ((t:*test-suite* (make-instance 'tc:test-suite :name "csys")))
     (load (t:test-path "config-csys" "etc"))
@@ -63,11 +66,12 @@
     env))
 
 (deftest test-basic-0 ()
-  (let ((env (setup-test (csys:make-program #'csys:eff-proc)))
+  (let ((env (setup-test (csys:make-program (csys:eff-proc :actions (actions)))))
+        ;(env (setup-test (csys:make-program (csys:eff-proc))))
         ;(env (setup-test (test-program))
         (rcvr (tc:receiver t:*test-suite*)))
     (sleep 0.1)
-    (tc:expect rcvr (message:create '(:csys :effect :c00 "0-0") :data '(:value 1)))
+    (tc:expect rcvr (message:create '(:csys :effect :c00) :data '(:value 1)))
     (actor:send env (message:create '(:csys :value :c00 "0-0") :data '(:value 1)))
     (sleep 0.1)
     (core:shutdown)))