From 513d9e7bb4df41cd20488d78d7ffca3469219366 Mon Sep 17 00:00:00 2001 From: Helmut Merz Date: Wed, 9 Sep 2026 18:58:47 +0200 Subject: [PATCH] csys: make programs configurable --- csys/environ.lisp | 16 +++++++------ csys/program/basic.lisp | 53 ++++++++++++++++++++++------------------- test/test-csys.lisp | 4 ++-- 3 files changed, 40 insertions(+), 33 deletions(-) diff --git a/csys/environ.lisp b/csys/environ.lisp index d79c761..e3195cb 100644 --- a/csys/environ.lisp +++ b/csys/environ.lisp @@ -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 diff --git a/csys/program/basic.lisp b/csys/program/basic.lisp index e47ebdb..f6f2f45 100644 --- a/csys/program/basic.lisp +++ b/csys/program/basic.lisp @@ -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) - (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 :s02 :loc #(1 0) :connect :pred) - (csys:send-create self :cat :e02 :loc #(2 0) :connect :succ) - (csys:send-switch self :active) - nil))) +(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 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)))) -(defun b2-next-one (cfg) - (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)) - (csys:send-switch self :active) - nil))) +(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 op-inhibit) + (environ:send-connect '(:c02 #(0 0)) self :op op-inhibit) + (csys:send-switch self :active) + nil)))) diff --git a/test/test-csys.lisp b/test/test-csys.lisp index d94592d..05bd32f 100644 --- a/test/test-csys.lisp +++ b/test/test-csys.lisp @@ -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)