csys/program/gene, work in progress: start with generic generative, genetic program

csys/environ.lisp

@@ -76,6 +76,7 @@
         :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)))
@@ -99,10 +100,12 @@
          (head (shape:head msg))
          (data (shape:data msg))
          (dom (car head))
+         (cat (getf data :cat))
          (spc (getf (spaces scope) dom)))
     (unless addr 
       (setf addr (gethash rcvr (cells scope))))
-    (util:plist-add data :loc (car (space:free-loc-at spc (caddr addr))))
+    ;(util:plist-add data :loc (car (space:free-loc-at spc (caddr addr))))
+    (util:plist-add data :addr (list dom cat (car (space:free-loc-at spc (caddr addr)))))
     (csys:send-message rcvr head data))
   nil)
 
@@ -118,7 +121,7 @@
       (forward (message:create head :data data :customer cust) scope)
       (let ((rcvrs (find-cells-near scope tgt)))
         (dolist (rcvr rcvrs)
-          (actor:send rcvr (message:create head :data data))))))
+          (csys:send-message rcvr head data)))))
   nil)
 
 ;;;; public shortcuts
@@ -130,8 +133,8 @@
   (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)
-  (let ((head (cons domain :create))
+(defun send-create (rcvr &key (domain csys:*domain*) (env *env*) cat connect op)
+  (let ((head (list domain :create))
         data)
     (when (listp rcvr)
       (setf head (append head (cdr rcvr)))

csys/program/gene.lisp

@@ -0,0 +1,24 @@
+;;;; cl-scopes/csys/program/gene - generative / genetic programs
+
+(defpackage :scopes/csys/program/gene
+  (:use :common-lisp)
+  (:local-nicknames (:actor :scopes/core/actor)
+                    (:csys :scopes/csys)
+                    (:environ :scopes/csys/environ)
+                    (:message :scopes/core/message)
+                    (:util :scopes/util))
+  (:export #:prog-g0))
+
+(in-package :scopes/csys/program/gene)
+
+;;;; gene-0: zero-only network for explicit messages and interactive testing
+
+(defun prog-g0 ()
+  (let ((val-action (csys:value-add))) 
+    (csys:make-program
+      (list '(:c00 :initial) (csys:std-proc :value val-action)
+            '(:e00 :initial) (csys:eff-proc)
+            ':default (csys:std-proc)))))
+
+
+

scopes-csys.asd

@@ -12,6 +12,7 @@
   :components  ((:file "csys/csys")
                 (:file "csys/environ" :depends-on ("csys/csys" "csys/space"))
                 (:file "csys/program/basic" :depends-on ("csys/csys" "csys/environ"))
+                (:file "csys/program/gene" :depends-on ("csys/csys" "csys/environ"))
                 (:file "csys/space"))
   :long-description "scopes/csys: Concurrent cybernetic communication systems."
   :in-order-to  ((test-op (test-op "scopes-csys/test"))))

test/test-csys.lisp

@@ -10,6 +10,7 @@
                     (:core :scopes/core)
                     (:csys :scopes/csys)
                     (:environ :scopes/csys/environ)
+                    (:gene :scopes/csys/program/gene)
                     (:logging :scopes/logging)
                     (:message :scopes/core/message)
                     (:shape :scopes/shape)
@@ -55,7 +56,8 @@
         (test-space)
         (test-basic-0)
         (test-basic-1)
-        (test-basic-2))
+        (test-basic-2)
+        (test-gene-0))
       (sleep 0.02)
       (tc:check-expected)
       (t:show-result))))
@@ -124,3 +126,10 @@
     (environ:send-value '(:s02 #(1 0)) 2)
     (teardown)))
 
+(deftest test-gene-0 ()
+  (let ((environ:*env* (setup (list (gene:prog-g0))))
+        (rcvr (tc:receiver t:*test-suite*)))
+    (environ:send-create '(:csys :c00 #(0 0)) :cat :e01 :connect :succ)
+    (sleep 0.01) (print (tc:collected rcvr))
+    (teardown)))
+