csys, work in progress: fully configurable programs

csys/program/basic.lisp

@@ -14,7 +14,7 @@
 ;;;; basic-0: minimal recursive system - "self-inhibit"
 
 (defun prog-b0 ()
-  (let ((val-action (csys:value-add :limits '(0)))) 
+  (let ((val-action (csys:value-add))) 
     (csys:make-program
       (list '(:c00 :initial) (csys:std-proc :value val-action :next (b0-next-zero))
             '(:e00 :initial) (csys:eff-proc)
@@ -32,52 +32,68 @@
 ;;;; basic-1: minimal cross-linked system - "distinction"
 
 (defun config-b1 ()
-  (list (prog-b1) :zero-cat :s01
+  (let* ((ops (list :inhibit (csys:divide -1)))
-        :eff-contacts '(:e01 (#(1 0) #(1 1)))))
+         (std (list :bias 0 :cat :s01 :ops ops))
+         (eff (list :bias 2))
+         (cfg (list :std std :eff eff)))
+    (list (prog-b1 cfg) :std std
+          :eff-contacts '(:e01 (#(1 0) #(1 1))))))
 
-(defun prog-b1 ()
+(defun prog-b1 (cfg)
-  (let ((val-action (csys:value-add :bias 2 :limits '(0)))) 
+  (let* ((std (getf cfg :std))
+         (eff (getf cfg :eff))
+         (bias (getf eff :bias 0))
+         (val-action (csys:value-add :bias bias))) 
     (csys:make-program
-      (list '(:s01 :initial) (csys:std-proc :next (b1-next-zero))
+      (list '(:s01 :initial) (csys:std-proc :next (b1-next-zero std eff))
-            '(:s01 :basic) (csys:std-proc :next (b1-next-one))
+            '(:s01 :basic) (csys:std-proc :next (b1-next-one std))
             '(:e01 :default) (csys:eff-proc :value val-action)
             ':default (csys:std-proc)))))
 
-(defun b1-next-zero ()
+(defun b1-next-zero (std eff)
+  (let ((bias (getf eff :bias 0))
+        (op-inhibit (getf (getf std :ops) :inhibit)))
     (lambda (msg scope) 
       (let ((self actor:*self*))
-      (csys:send-create self :cat :e01 :loc #(1 0) :value 2 :connect :succ)
+        (csys:send-create self :cat :e01 :loc #(1 0) :value bias :connect :succ)
-      (csys:send-create self :cat :e01 :loc #(1 1) :value 2 
+        (csys:send-create self :cat :e01 :loc #(1 1) :value bias 
-                        :connect :succ :op (csys:multiply -1))
+                          :connect :succ :op op-inhibit)
         (csys:send-create self :cat :s01 :loc #(0 1) :stage :basic)
         (csys:send-switch self :active)
-      nil)))
+        nil))))
  
-(defun b1-next-one ()
+(defun b1-next-one (std)
+  (let ((op-inhibit (getf (getf std :ops) :inhibit))) 
     (lambda (msg scope) 
       (let ((self actor:*self*)
             (environ:*env* (csys:environ scope)))
-      (environ:send-connect self '(:e01 #(1 0)) :op (csys:multiply -1))
+        (environ:send-connect self '(:e01 #(1 0)) :op op-inhibit)
         (environ:send-connect self '(:e01 #(1 1)))
         (csys:send-switch self :active)
-      nil)))
+        nil))))
 
 ;;;; basic-2: three-layer recursive system - "delayed distinction"
 
 (defun config-b2 ()
-  (list (prog-b2) :zero-cat :c02 :zero-val 2
+  (let* ((ops (list :inhibit (csys:divide -1)))
-        :eff-contacts '(:e02 (#(2 0) #(2 1)))))
+         (std (list :bias 2 :cat :c02 :ops ops))
+         (cfg (list :std std))) 
+    (list (prog-b2 cfg) :std std
+          :eff-contacts '(:e02 (#(2 0) #(2 1))))))
 
-(defun prog-b2 ()
+(defun prog-b2 (cfg)
-  (let ((val-action (csys:value-add :bias 2 :limits '(0)))) 
+  (let* ((std (getf cfg :std))
+         (val-action (csys:value-add :bias 2))) 
     (csys:make-program
-      (list '(:c02 :initial) (csys:std-proc :value val-action :next (b2-next-zero))
+      (list '(:c02 :initial) 
-            '(:c02 :basic) (csys:std-proc :value val-action :next (b2-next-one))
+              (csys:std-proc :value val-action :next (b2-next-zero cfg))
+            '(:c02 :basic) 
+              (csys:std-proc :value val-action :next (b2-next-one cfg))
             '(:c02 :default) (csys:std-proc :value val-action)
             '(:e02 :default) (csys:eff-proc)
             ':default (csys:std-proc)))))
 
-(defun b2-next-zero ()
+(defun b2-next-zero (cfg)
   (lambda (msg scope) 
     (let ((self actor:*self*))
       (csys:send-create self :cat :c02 :loc #(0 1) :value 2 :stage :basic)
@@ -86,7 +102,7 @@
       (csys:send-switch self :active)
       nil)))
  
-(defun b2-next-one ()
+(defun b2-next-one (cfg)
   (lambda (msg scope) 
     (let ((self actor:*self*)
           (environ:*env* (csys:environ scope)))

test/test-csys.lisp

@@ -59,9 +59,11 @@
 (defun setup (cfg &key (delay 0.02))
   (setup-config)
   (core:setup-services)
-  (destructuring-bind (prg &key (zero-cat :c00) (zero-val 0) eff-contacts) cfg
+  (destructuring-bind (prg &key std eff-contacts) cfg
     (let ((rcvr (core:find-service :test-receiver))
-          (env (environ:create #'proc-env t:*test-suite* :eff-contacts eff-contacts)))
+          (env (environ:create #'proc-env t:*test-suite* :eff-contacts eff-contacts))
+          (zero-val (getf std :bias 0))
+          (zero-cat (getf std :cat :c00)))
       (setf (tc:receiver t:*test-suite*) rcvr)
       (csys:create-zero prg env :categ (list :csys zero-cat) :value zero-val)
       (sleep delay)
@@ -85,6 +87,7 @@
   (let ((environ:*env* (setup (basic:config-b1))))
     (environ:send-value '(:s01 #(0 0)) 1)
     (environ:send-value '(:s01 #(0 1)) 2)
+    ;(environ:send-value '(:s01 #(0 0)) 1)
     (teardown)))
 
 (deftest test-basic-2 ()