csys, work in progress: program basic-1

csys/environ.lisp

@@ -10,7 +10,7 @@
                     (:util :scopes/util))
   (:export #:create
            #:actions
-           #:send-value))
+           #:send-value #:send-connect))
 
 (in-package :scopes/csys/environ)
 
@@ -28,6 +28,7 @@
         :notify (csys:no-op)
         :effect (csys:no-op)
         :value #'forward
+        :connect #'forward
         :default (csys:no-op :no-forward t)))
 
 (defun cell-created (msg scope)
@@ -42,8 +43,14 @@
     nil))
 
 (defun forward (msg scope)
-  (dolist (cell (find-cells (cells scope) (message:addr msg))) 
+  (let ((addr (message:addr msg))) 
-    (actor:send cell msg))
+    (if addr 
+      (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)
 
 ;;;; public shortcuts
@@ -52,6 +59,10 @@
   (let ((head (list domain :value cat loc)))
    (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 args))))
+ 
 ;;;; internal helpers
 
 (defun register-cell (reg addr cell)

csys/program.lisp

@@ -4,8 +4,9 @@
   (:use :common-lisp)
   (:local-nicknames (:actor :scopes/core/actor)
                     (:csys :scopes/csys)
+                    (:environ :scopes/csys/environ)
                     (:util :scopes/util))
-  (:export #:basic-0))
+  (:export #:basic-0 #:basic-1))
 
 (in-package :scopes/csys/program)
 
@@ -13,15 +14,15 @@
 
 (defun basic-0 ()
   (csys:make-program
-    (list '(:c00 :initial) (csys:std-proc :actions (actions-zero-initial))
+    (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 actions-zero-initial () 
+(defun b0-actions-zero-initial () 
   (util:plist-merge (csys:basic-actions) 
-                    (list :next (next-zero-initial))))
+                    (list :next (b0-next-zero-initial))))
 
-(defun next-zero-initial ()
+(defun b0-next-zero-initial ()
   (lambda (msg scope) 
     (let ((self actor:*self*))
       (csys:send-create self :cat :e01 :connect :succ)
@@ -30,3 +31,38 @@
       ;; 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 (env 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)))

test/test-csys.lisp

@@ -52,20 +52,20 @@
       (tc:check-expected)
       (t:show-result))))
 
-(defun setup-test (prg)
+(defun setup-test (prg &key (zero-cat :c00))
   (setup-config)
   (core:setup-services)
-  (let* ((recv (core:find-service :test-receiver))
+  (let* ((rcvr (core:find-service :test-receiver))
          (env (environ:create #'proc-env t:*test-suite*)))
-    (setf (tc:receiver t:*test-suite*) recv)
+    (setf (tc:receiver t:*test-suite*) rcvr)
-    (csys:create-zero prg env)
+    (csys:create-zero prg env :categ (list :csys zero-cat))
     env))
 
 ;;;; test definitions
  
 (deftest test-basic-0 ()
-  (let ((env (setup-test (program:basic-0)))
+  (let ((env (setup-test (program:basic-0))))
-        (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")