csys/program: basic-2: simple three-layer recursive system

csys/csys.lisp

@@ -73,11 +73,11 @@
           (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)) (loc "0-0") (value 0))
   (let* ((domain (car categ))
          (addr (list domain (cadr categ) loc))
          (msg (message:create (list domain :create) :data (list :addr addr)))
-         (scope (scope prg env :categ categ))
+         (scope (scope prg env :categ categ :value value))
          (zero (neuron scope)))
     (notify-created msg zero scope)))
  

csys/environ.lisp

@@ -28,7 +28,7 @@
     env))
 
 (defun simple-setup (cfg)
-  (destructuring-bind (prg &key (zero-cat :c00) eff-contacts) cfg
+  (destructuring-bind (prg &key (zero-cat :c00) (zero-val 0) eff-contacts) cfg
     (let ((env (create #'simple-proc (csys:printer) :eff-contacts eff-contacts)))
       (csys:create-zero prg env :categ (list csys:*domain* zero-cat))
       env)))

csys/program/basic.lisp

@@ -6,13 +6,13 @@
                     (:csys :scopes/csys)
                     (:environ :scopes/csys/environ)
                     (:util :scopes/util))
-  (:export #:basic-0 #:config-basic-1))
+  (:export #:prog-b0 #:config-b1 #:config-b2))
 
 (in-package :scopes/csys/program/basic)
 
 ;;;; basic-0: minimal recursive system
 
-(defun basic-0 ()
+(defun prog-b0 ()
   (csys:make-program
     (list '(:c00 :initial) (csys:std-proc :next (b0-next-zero))
           '(:e00 :initial) (csys:eff-proc)
@@ -29,11 +29,11 @@
  
 ;;;; basic-1: minimal cross-linked system
 
-(defun config-basic-1 ()
-  (list (basic-1) :zero-cat :s01
+(defun config-b1 ()
+  (list (prog-b1) :zero-cat :s01
         :eff-contacts '(:e01 ("1-0" "1-1"))))
 
-(defun basic-1 ()
+(defun prog-b1 ()
   (csys:make-program
     (list '(:s01 :initial) (csys:std-proc :next (b1-next-zero))
           '(:s01 :basic) (csys:std-proc :next (b1-next-one))
@@ -59,3 +59,42 @@
       (environ:send-connect env :to self :target '(:csys :e01 "1-1"))
       ;; switch :active
       nil)))
+
+;;;; basic-2: three-layer recursive system
+
+(defun config-b2 ()
+  (list (prog-b2) :zero-cat :c02 :zero-val 2
+        :eff-contacts '(:e02 ("2-0" "2-1"))))
+
+(defun prog-b2 ()
+  (let ((val-action (csys:value-add :bias 2))) 
+    (csys:make-program
+      (list '(:c02 :initial) (csys-std-proc :value val-action :next (b2-next-zero))
+            '(:c02 :basic) (csys:std-proc :value val-action :next (b2-next-one))
+            '(:e01 :default) (csys:eff-proc)
+            ':default (csys:std-proc)))))
+
+(defun b2-next-zero ()
+  (lambda (msg scope) 
+    (let ((self actor:*self*)
+          (env (csys:environ scope)))
+      (csys:send-create self :cat :c02 :loc "0-1" :value 2 :stage :basic)
+      (csys:send-create self :cat :s02 :loc "1-0" :connect :pred)
+      (csys:send-create self :cat :e02 :loc "2-0" :connect :succ)
+      (environ:send-connect env :to self :target '(:csys :c02 "0-1") 
+                            :op (csys:multiply -1))
+      ;; switch :active
+      nil)))
+ 
+(defun b2-next-one ()
+  (lambda (msg scope) 
+    (let ((self actor:*self*)
+          (env (csys:environ scope)))
+      (csys:send-create self :cat :s02 :loc "1-1" :connect :pred)
+      (csys:send-create self :cat :e02 :loc "2-1" :connect :succ)
+      (environ:send-connect env :to self :target '(:csys :c02 "0-0") 
+                            :op (csys:multiply -1))
+      ;; switch :active
+      nil)))
+
+

test/test-csys.lisp

@@ -12,7 +12,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)
@@ -58,17 +57,17 @@
 (defun setup-test (cfg)
   (setup-config)
   (core:setup-services)
-  (destructuring-bind (prg &key (zero-cat :c00) eff-contacts) cfg
+  (destructuring-bind (prg &key (zero-cat :c00) (zero-val 0) eff-contacts) cfg
     (let ((rcvr (core:find-service :test-receiver))
           (env (environ:create #'proc-env t:*test-suite* :eff-contacts eff-contacts)))
       (setf (tc:receiver t:*test-suite*) rcvr)
-      (csys:create-zero prg env :categ (list :csys zero-cat))
+      (csys:create-zero prg env :categ (list :csys zero-cat) :value zero-val)
       env)))
 
 ;;;; test definitions
  
 (deftest test-basic-0 ()
-  (let ((environ:*env* (setup-test (list (basic:basic-0)))))
+  (let ((environ:*env* (setup-test (list (basic:prog-b0)))))
         ;(rcvr (tc:receiver t:*test-suite*))
     (sleep 0.1)
     ;(tc:expect rcvr (message:create '(:csys :effect :e01) :data '(:value 1)))
@@ -78,7 +77,7 @@
     (core:shutdown)))
 
 (deftest test-basic-1 ()
-  (let ((environ:*env* (setup-test (basic:config-basic-1))))
+  (let ((environ:*env* (setup-test (basic:config-b1))))
     (sleep 0.1)
     (environ:send-value '(:s01 "0-0") 1)
     (environ:send-value '(:s01 "0-1") 2)