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)))
(defun printer ()
(actor:create (lambda (msg) (print msg))))
(actor:create
(lambda (msg)
(format t "~&~s~%" msg))))
;;;; internal helpers

2
csys/environ.lisp
View file

@ -20,7 +20,7 @@
(defclass scope (csys:scope)
((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))
(scope (csys:scope prg meta-env :cls 'scope :categ '(:env :c00)))
(env (csys:neuron scope)))

26
csys/program.lisp
View file

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

12
test/test-csys.lisp
View file

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