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

csys, value-add action: + limits parameter

Browse source
This commit is contained in:
Helmut Merz 2026-08-19 16:13:18 +02:00
parent dc124a6eff
commit e6a802a939
5 changed files with 41 additions and 18 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
csys/csys.lisp
View file

@ -154,17 +154,20 @@
(setf (value scope) (shape:data-value msg :value))
(values msg scope)))
(defun value-add (&key (bias 0) (threshold 1))
(defun value-add (&key (bias 0) (threshold 1) limits)
(lambda (msg scope)
(let* ((val (getf (shape:data msg) :value))
(newval (+ val (value scope))))
(newval (+ val (value scope)))
(limit2 (cadr limits)))
;(util:lgi newval (length (syns scope)))
(when limit2 (setf newval (min newval limit2)))
(if (>= newval threshold)
(let* ((head (new-msg-head msg scope))
(msg (message:create head :data (list :value newval))))
(setf (value scope) bias)
(values msg scope))
(progn
(let ((limit1 (car limits)))
(when limit1 (setf newval (max newval limit1)))
(setf (value scope) newval)
(values nil scope))))))
@ -194,8 +197,8 @@
(values nil scope))))
(defun retire (msg scope)
;(environ:unregister *self*)
;(environ:remove-pred-syns *self*)
#+// (environ:unregister *self*)
#+// (environ:remove-pred-syns *self*)
(setf (stage scope) :retired)
(setf (syns scope) nil)
(setf (proc scope)

2
csys/environ.lisp
View file

@ -85,7 +85,7 @@
(defun forward (msg scope)
(let ((addr (message:addr msg)))
(if addr
(dolist (cell (find-cells (cells scope) (message:addr msg)))
(let ((cell (find-cell (cells scope) (message:addr msg))))
(actor:send cell msg))
(let ((rcvr (getf (shape:data msg) :to)))
(if rcvr

12
csys/program/basic.lisp
View file

@ -14,10 +14,11 @@
;;;; basic-0: minimal recursive system
(defun prog-b0 ()
(let ((val-action (csys:value-add :limits '(0))))
(csys:make-program
(list '(:c00 :initial) (csys:std-proc :next (b0-next-zero))
(list '(:c00 :initial) (csys:std-proc :value val-action :next (b0-next-zero))
'(:e00 :initial) (csys:eff-proc)
':default (csys:std-proc))))
':default (csys:std-proc)))))
(defun b0-next-zero ()
(lambda (msg scope)
@ -35,11 +36,12 @@
:eff-contacts '(:e01 ("1-0" "1-1"))))
(defun prog-b1 ()
(let ((val-action (csys:value-add :bias 2 :limits '(0))))
(csys:make-program
(list '(:s01 :initial) (csys:std-proc :next (b1-next-zero))
'(:s01 :basic) (csys:std-proc :next (b1-next-one))
'(:e01 :default) (csys:eff-proc :value (csys:value-add :bias 2))
':default (csys:std-proc))))
'(:e01 :default) (csys:eff-proc :value val-action)
':default (csys:std-proc)))))
(defun b1-next-zero ()
(lambda (msg scope)
@ -67,7 +69,7 @@
:eff-contacts '(:e02 ("2-0" "2-1"))))
(defun prog-b2 ()
(let ((val-action (csys:value-add :bias 2)))
(let ((val-action (csys:value-add :bias 2 :limits '(0))))
(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))

18
space/space.lisp Normal file
View file

@ -0,0 +1,18 @@
;;;; cl-scopes/space
;;;; definitions for spatial registering and retrieving objects by location
(defpackage :scopes/space
(:use :common-lisp)
(:local-nicknames (:alx :alexandria))
(:export #:create #:put #:query))
(in-package :scopes/space)
(defclass index ()
((data :reader data :initform (make-hash-table :test #'equal))))
(defun create ()
(make-instance 'index))

4
test/test-csys.lisp
View file

@ -90,7 +90,7 @@
(deftest test-basic-2 ()
(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
(environ:send-value '(:s02 "1-1") 2) (sleep 0.0001)
(environ:send-value '(:s02 "1-0") 2)
(teardown)))