From dd4956cd4f95c0c896c7f16e1546d9618b3e34da Mon Sep 17 00:00:00 2001 From: Helmut Merz Date: Fri, 14 Aug 2026 08:28:34 +0200 Subject: [PATCH] csys: + switch action, + make sure bias is set correctly --- csys/csys.lisp | 17 ++++++++++++++++- csys/program/basic.lisp | 11 ++++++----- test/test-csys.lisp | 2 +- 3 files changed, 23 insertions(+), 7 deletions(-) diff --git a/csys/csys.lisp b/csys/csys.lisp index 3b10283..c625613 100644 --- a/csys/csys.lisp +++ b/csys/csys.lisp @@ -15,7 +15,7 @@ #:handle-action #:basic-actions #:forward #:notify #:no-op #:printer #:value-add #:create #:connect #:multiply - #:send-message #:send-create #:send-connect)) + #:send-message #:send-create #:send-connect #:send-switch)) (in-package :scopes/csys) @@ -141,6 +141,7 @@ (list :value (value-add) :create (create) :connect (connect) + :switch (switch) :next (no-op :no-forward t))) (defun no-op (&key no-forward) @@ -156,6 +157,7 @@ (lambda (msg scope) (let* ((val (getf (shape:data msg) :value)) (newval (+ val (value scope)))) + (util:lgi newval (length (syns scope))) (if (>= newval threshold) (let* ((head (new-msg-head msg scope)) (msg (message:create head :data (list :value newval)))) @@ -182,6 +184,14 @@ (cons (synapse (getf data :target) (getf data :op)) (syns scope))) (values nil scope)))) +(defun switch (&key (default :active)) + (lambda (msg scope) + (let ((data (shape:data msg))) + (setf (stage scope) (getf data :stage default)) + (set-proc scope) + (util:lgi (stage scope) (proc scope) (syns scope)) + (values nil scope)))) + ;;;; synapse ops (defun multiply (n) @@ -206,6 +216,11 @@ (defun send-connect (cell target &key op (domain *domain*)) (send-message cell (list domain :connect) (list :target target :op op))) +(defun send-switch (cell stage &key (domain *domain*)) + (send-message cell (list domain :switch) (list :stage stage))) + +;;;; some predefined special behaviours + (defun printer () (actor:create (lambda (msg) diff --git a/csys/program/basic.lisp b/csys/program/basic.lisp index ae6b74f..8dbf742 100644 --- a/csys/program/basic.lisp +++ b/csys/program/basic.lisp @@ -25,7 +25,7 @@ (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)) - ;(csys:send-switch self :active) + (csys:send-switch self :active) nil))) ;;;; basic-1: minimal cross-linked system @@ -48,7 +48,7 @@ (csys:send-create self :cat :e01 :loc "1-1" :value 2 :connect :succ :op (csys:multiply -1)) (csys:send-create self :cat :s01 :loc "0-1" :stage :basic) - ;; switch :active + (csys:send-switch self :active) nil))) (defun b1-next-one () @@ -57,7 +57,7 @@ (environ:*env* (csys:environ scope))) (environ:send-connect self '(:e01 "1-0") :op (csys:multiply -1)) (environ:send-connect self '(:e01 "1-1")) - ;; switch :active + (csys:send-switch self :active) nil))) ;;;; basic-2: three-layer recursive system @@ -71,6 +71,7 @@ (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)) + '(:c02 :default) (csys:std-proc :value val-action) '(:e02 :default) (csys:eff-proc) ':default (csys:std-proc))))) @@ -80,7 +81,7 @@ (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) - ;; switch :active + (csys:send-switch self :active) nil))) (defun b2-next-one () @@ -91,5 +92,5 @@ (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)) - ;; switch :active + (csys:send-switch self :active) nil))) diff --git a/test/test-csys.lisp b/test/test-csys.lisp index d61af67..f75fdfa 100644 --- a/test/test-csys.lisp +++ b/test/test-csys.lisp @@ -88,7 +88,7 @@ (teardown))) (deftest test-basic-2 () - (let ((environ:*env* (setup (basic:config-b2)))) + (let ((environ:*env* (setup (basic:config-b2) :delay 0.03))) (environ:send-value '(:s02 "1-0") 1) (sleep 0.0001) (environ:send-value '(:s02 "1-1") 2) (sleep 0.0001) ;; 2 => loop (environ:send-value '(:s02 "1-0") 2) ;; stop loop