From 7f69cc051ae433aeaf8bb4179b95410d5e042e14 Mon Sep 17 00:00:00 2001 From: Helmut Merz Date: Sat, 12 Sep 2026 16:13:33 +0200 Subject: [PATCH] csys: parameterize program config; space:put: check if location already occpied --- csys/csys.lisp | 10 +++++----- csys/environ.lisp | 2 +- csys/program/basic.lisp | 16 +++++++++++----- csys/space.lisp | 9 +++++++-- scratch.lisp | 7 +++++-- test/test-csys.lisp | 2 +- 6 files changed, 30 insertions(+), 16 deletions(-) diff --git a/csys/csys.lisp b/csys/csys.lisp index 6610c5f..50497d9 100644 --- a/csys/csys.lisp +++ b/csys/csys.lisp @@ -14,7 +14,7 @@ #:neuron #:std-proc #:eff-proc #:handle-action #:basic-actions #:forward #:notify #:no-op #:printer #:value-add #:create #:connect - #:modify-value #:multiply #:divide + #:modify-value #:add #:multiply #:send-message #:send-create #:send-connect #:send-switch)) (in-package :scopes/csys) @@ -216,11 +216,11 @@ (setf (getf data :value) (apply fn (getf data :value 0) args)) (message:create (shape:head msg) :data data)))) -(defun multiply (n) - (modify-value #'* n)) +(defun add (n) + (modify-value #'+)) -(defun divide (n) - (modify-value #'floor n)) +(defun multiply (n) + (modify-value (lambda (val) (floor (* val n))))) ;;;; public shortcuts diff --git a/csys/environ.lisp b/csys/environ.lisp index 1e4f216..15deeb6 100644 --- a/csys/environ.lisp +++ b/csys/environ.lisp @@ -130,7 +130,7 @@ (space:put idx loc cell)))) (defun find-cell (reg addr &key no-warn) - (destructuring-bind (dom cat loc) addr + (destructuring-bind (dom cat &optional loc) addr (let* ((idx (getf reg dom)) (cell (space:fetch idx loc))) (unless (or no-warn cell) diff --git a/csys/program/basic.lisp b/csys/program/basic.lisp index f6f2f45..7fd4620 100644 --- a/csys/program/basic.lisp +++ b/csys/program/basic.lisp @@ -7,7 +7,7 @@ (:environ :scopes/csys/environ) (:message :scopes/core/message) (:util :scopes/util)) - (:export #:prog-b0 #:config-b1 #:config-b2)) + (:export #:prog-b0 #:config-b1 #:config-b2 #:config-b2a)) (in-package :scopes/csys/program/basic) @@ -32,7 +32,7 @@ ;;;; basic-1: minimal cross-linked system - "distinction" (defun config-b1 () - (let* ((ops (list :inhibit (csys:divide -1))) + (let* ((ops (list :inhibit (csys:multiply -1))) (std (list :bias 0 :cat :s01 :ops ops)) (eff (list :bias 2)) (cfg (list :std std :eff eff))) @@ -75,9 +75,9 @@ ;;;; basic-2: three-layer recursive system - "delayed distinction" -(defun config-b2 () - (let* ((ops (list :inhibit (csys:divide -1))) - (std (list :bias 2 :cat :c02 :ops ops)) +(defun config-b2 (&key (threshold 1) (bias 2) (op-inhibit (csys:multiply -1))) + (let* ((ops (list :inhibit op-inhibit)) + (std (list :threshold threshold :bias bias :cat :c02 :ops ops)) (cfg (list :std std))) (list (prog-b2 cfg) :std std :contacts '(:e02 (#(2 0) #(2 1)))))) @@ -117,3 +117,9 @@ (environ:send-connect '(:c02 #(0 0)) self :op op-inhibit) (csys:send-switch self :active) nil)))) + +;;;; basic-2 variations: basic-2 with changed params + +(defun config-b2a () + (config-b2 :threshold 4 :bias 7 :op-inhibit (csys:multiply -1/2))) + diff --git a/csys/space.lisp b/csys/space.lisp index 16663cb..134832f 100644 --- a/csys/space.lisp +++ b/csys/space.lisp @@ -3,7 +3,9 @@ (defpackage :scopes/csys/space (:use :common-lisp) - (:local-nicknames (:alx :alexandria)) + (:local-nicknames (:alx :alexandria) + (:util :scopes/util) + ) (:export #:create #:put #:fetch #:query)) (in-package :scopes/csys/space) @@ -12,7 +14,10 @@ (make-hash-table :test #'equalp)) (defun put (space key value) - (setf (gethash key space) value)) + (let ((current (gethash key space))) + (if current + (util:lgw "location already occupied" space key current value) + (setf (gethash key space) value)))) (defun fetch (space key) (gethash key space)) diff --git a/scratch.lisp b/scratch.lisp index 496f267..c2a4273 100644 --- a/scratch.lisp +++ b/scratch.lisp @@ -12,11 +12,14 @@ (add-package-local-nickname :environ :scopes/csys/environ) (add-package-local-nickname :message :scopes/core/message) (add-package-local-nickname :shape :scopes/shape) +(add-package-local-nickname :space :scopes/csys/space) (scopes/util/async:init) -(setf environ:*env* (environ:simple-setup (basic:config-b2))) -;(environ:send-value '(:s02 "1-0") 2) +;(setf environ:*env* (environ:simple-setup (basic:config-b2))) +(setf environ:*env* (environ:simple-setup (basic:config-b2a))) + +;(environ:send-value '(:s02 #(1 0)) 2) ;;;; iterator experiments - obsolete? diff --git a/test/test-csys.lisp b/test/test-csys.lisp index 8fea704..da6b189 100644 --- a/test/test-csys.lisp +++ b/test/test-csys.lisp @@ -82,7 +82,7 @@ (space:put idx #(1 1) 42) (space:put idx #(1 2) 46) (space:put idx #(1 1) 43) - (== (space:fetch idx #(1 1)) 43) + (== (space:fetch idx #(1 1)) 42) (== (space:fetch idx #(1 2)) 46) ))