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

csys/program, tests: consistent naming of categories in basic-0 and basic-1

Browse source
This commit is contained in:
Helmut Merz 2026-08-09 14:25:49 +02:00
parent 94b35fcefd
commit 0cca279545
4 changed files with 23 additions and 21 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
csys/csys.lisp
View file

@ -204,7 +204,9 @@
(send-message cell (list domain :connect) (list :target target :op op))) (send-message cell (list domain :connect) (list :target target :op op)))
(defun printer () (defun printer ()
(actor:create (lambda (msg) (print msg)))) (actor:create
(lambda (msg)
(format t "~&~s~%" msg))))
;;;; internal helpers ;;;; internal helpers

2
csys/environ.lisp
View file

@ -20,7 +20,7 @@
(defclass scope (csys:scope) (defclass scope (csys:scope)
((cells :reader cells :initform (make-hash-table :test #'equal)))) ((cells :reader cells :initform (make-hash-table :test #'equal))))
(defun create (proc meta-env &key eff-contacts) ; meta-env example: (csys:printer) (defun create (proc meta-env &key eff-contacts)
(let* ((prg (csys:make-program proc)) (let* ((prg (csys:make-program proc))
(scope (csys:scope prg meta-env :cls 'scope :categ '(:env :c00))) (scope (csys:scope prg meta-env :cls 'scope :categ '(:env :c00)))
(env (csys:neuron scope))) (env (csys:neuron scope)))

26
csys/program.lisp
View file

@ -15,14 +15,14 @@
(defun basic-0 () (defun basic-0 ()
(csys:make-program (csys:make-program
(list '(:c00 :initial) (csys:std-proc :next (b0-next-zero)) (list '(:c00 :initial) (csys:std-proc :next (b0-next-zero))
'(:e01 :initial) (csys:eff-proc) '(:e00 :initial) (csys:eff-proc)
':default (csys:std-proc)))) ':default (csys:std-proc))))
(defun b0-next-zero () (defun b0-next-zero ()
(lambda (msg scope) (lambda (msg scope)
(let ((self actor:*self*)) (let ((self actor:*self*))
(csys:send-create self :cat :e01 :connect :succ) (csys:send-create self :cat :e00 :connect :succ)
(csys:send-create self :cat :s01 :loc "0-1" :connect :pred) (csys:send-create self :cat :s00 :loc "0-1" :connect :pred)
(csys:send-connect self self :op (csys:multiply -1)) (csys:send-connect self self :op (csys:multiply -1))
;; switch :active ;; switch :active
nil))) nil)))
@ -30,23 +30,23 @@
;;;; basic-1: minimal cross-linked system ;;;; basic-1: minimal cross-linked system
(defun config-basic-1 () (defun config-basic-1 ()
(list (basic-1) :zero-cat :s00 (list (basic-1) :zero-cat :s01
:eff-contacts '(:e00 ("1-0" "1-1")))) :eff-contacts '(:e01 ("1-0" "1-1"))))
(defun basic-1 () (defun basic-1 ()
(csys:make-program (csys:make-program
(list '(:s00 :initial) (csys:std-proc :next (b1-next-zero)) (list '(:s01 :initial) (csys:std-proc :next (b1-next-zero))
'(:s00 :basic) (csys:std-proc :next (b1-next-one)) '(:s01 :basic) (csys:std-proc :next (b1-next-one))
'(:e00 :default) (csys:eff-proc :value (csys:value-add :bias 2)) '(:e01 :default) (csys:eff-proc :value (csys:value-add :bias 2))
':default (csys:std-proc)))) ':default (csys:std-proc))))
(defun b1-next-zero () (defun b1-next-zero ()
(lambda (msg scope) (lambda (msg scope)
(let ((self actor:*self*)) (let ((self actor:*self*))
(csys:send-create self :cat :e00 :loc "1-0" :value 2 :connect :succ) (csys:send-create self :cat :e01 :loc "1-0" :value 2 :connect :succ)
(csys:send-create self :cat :e00 :loc "1-1" :value 2 (csys:send-create self :cat :e01 :loc "1-1" :value 2
:connect :succ :op (csys:multiply -1)) :connect :succ :op (csys:multiply -1))
(csys:send-create self :cat :s00 :loc "0-1" :stage :basic) (csys:send-create self :cat :s01 :loc "0-1" :stage :basic)
;; switch :active ;; switch :active
nil))) nil)))
@ -54,8 +54,8 @@
(lambda (msg scope) (lambda (msg scope)
(let ((self actor:*self*) (let ((self actor:*self*)
(env (csys:environ scope))) (env (csys:environ scope)))
(environ:send-connect env :to self :target '(:csys :e00 "1-0") (environ:send-connect env :to self :target '(:csys :e01 "1-0")
:op (csys:multiply -1)) :op (csys:multiply -1))
(environ:send-connect env :to self :target '(:csys :e00 "1-1")) (environ:send-connect env :to self :target '(:csys :e01 "1-1"))
;; switch :active ;; switch :active
nil))) nil)))

12
test/test-csys.lisp
View file

@ -30,8 +30,8 @@
(defun setup-config () (defun setup-config ()
(config:add :test-receiver :setup #'tc:setup) (config:add :test-receiver :setup #'tc:setup)
(config:add-action '(:csys :effect :e01) (value-in '(1 2))) (config:add-action '(:csys :effect :e00) (value-in '(1 2)))
(config:add-action '(:csys :effect :e00) (value-in '(1 2 3 4))) (config:add-action '(:csys :effect :e01) (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)))
@ -71,15 +71,15 @@
;(rcvr (tc:receiver t:*test-suite*)) ;(rcvr (tc:receiver t:*test-suite*))
(sleep 0.1) (sleep 0.1)
;(tc:expect rcvr (message:create '(:csys :effect :e01) :data '(:value 1))) ;(tc:expect rcvr (message:create '(:csys :effect :e01) :data '(:value 1)))
(environ:send-value '(:s01 "0-1") 1) (environ:send-value '(:s00 "0-1") 1)
(environ:send-value '(:s01 "0-1") 2) (environ:send-value '(:s00 "0-1") 2)
(sleep 0.1) (sleep 0.1)
(core:shutdown))) (core:shutdown)))
(deftest test-basic-1 () (deftest test-basic-1 ()
(let ((environ:*env* (setup-test (program:config-basic-1)))) (let ((environ:*env* (setup-test (program:config-basic-1))))
(sleep 0.1) (sleep 0.1)
(environ:send-value '(:s00 "0-0") 1) (environ:send-value '(:s01 "0-0") 1)
(environ:send-value '(:s00 "0-1") 2) (environ:send-value '(:s01 "0-1") 2)
(sleep 0.1) (sleep 0.1)
(core:shutdown))) (core:shutdown)))