core/message.lisp

@@ -40,10 +40,8 @@
     (list (car head) (cadr head))))
 
 (defun addr (msg)
-  (let* ((head (shape:head msg)))
+  (let ((head (shape:head msg)))
-    (if (caddr head)
+    (cons (car head) (cddr head))))
-      (cons (car head) (cddr head))
-      nil)))
 
 (defun categ (msg)
   (let ((head (shape:head msg)))

csys/csys.lisp

@@ -70,9 +70,9 @@
           (util:lgw "proc not found" cat stg spec))
         proc))))
 
-(defun create-zero (prg env &key (categ '(:csys :c00)) (loc "0-0"))
+(defun create-zero (prg env &key (categ '(:csys :c00)) (name "0-0"))
   (let* ((domain (car categ))
-         (addr (list domain (cadr categ) loc))
+         (addr (list domain (cadr categ) name))
          (msg (message:create (list domain :create) :data (list :addr addr)))
          (scope (scope prg env :categ categ))
          (zero (neuron scope)))
@@ -183,12 +183,11 @@
 
 ;;;; public shortcuts
 
-(defun send-create (cell &rest args &key (domain :csys) 
+(defun send-create (cell &rest args &key (domain :csys) (cat :c00) name connect op)
-                         (cat :c00) loc connect op &allow-other-keys)
+  (let ((args+ (if name 
-  (let ((args+ (if loc 
+                 `(:addr ,(list domain cat name))
-                 `(:addr ,(list domain cat loc))
                  `(:categ ,(list domain cat)))))
-    (setf args (alx:remove-from-plist args :domain :cat :loc))
+    (setf args (alx:remove-from-plist args :domain :cat :name))
     (actor:send cell 
       (message:create (list domain :create) :data (append args+ args)))))
 

csys/environ.lisp

@@ -10,7 +10,7 @@
                     (:util :scopes/util))
   (:export #:create
            #:actions
-           #:send-value #:send-connect))
+           #:send-value))
 
 (in-package :scopes/csys/environ)
 
@@ -28,7 +28,6 @@
         :notify (csys:no-op)
         :effect (csys:no-op)
         :value #'forward
-        :connect #'forward-connect
         :default (csys:no-op :no-forward t)))
 
 (defun cell-created (msg scope)
@@ -43,31 +42,15 @@
     nil))
 
 (defun forward (msg scope)
-  (let ((addr (message:addr msg))) 
+  (dolist (cell (find-cells (cells scope) (message:addr msg))) 
-    (if addr 
+    (actor:send cell msg))
-      (dolist (cell (find-cells (cells scope) (message:addr msg))) 
-        (actor:send cell msg))
-      (let ((rcvr (getf (shape:data msg) :to)))
-        (if rcvr
-          (actor:send rcvr msg)
-          (util:lgw "no addr and no :to field in message" msg scope)))))
   nil)
 
-(defun forward-connect (msg scope)
-  (let* ((data (shape:data msg))
-         (tgt (car (find-cells (cells scope) (getf data :target)))))
-    (setf (getf data :target) tgt)
-    (forward (message:create (shape:head msg) :data data) scope)))
-
 ;;;; public shortcuts
 
-(defun send-value (env val &key (domain :csys) (cat :c00) (loc ""))
+(defun send-value (env val &key (domain :csys) (cat :c00) (name ""))
-  (let ((head (list domain :value cat loc)))
+  (let ((head (list domain :value cat name)))
    (actor:send env (message:create head :data `(:value ,val)))))
-
-(defun send-connect (env &rest args &key (domain :csys) addr to target op)
-  (let ((head (list domain :connect))) 
-    (actor:send env (message:create head :data args))))
  
 ;;;; internal helpers
 
@@ -82,9 +65,7 @@
 
 (defun find-cells (reg addr)
   (destructuring-bind (dom cat &optional (key "")) addr
-    (let* ((idx (gethash (list dom cat) reg))
+    (let ((idx (gethash (list dom cat) reg)))
-           (cells (when idx (index:query idx key))))
+      (when idx
-      (unless cells
+        (index:query idx key)))))
-        (util:lgw "not found" addr reg idx))
-      cells)))
  

csys/program.lisp

@@ -1,68 +0,0 @@
-;;;; cl-scopes/csys/program - common and general csys program definitions
-
-(defpackage :scopes/csys/program
-  (:use :common-lisp)
-  (:local-nicknames (:actor :scopes/core/actor)
-                    (:csys :scopes/csys)
-                    (:environ :scopes/csys/environ)
-                    (:util :scopes/util))
-  (:export #:basic-0 #:basic-1))
-
-(in-package :scopes/csys/program)
-
-;;;; basic-0: minimal recursive system
-
-(defun basic-0 ()
-  (csys:make-program
-    (list '(:c00 :initial) (csys:std-proc :actions (b0-actions-zero-initial))
-          '(:e01 :initial) (csys:eff-proc :actions (csys:basic-actions))
-          ':default (csys:std-proc :actions (csys:basic-actions)))))
-
-(defun b0-actions-zero-initial () 
-  (util:plist-merge (csys:basic-actions) 
-                    (list :next (b0-next-zero-initial))))
-
-(defun b0-next-zero-initial ()
-  (lambda (msg scope) 
-    (let ((self actor:*self*))
-      (csys:send-create self :cat :e01 :connect :succ)
-      (csys:send-create self :cat :s01 :loc "0-1" :connect :pred)
-      (csys:send-connect self self :op (csys:multiply -1))
-      ;; switch :active
-      nil)))
- 
-;;;; basic-1: minimal cross-linked system
-
-(defun basic-1 ()
-  (csys:make-program
-    (list '(:s00 :initial) (csys:std-proc :actions (b1-zero-actions-initial))
-          '(:s00 :basic) (csys:std-proc :actions (b1-one-actions-basic))
-          '(:e00 :default) (csys:eff-proc :actions (csys:basic-actions))
-          ':default (csys:std-proc :actions (csys:basic-actions)))))
-
-(defun b1-zero-actions-initial ()
-  (util:plist-merge (csys:basic-actions) 
-                    (list :next (b1-next-zero-initial))))
-
-(defun b1-next-zero-initial ()
-  (lambda (msg scope) 
-    (let ((self actor:*self*))
-      (csys:send-create self :cat :e00 :loc "1-0" :connect :succ)
-      (csys:send-create self :cat :e00 :loc "1-1" :connect :succ :op (csys:multiply -1))
-      (csys:send-create self :cat :s00 :stage :basic :loc "0-1")
-      ;; switch :active
-      nil)))
- 
-(defun b1-one-actions-basic ()
-  (util:plist-merge (csys:basic-actions) 
-                    (list :next (b1-next-one-basic))))
-
-(defun b1-next-one-basic ()
-  (lambda (msg scope) 
-    (let ((self actor:*self*)
-          (env (csys:environ scope)))
-      (environ:send-connect env :to self :target '(:csys :e00 "1-0") 
-                            :op (csys:multiply -1))
-      (environ:send-connect env :to self :target '(:csys :e00 "1-1"))
-      ;; switch :active
-      nil)))

scopes-csys.asd

@@ -10,9 +10,7 @@
   :description "Concurrent cybernetic communications systems."
   :depends-on (:scopes-core)
   :components  ((:file "csys/csys")
-                (:file "csys/environ" :depends-on ("csys/csys"))
+                (:file "csys/environ" :depends-on ("csys/csys")))
-                (:file "csys/program" :depends-on ("csys/csys" "csys/environ"))
-                )
   :long-description "scopes/csys: Concurrent cybernetic communication systems."
   :in-order-to  ((test-op (test-op "scopes-csys/test"))))
 

test/test-csys.lisp

@@ -11,7 +11,6 @@
                     (:environ :scopes/csys/environ)
                     (:logging :scopes/logging)
                     (:message :scopes/core/message)
-                    (:program :scopes/csys/program)
                     (:shape :scopes/shape)
                     (:util :scopes/util)
                     (:t :scopes/testing)
@@ -31,7 +30,6 @@
 (defun setup-config ()
   (config:add :test-receiver :setup #'tc:setup)
   (config:add-action '(:csys :effect :e01) (value-in '(1 2)))
-  (config:add-action '(:csys :effect :e00) (value-in '(1 2)))
   ;(config:add-action '(:csys :effect) #'tc:check-message)
   (config:add-action '(:csys) (constantly nil)))
 
@@ -49,36 +47,49 @@
     (async:init)
     (unwind-protect
       (test-basic-0)
-      (test-basic-1)
       (sleep 0.1)
       (tc:check-expected)
       (t:show-result))))
 
-(defun setup-test (prg &key (zero-cat :c00))
+(defun setup-test (prg)
   (setup-config)
   (core:setup-services)
-  (let* ((rcvr (core:find-service :test-receiver))
+  (let* ((recv (core:find-service :test-receiver))
          (env (environ:create #'proc-env t:*test-suite*)))
-    (setf (tc:receiver t:*test-suite*) rcvr)
+    (setf (tc:receiver t:*test-suite*) recv)
-    (csys:create-zero prg env :categ (list :csys zero-cat))
+    (csys:create-zero prg env)
     env))
 
+;;;; test-specific programs / actions 
+;;;; (move to scopes/csys/programs)
+
+(defun prog-b0 ()
+  (csys:make-program
+    (list '(:c00 :initial) (csys:std-proc :actions (actions-zero-initial))
+          '(:e01 :initial) (csys:eff-proc :actions (csys:basic-actions))
+          ':default (csys:std-proc :actions (csys:basic-actions)))))
+
+(defun actions-zero-initial () 
+  (util:plist-merge (csys:basic-actions) 
+                    (list :next (next-zero-initial))))
+
+(defun next-zero-initial ()
+  (lambda (msg scope) 
+    (let ((self actor:*self*))
+      (csys:send-create self :cat :e01 :connect :succ)
+      (csys:send-create self :cat :s01 :name "0-1" :connect :pred)
+      (csys:send-connect self self :op (csys:multiply -1))
+      ;; switch :active
+      nil)))
+ 
 ;;;; test definitions
  
 (deftest test-basic-0 ()
-  (let ((env (setup-test (program:basic-0))))
+  (let ((env (setup-test (prog-b0)))
-        ;(rcvr (tc:receiver t:*test-suite*))
+        (rcvr (tc:receiver t:*test-suite*)))
     (sleep 0.1)
     ;(tc:expect rcvr (message:create '(:csys :effect :e01) :data '(:value 1)))
-    (environ:send-value env 1 :cat :s01 :loc "0-1")
+    (environ:send-value env 1 :cat :s01 :name "0-1")
-    (environ:send-value env 2 :cat :s01 :loc "0-1")
+    (environ:send-value env 2 :cat :s01 :name "0-1")
-    (sleep 0.1)
-    (core:shutdown)))
-
-(deftest test-basic-1 ()
-  (let ((env (setup-test (program:basic-1) :zero-cat :s00)))
-    (sleep 0.1)
-    (environ:send-value env 1 :cat :s00 :loc "0-1")
-    ;(environ:send-value env 2 :cat :s00 :loc "0-1")
     (sleep 0.1)
     (core:shutdown)))