diff --git a/csys/environ.lisp b/csys/environ.lisp index 225c679..1d23edc 100644 --- a/csys/environ.lisp +++ b/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))) diff --git a/csys/program/gene.lisp b/csys/program/gene.lisp new file mode 100644 index 0000000..f0895ca --- /dev/null +++ b/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))))) + + + diff --git a/scopes-csys.asd b/scopes-csys.asd index cb4c3a7..2b9c258 100644 --- a/scopes-csys.asd +++ b/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")))) diff --git a/test/test-csys.lisp b/test/test-csys.lisp index 86cfc47..193890e 100644 --- a/test/test-csys.lisp +++ b/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))) +