program/gene 0: improvements

csys/csys.lisp

@@ -160,7 +160,7 @@
     (let* ((val (getf (shape:data msg) :value))
            (newval (+ val (value scope)))
            (limit2 (cadr limits)))
-      ;(util:lgi newval (length (syns scope)))
+      ;(util:lgw "debug" bias threshold val newval (length (syns scope)) (categ scope))
       (when limit2 (setf newval (min newval limit2)))
       (if (>= newval threshold)
         (let* ((head (new-msg-head msg scope))

csys/environ.lisp

@@ -7,7 +7,8 @@
                     (:message :scopes/core/message)
                     (:shape :scopes/shape)
                     (:space :scopes/csys/space)
-                    (:util :scopes/util))
+                    (:util :scopes/util)
+                    (:alx :alexandria))
   (:export #:*env*
            #:create #:simple-setup #:simple-proc
            #:actions
@@ -76,7 +77,6 @@
         :default (csys:no-op :no-forward t)))
 
 (defun cell-created (msg scope)
-  ;(util:lgw "debug" msg scope)
   (let* ((data (shape:data msg))
          (addr (getf data :addr))
          (new (getf data :new)))
@@ -85,9 +85,8 @@
       (let* ((ct-addr (cons :env (cdr addr)))
              (ct (find-cell scope ct-addr :no-warn t)))
         (when ct (csys:send-connect new ct)))
-    (csys:send-message new (list (message:domain msg) :next) data)
+    (csys:send-message new (list (message:domain msg) :next) data))
-    msg))
+  msg)
-    ;nil))
 
 (defun forward (msg scope)
   (let ((rcvr (or (actor:customer msg) 
@@ -135,16 +134,14 @@
   (let ((head (cons domain (cons :value cat-loc))))
     (send-message head `(:value ,val) :env env)))
 
-(defun send-create (rcvr &key (domain csys:*domain*) (env *env*) cat connect op)
+(defun send-create (rcvr &rest args &key (domain csys:*domain*) 
-  (let ((head (list domain :create))
+                         (env *env*) &allow-other-keys)
-        data)
+  (let ((head (list domain :create)))
     (when (listp rcvr)
       (setf head (append head (cdr rcvr)))
       (setf rcvr nil))
-    (when cat (util:plist-add data :cat cat))
+    (setf args (alx:remove-from-plist args :domain :env))
-    (when connect (util:plist-add data :connect connect))
+    (send-message head args :customer rcvr :env env)))
-    (when op (util:plist-add data :op op))
-    (send-message head data :customer rcvr :env env)))
 
 (defun send-connect (rcvr target &key (domain csys:*domain*) (env *env*) op)
   (let* ((cat-loc (when (listp rcvr) rcvr))

csys/program/gene.lisp

@@ -19,7 +19,7 @@
          (eff (list :bias 2))
          (cfg (list :std std :eff eff)))
     (list (prog-g0 cfg) :std std
-          :contacts '(:e00 (#(1 0) #(1 1))))))
+          :contacts '(:e10 (#(1 0) #(1 1))))))
 
 (defun prog-g0 (cfg)
   (let* ((std (getf cfg :std))
@@ -29,6 +29,6 @@
          (val-action-e (csys:value-add :bias bias-e :threshold threshold-e))) 
     (csys:make-program
       (list '(:c00 :initial) (csys:std-proc)
-            '(:e00 :initial) (csys:eff-proc :value val-action-e)
+            '(:e10 :initial) (csys:eff-proc :value val-action-e)
             ':default (csys:std-proc)))))
 

test/test-csys.lisp

@@ -35,6 +35,7 @@
   (config:add-action '(:csys :effect :e00) (value-in '(1 2)))
   (config:add-action '(:csys :effect :e01) (value-in '(1 2 3 4)))
   (config:add-action '(:csys :effect :e02) (value-in '(1 2 3 4)))
+  ;(config:add-action '(:csys :effect :e10) (value-in '(1 2 3 4)))
   ;(config:add-action '(:csys :effect) #'tc:check-message)
   ;(config:add-action '(:csys) (constantly nil))
   (config:add-action '(:csys) #'tc:collect))
@@ -129,9 +130,13 @@
 (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 :e00 :connect :succ)
+    (environ:send-create '(:csys :c00 #(0 0)) :cat :e10 :connect :succ :value 2)
     (sleep 0.01)
     (environ:send-value '(:c00 #(0 0)) 2)
-    (sleep 0.01) (print (tc:collected rcvr))
+    ;(environ:send-value '(:c00 #(0 0)) 2)
+    (sleep 0.01) 
+    ;(print (tc:collected rcvr))
+    ;(tc:check-collected check-item-fn)
+    (== (length (tc:collected rcvr)) 3)
     (teardown)))