redefine environ:send-connect, analog to send-value, accepting neurons or addresses as paameters

csys/environ.lisp

@@ -95,17 +95,29 @@
 
 (defun forward-connect (msg scope)
   (let* ((data (shape:data msg))
-         (tgt (car (find-cells (cells scope) (getf data :target)))))
+         (tgt (getf data :target)))
-    (setf (getf data :target) tgt)
+    (when (listp tgt) 
+      (setf (getf data :target) (find-cell (cells scope) tgt)))
     (forward (message:create (shape:head msg) :data data) scope)))
 
 ;;;; public shortcuts
 
-(defun send-value (cat-loc val &key (domain csys:*domain*) (env *env*))
+(defun send-value (cat-loc val &key (domain csys:*domain*) (env *env*) delay)
   (let ((head (cons domain (cons :value cat-loc))))
     (actor:send env (message:create head :data `(:value ,val)))))
 
-(defun send-connect (env &rest args &key (domain csys:*domain*) addr to target op)
+(defun send-connect (rcvr target &key (domain csys:*domain*) (env *env*) op)
+  (let* ((cat-loc (when (listp rcvr) rcvr))
+         (head (cons domain (cons :connect cat-loc)))
+         (data (unless cat-loc (list :to rcvr))))
+    (when op (util:plist-add data :op op))
+    (when (and (listp target) (< (length target) 3)) 
+      (setf target (cons domain target)))
+    (util:plist-add data :target target)
+    (util:lgi rcvr target cat-loc head data)
+    (actor:send env (message:create head :data data))))
+
+(defun x-send-connect (env &rest args &key (domain csys:*domain*) to target op)
   (let ((head (list domain :connect))) 
     (actor:send env (message:create head :data args))))
  

csys/program/basic.lisp

@@ -54,10 +54,13 @@
 (defun b1-next-one ()
   (lambda (msg scope) 
     (let ((self actor:*self*)
+          (environ:*env* (csys:environ scope))
           (env (csys:environ scope)))
-      (environ:send-connect env :to self :target '(:csys :e01 "1-0") 
+      (environ:send-connect self '(:e01 "1-0") :op (csys:multiply -1))
-                            :op (csys:multiply -1))
+      ;(environ:send-connect env :to self :target '(:csys :e01 "1-0") 
-      (environ:send-connect env :to self :target '(:csys :e01 "1-1"))
+      ;                     :op (csys:multiply -1))
+      ;(environ:send-connect env :to self :target '(:csys :e01 "1-1"))
+      (environ:send-connect self '(:e01 "1-1"))
       ;; switch :active
       nil)))
 
@@ -77,26 +80,23 @@
 
 (defun b2-next-zero ()
   (lambda (msg scope) 
-    (let ((self actor:*self*)
+    (let ((self actor:*self*))
-          (env (csys:environ scope)))
       (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)
-      ;(environ:send-connect env :to self :target '(:csys :c02 "0-1") :op (csys:multiply -1))
       ;; switch :active
       nil)))
  
 (defun b2-next-one ()
   (lambda (msg scope) 
     (let ((self actor:*self*)
-          (env (csys:environ scope)))
+          (env (csys:environ scope))
+          (environ:*env* (csys:environ scope))
+          (zero '(:csys :c02 "0-0")))
       (csys:send-create self :cat :s02 :loc "1-1" :connect :pred)
       (csys:send-create self :cat :e02 :loc "2-1" :connect :succ)
-      (environ:send-connect env :to self :target '(:csys :c02 "0-0") 
+      (environ:send-connect self '(:c02 "0-0") :op (csys:multiply -1))
-                            :op (csys:multiply -1))
+      (environ:send-connect '(:c02 "0-0") self :op (csys:multiply -1))
-      (actor:send env 
-        (message:create '(:csys :connect :c02 "0-0") 
-                        :data (list :target '(:csys :c02 "0-1") :op (csys:multiply -1))))
       ;; switch :active
       nil)))
 

test/test-csys.lisp

@@ -52,7 +52,7 @@
       (test-basic-0)
       (test-basic-1)
       (test-basic-2)
-      (sleep 0.1)
+      (sleep 0.02)
       (tc:check-expected)
       (t:show-result))))
 
@@ -71,26 +71,29 @@
 (deftest test-basic-0 ()
   (let ((environ:*env* (setup-test (list (basic:prog-b0)))))
         ;(rcvr (tc:receiver t:*test-suite*))
-    (sleep 0.1)
+    (sleep 0.02)
     ;(tc:expect rcvr (message:create '(:csys :effect :e01) :data '(:value 1)))
     (environ:send-value '(:s00 "0-1") 1)
     (environ:send-value '(:s00 "0-1") 2)
-    (sleep 0.1)
+    (sleep 0.03)
     (core:shutdown)))
 
 (deftest test-basic-1 ()
   (let ((environ:*env* (setup-test (basic:config-b1))))
-    (sleep 0.1)
+    (sleep 0.02)
     (environ:send-value '(:s01 "0-0") 1)
     (environ:send-value '(:s01 "0-1") 2)
-    (sleep 0.1)
+    (sleep 0.03)
     (core:shutdown)))
 
 (deftest test-basic-2 ()
   (let ((environ:*env* (setup-test (basic:config-b2))))
-    (sleep 0.2)
+    (sleep 0.02)
     (environ:send-value '(:s02 "1-0") 1)
-    (environ:send-value '(:s02 "1-1") 1) ;; 2 => loop
+    (sleep 0.0001)
-    (sleep 0.1)
+    (environ:send-value '(:s02 "1-1") 2) ;; 2 => loop
+    (sleep 0.0001)
+    (environ:send-value '(:s02 "1-0") 2) ;; stop loop
+    (sleep 0.03)
     (core:shutdown)))