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

31
csys/program/basic.lisp
View file

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

4
test/test-csys.lisp
View file

@ -59,9 +59,9 @@
(defun setup (cfg &key (delay 0.02))
(setup-config)
(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))
(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-cat (getf std :cat :c00)))
(setf (tc:receiver t:*test-suite*) rcvr)