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

csys, work in progress: fully configurable programs

Browse source
This commit is contained in:
Helmut Merz 2026-09-09 16:08:27 +02:00
parent d4b032f156
commit 434bee0777
2 changed files with 53 additions and 34 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

62
csys/program/basic.lisp
View file

@ -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 ()
(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 1) :value 2
:connect :succ :op (csys:multiply -1))
(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)))
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
: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)))

7
test/test-csys.lisp
View file

@ -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 ()