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

csys: make programs configurable

Browse source
This commit is contained in:
Helmut Merz 2026-09-09 18:58:47 +02:00
parent 434bee0777
commit 513d9e7bb4
3 changed files with 40 additions and 33 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

16
csys/environ.lisp
View file

@ -20,18 +20,20 @@
(defclass scope (csys:scope) (defclass scope (csys:scope)
((spaces :reader spaces :initarg :spaces))) ((spaces :reader spaces :initarg :spaces)))
(defun create (proc meta-env &key eff-contacts (spaces '(:env :csys))) (defun create (proc meta-env &key contacts (spaces '(:env :csys)))
(let* ((prg (csys:make-program proc)) (let* ((prg (csys:make-program proc))
(spcs (loop for d in spaces append (list d (space:create)))) (spcs (loop for d in spaces append (list d (space:create))))
(scope (csys:scope prg meta-env :cls 'scope :categ '(:env :c00) :spaces spcs)) (scope (csys:scope prg meta-env :cls 'scope :categ '(:env :c00) :spaces spcs))
(env (csys:neuron scope))) (env (csys:neuron scope)))
(create-contact-cells eff-contacts env (spaces scope)) (create-contact-cells contacts env (spaces scope))
env)) env))
(defun simple-setup (cfg) (defun simple-setup (cfg)
(destructuring-bind (prg &key (zero-cat :c00) (zero-val 0) eff-contacts) cfg (destructuring-bind (prg &key std contacts) cfg
(let ((env (create #'simple-proc (csys:printer) :eff-contacts eff-contacts))) (let* ((env (create #'simple-proc (csys:printer) :contacts contacts))
(csys:create-zero prg env :categ (list csys:*domain* zero-cat)) (zero-val (getf std :bias 0))
(zero-cat (getf std :cat :c00)))
(csys:create-zero prg env :categ (list csys:*domain* zero-cat) :value zero-val)
env))) env)))
(defun simple-proc (msg scope) (defun simple-proc (msg scope)
@ -46,8 +48,8 @@
(defclass contact-scope (csys:scope) (defclass contact-scope (csys:scope)
((loc :reader loc :initarg :loc))) ((loc :reader loc :initarg :loc)))
(defun create-contact-cells (eff-contacts env cells) (defun create-contact-cells (contacts env cells)
(util:loop-plist eff-contacts cat locs do (util:loop-plist contacts cat locs do
(dolist (loc locs) (dolist (loc locs)
(let ((ct (csys:neuron (let ((ct (csys:neuron
(csys:scope (csys:make-program #'proc-contact) env (csys:scope (csys:make-program #'proc-contact) env

53
csys/program/basic.lisp
View file

@ -37,13 +37,14 @@
(eff (list :bias 2)) (eff (list :bias 2))
(cfg (list :std std :eff eff))) (cfg (list :std std :eff eff)))
(list (prog-b1 cfg) :std std (list (prog-b1 cfg) :std std
:eff-contacts '(:e01 (#(1 0) #(1 1)))))) :contacts '(:e01 (#(1 0) #(1 1))))))
(defun prog-b1 (cfg) (defun prog-b1 (cfg)
(let* ((std (getf cfg :std)) (let* ((std (getf cfg :std))
(eff (getf cfg :eff)) (eff (getf cfg :eff))
(bias (getf eff :bias 0)) (bias (getf eff :bias 0))
(val-action (csys:value-add :bias bias))) (threshold (getf std :threshold 1))
(val-action (csys:value-add :bias bias :threshold threshold)))
(csys:make-program (csys:make-program
(list '(:s01 :initial) (csys:std-proc :next (b1-next-zero std eff)) (list '(:s01 :initial) (csys:std-proc :next (b1-next-zero std eff))
'(:s01 :basic) (csys:std-proc :next (b1-next-one std)) '(:s01 :basic) (csys:std-proc :next (b1-next-one std))
@ -79,36 +80,40 @@
(std (list :bias 2 :cat :c02 :ops ops)) (std (list :bias 2 :cat :c02 :ops ops))
(cfg (list :std std))) (cfg (list :std std)))
(list (prog-b2 cfg) :std std (list (prog-b2 cfg) :std std
:eff-contacts '(:e02 (#(2 0) #(2 1)))))) :contacts '(:e02 (#(2 0) #(2 1))))))
(defun prog-b2 (cfg) (defun prog-b2 (cfg)
(let* ((std (getf cfg :std)) (let* ((std (getf cfg :std))
(val-action (csys:value-add :bias 2))) (bias (getf std :bias 0))
(threshold (getf std :threshold 1))
(val-action (csys:value-add :bias bias :threshold threshold)))
(csys:make-program (csys:make-program
(list '(:c02 :initial) (list '(:c02 :initial)
(csys:std-proc :value val-action :next (b2-next-zero cfg)) (csys:std-proc :value val-action :next (b2-next-zero std))
'(:c02 :basic) '(:c02 :basic)
(csys:std-proc :value val-action :next (b2-next-one cfg)) (csys:std-proc :value val-action :next (b2-next-one std))
'(:c02 :default) (csys:std-proc :value val-action) '(:c02 :default) (csys:std-proc :value val-action)
'(:e02 :default) (csys:eff-proc) '(:e02 :default) (csys:eff-proc)
':default (csys:std-proc))))) ':default (csys:std-proc)))))
(defun b2-next-zero (cfg) (defun b2-next-zero (std)
(lambda (msg scope) (let ((bias (getf std :bias 0)))
(let ((self actor:*self*)) (lambda (msg scope)
(csys:send-create self :cat :c02 :loc #(0 1) :value 2 :stage :basic) (let ((self actor:*self*))
(csys:send-create self :cat :s02 :loc #(1 0) :connect :pred) (csys:send-create self :cat :c02 :loc #(0 1) :value bias :stage :basic)
(csys:send-create self :cat :e02 :loc #(2 0) :connect :succ) (csys:send-create self :cat :s02 :loc #(1 0) :connect :pred)
(csys:send-switch self :active) (csys:send-create self :cat :e02 :loc #(2 0) :connect :succ)
nil))) (csys:send-switch self :active)
nil))))
(defun b2-next-one (cfg) (defun b2-next-one (std)
(lambda (msg scope) (let ((op-inhibit (getf (getf std :ops) :inhibit)))
(let ((self actor:*self*) (lambda (msg scope)
(environ:*env* (csys:environ scope))) (let ((self actor:*self*)
(csys:send-create self :cat :s02 :loc #(1 1) :connect :pred) (environ:*env* (csys:environ scope)))
(csys:send-create self :cat :e02 :loc #(2 1) :connect :succ) (csys:send-create self :cat :s02 :loc #(1 1) :connect :pred)
(environ:send-connect self '(:c02 #(0 0)) :op (csys:multiply -1)) (csys:send-create self :cat :e02 :loc #(2 1) :connect :succ)
(environ:send-connect '(:c02 #(0 0)) self :op (csys:multiply -1)) (environ:send-connect self '(:c02 #(0 0)) :op op-inhibit)
(csys:send-switch self :active) (environ:send-connect '(:c02 #(0 0)) self :op op-inhibit)
nil))) (csys:send-switch self :active)
nil))))

4
test/test-csys.lisp
View file

@ -59,9 +59,9 @@
(defun setup (cfg &key (delay 0.02)) (defun setup (cfg &key (delay 0.02))
(setup-config) (setup-config)
(core:setup-services) (core:setup-services)
(destructuring-bind (prg &key std eff-contacts) cfg (destructuring-bind (prg &key std contacts) cfg
(let ((rcvr (core:find-service :test-receiver)) (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* :contacts contacts))
(zero-val (getf std :bias 0)) (zero-val (getf std :bias 0))
(zero-cat (getf std :cat :c00))) (zero-cat (getf std :cat :c00)))
(setf (tc:receiver t:*test-suite*) rcvr) (setf (tc:receiver t:*test-suite*) rcvr)