cco/cl-scopes
3
0
Fork 0
Code Issues 1 Pull requests Releases Wiki Activity Actions

csys/program basic-2 basically working

Browse source
This commit is contained in:
Helmut Merz 2026-08-10 15:45:16 +02:00
parent 8775628705
commit bc6205b3ce
3 changed files with 20 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
csys/program/basic.lisp
View file

@ -5,6 +5,7 @@
(:local-nicknames (:actor :scopes/core/actor) (:local-nicknames (:actor :scopes/core/actor)
(:csys :scopes/csys) (:csys :scopes/csys)
(:environ :scopes/csys/environ) (:environ :scopes/csys/environ)
(:message :scopes/core/message)
(:util :scopes/util)) (:util :scopes/util))
(:export #:prog-b0 #:config-b1 #:config-b2)) (:export #:prog-b0 #:config-b1 #:config-b2))
@ -69,9 +70,9 @@
(defun prog-b2 () (defun prog-b2 ()
(let ((val-action (csys:value-add :bias 2))) (let ((val-action (csys:value-add :bias 2)))
(csys:make-program (csys:make-program
(list '(:c02 :initial) (csys-std-proc :value val-action :next (b2-next-zero)) (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)) '(:c02 :basic) (csys:std-proc :value val-action :next (b2-next-one))
'(:e01 :default) (csys:eff-proc) '(:e02 :default) (csys:eff-proc)
':default (csys:std-proc))))) ':default (csys:std-proc)))))
(defun b2-next-zero () (defun b2-next-zero ()
@ -81,8 +82,7 @@
(csys:send-create self :cat :c02 :loc "0-1" :value 2 :stage :basic) (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 :s02 :loc "1-0" :connect :pred)
(csys:send-create self :cat :e02 :loc "2-0" :connect :succ) (csys:send-create self :cat :e02 :loc "2-0" :connect :succ)
(environ:send-connect env :to self :target '(:csys :c02 "0-1") ;(environ:send-connect env :to self :target '(:csys :c02 "0-1") :op (csys:multiply -1))
:op (csys:multiply -1))
;; switch :active ;; switch :active
nil))) nil)))
@ -94,6 +94,9 @@
(csys:send-create self :cat :e02 :loc "2-1" :connect :succ) (csys:send-create self :cat :e02 :loc "2-1" :connect :succ)
(environ:send-connect env :to self :target '(:csys :c02 "0-0") (environ:send-connect env :to self :target '(:csys :c02 "0-0")
:op (csys:multiply -1)) :op (csys:multiply -1))
(actor:send env
(message:create '(:csys :connect :c02 "0-0")
:data (list :target '(:csys :c02 "0-1") :op (csys:multiply -1))))
;; switch :active ;; switch :active
nil))) nil)))

4
scratch.lisp
View file

@ -12,9 +12,9 @@
(add-package-local-nickname :environ :scopes/csys/environ) (add-package-local-nickname :environ :scopes/csys/environ)
(scopes/util/async:init) (scopes/util/async:init)
(setf environ:*env* (environ:simple-setup (basic:config-basic-1))) (setf environ:*env* (environ:simple-setup (basic:config-b2)))
;(environ:send-value '(:s00 "0-1") 2) ;(environ:send-value '(:s02 "1-0") 2)
;;;; iterator experiments - obsolete? ;;;; iterator experiments - obsolete?

11
test/test-csys.lisp
View file

@ -32,6 +32,7 @@
(config:add :test-receiver :setup #'tc:setup) (config:add :test-receiver :setup #'tc:setup)
(config:add-action '(:csys :effect :e00) (value-in '(1 2))) (config:add-action '(:csys :effect :e00) (value-in '(1 2)))
(config:add-action '(:csys :effect :e01) (value-in '(1 2 3 4))) (config:add-action '(:csys :effect :e01) (value-in '(1 2 3 4)))
(config:add-action '(:csys :effect :e02) (value-in '(1 2 3 4)))
;(config:add-action '(:csys :effect) #'tc:check-message) ;(config:add-action '(:csys :effect) #'tc:check-message)
(config:add-action '(:csys) (constantly nil))) (config:add-action '(:csys) (constantly nil)))
@ -50,6 +51,7 @@
(unwind-protect (unwind-protect
(test-basic-0) (test-basic-0)
(test-basic-1) (test-basic-1)
(test-basic-2)
(sleep 0.1) (sleep 0.1)
(tc:check-expected) (tc:check-expected)
(t:show-result)))) (t:show-result))))
@ -83,3 +85,12 @@
(environ:send-value '(:s01 "0-1") 2) (environ:send-value '(:s01 "0-1") 2)
(sleep 0.1) (sleep 0.1)
(core:shutdown))) (core:shutdown)))
(deftest test-basic-2 ()
(let ((environ:*env* (setup-test (basic:config-b2))))
(sleep 0.2)
(environ:send-value '(:s02 "1-0") 1)
(environ:send-value '(:s02 "1-1") 1) ;; 2 => loop
(sleep 0.1)
(core:shutdown)))