diff --git a/csys/program/basic.lisp b/csys/program/basic.lisp index 464c411..e47ebdb 100644 --- a/csys/program/basic.lisp +++ b/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 - :eff-contacts '(:e01 (#(1 0) #(1 1))))) + (let* ((ops (list :inhibit (csys:divide -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 () - (let ((val-action (csys:value-add :bias 2 :limits '(0)))) +(defun prog-b1 (cfg) + (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)) - '(:s01 :basic) (csys:std-proc :next (b1-next-one)) + (list '(:s01 :initial) (csys:std-proc :next (b1-next-zero std eff)) + '(: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 () - (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 1) :value 2 - :connect :succ :op (csys:multiply -1)) - (csys:send-create self :cat :s01 :loc #(0 1) :stage :basic) - (csys:send-switch self :active) - nil))) +(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 bias :connect :succ) + (csys:send-create self :cat :e01 :loc #(1 1) :value bias + :connect :succ :op op-inhibit) + (csys:send-create self :cat :s01 :loc #(0 1) :stage :basic) + (csys:send-switch self :active) + nil)))) -(defun b1-next-one () - (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 1))) - (csys:send-switch self :active) - nil))) +(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 op-inhibit) + (environ:send-connect self '(:e01 #(1 1))) + (csys:send-switch self :active) + nil)))) ;;;; basic-2: three-layer recursive system - "delayed distinction" (defun config-b2 () - (list (prog-b2) :zero-cat :c02 :zero-val 2 - :eff-contacts '(:e02 (#(2 0) #(2 1))))) + (let* ((ops (list :inhibit (csys:divide -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 () - (let ((val-action (csys:value-add :bias 2 :limits '(0)))) +(defun prog-b2 (cfg) + (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)) - '(:c02 :basic) (csys:std-proc :value val-action :next (b2-next-one)) + (list '(:c02 :initial) + (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))) diff --git a/test/test-csys.lisp b/test/test-csys.lisp index 141493c..d94592d 100644 --- a/test/test-csys.lisp +++ b/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 ()