csys: + switch action, + make sure bias is set correctly

csys/csys.lisp

@@ -15,7 +15,7 @@
            #:handle-action #:basic-actions #:forward #:notify
            #:no-op #:printer #:value-add #:create #:connect
            #:multiply
-           #:send-message #:send-create #:send-connect))
+           #:send-message #:send-create #:send-connect #:send-switch))
 
 (in-package :scopes/csys)
 
@@ -141,6 +141,7 @@
   (list :value (value-add)
         :create (create)
         :connect (connect)
+        :switch (switch)
         :next (no-op :no-forward t)))
 
 (defun no-op (&key no-forward) 
@@ -156,6 +157,7 @@
   (lambda (msg scope)
     (let* ((val (getf (shape:data msg) :value))
            (newval (+ val (value scope))))
+      (util:lgi newval (length (syns scope)))
       (if (>= newval threshold)
         (let* ((head (new-msg-head msg scope))
                (msg (message:create head :data (list :value newval))))
@@ -182,6 +184,14 @@
             (cons (synapse (getf data :target) (getf data :op)) (syns scope)))
       (values nil scope))))
 
+(defun switch (&key (default :active))
+  (lambda (msg scope)
+    (let ((data (shape:data msg)))
+      (setf (stage scope) (getf data :stage default))
+      (set-proc scope)
+      (util:lgi (stage scope) (proc scope) (syns scope))
+      (values nil scope))))
+
 ;;;; synapse ops
 
 (defun multiply (n)
@@ -206,6 +216,11 @@
 (defun send-connect (cell target &key op (domain *domain*))
   (send-message cell (list domain :connect) (list :target target :op op)))
 
+(defun send-switch (cell stage &key (domain *domain*))
+  (send-message cell (list domain :switch) (list :stage stage)))
+
+;;;; some predefined special behaviours
+
 (defun printer ()
   (actor:create 
     (lambda (msg) 

csys/program/basic.lisp

@@ -25,7 +25,7 @@
       (csys:send-create self :cat :e00 :connect :succ)
       (csys:send-create self :cat :s00 :loc "0-1" :connect :pred)
       (csys:send-connect self self :op (csys:multiply -1))
-      ;(csys:send-switch self :active)
+      (csys:send-switch self :active)
       nil)))
  
 ;;;; basic-1: minimal cross-linked system
@@ -48,7 +48,7 @@
       (csys:send-create self :cat :e01 :loc "1-1" :value 2 
                         :connect :succ :op (csys:multiply -1))
       (csys:send-create self :cat :s01 :loc "0-1" :stage :basic)
-      ;; switch :active
+      (csys:send-switch self :active)
       nil)))
  
 (defun b1-next-one ()
@@ -57,7 +57,7 @@
           (environ:*env* (csys:environ scope)))
       (environ:send-connect self '(:e01 "1-0") :op (csys:multiply -1))
       (environ:send-connect self '(:e01 "1-1"))
-      ;; switch :active
+      (csys:send-switch self :active)
       nil)))
 
 ;;;; basic-2: three-layer recursive system
@@ -71,6 +71,7 @@
     (csys:make-program
       (list '(:c02 :initial) (csys:std-proc :value val-action :next (b2-next-zero))
             '(:c02 :basic) (csys:std-proc :value val-action :next (b2-next-one))
+            '(:c02 :default) (csys:std-proc :value val-action)
             '(:e02 :default) (csys:eff-proc)
             ':default (csys:std-proc)))))
 
@@ -80,7 +81,7 @@
       (csys:send-create self :cat :c02 :loc "0-1" :value 2 :stage :basic)
       (csys:send-create self :cat :s02 :loc "1-0" :connect :pred)
       (csys:send-create self :cat :e02 :loc "2-0" :connect :succ)
-      ;; switch :active
+      (csys:send-switch self :active)
       nil)))
  
 (defun b2-next-one ()
@@ -91,5 +92,5 @@
       (csys:send-create self :cat :e02 :loc "2-1" :connect :succ)
       (environ:send-connect self '(:c02 "0-0") :op (csys:multiply -1))
       (environ:send-connect '(:c02 "0-0") self :op (csys:multiply -1))
-      ;; switch :active
+      (csys:send-switch self :active)
       nil)))

test/test-csys.lisp

@@ -88,7 +88,7 @@
     (teardown)))
 
 (deftest test-basic-2 ()
-  (let ((environ:*env* (setup (basic:config-b2))))
+  (let ((environ:*env* (setup (basic:config-b2) :delay 0.03)))
     (environ:send-value '(:s02 "1-0") 1) (sleep 0.0001)
     (environ:send-value '(:s02 "1-1") 2) (sleep 0.0001) ;; 2 => loop
     (environ:send-value '(:s02 "1-0") 2) ;; stop loop