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

csys: program basic-1: set bias to 2; + scratch and helpers for interactive tests

Browse source
This commit is contained in:
Helmut Merz 2026-08-09 09:22:58 +02:00
parent b0488a8a1d
commit 94b35fcefd
4 changed files with 26 additions and 14 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
csys/csys.lisp
View file

@ -134,8 +134,8 @@
;;;; action handlers ;;;; action handlers
(defun basic-actions (&key (threshold 1)) (defun basic-actions ()
(list :value (value-add :threshold threshold) (list :value (value-add)
:create (create) :create (create)
:connect (connect) :connect (connect)
:next (no-op :no-forward t))) :next (no-op :no-forward t)))
@ -149,7 +149,7 @@
(setf (value scope) (shape:data-value msg :value)) (setf (value scope) (shape:data-value msg :value))
(values msg scope))) (values msg scope)))
(defun value-add (&key (bias 0) (threshold 0)) (defun value-add (&key (bias 0) (threshold 1))
(lambda (msg scope) (lambda (msg scope)
(let* ((val (getf (shape:data msg) :value)) (let* ((val (getf (shape:data msg) :value))
(newval (+ val (value scope)))) (newval (+ val (value scope))))

7
csys/program.lisp
View file

@ -37,14 +37,15 @@
(csys:make-program (csys:make-program
(list '(:s00 :initial) (csys:std-proc :next (b1-next-zero)) (list '(:s00 :initial) (csys:std-proc :next (b1-next-zero))
'(:s00 :basic) (csys:std-proc :next (b1-next-one)) '(:s00 :basic) (csys:std-proc :next (b1-next-one))
'(:e00 :default) (csys:eff-proc) '(:e00 :default) (csys:eff-proc :value (csys:value-add :bias 2))
':default (csys:std-proc)))) ':default (csys:std-proc))))
(defun b1-next-zero () (defun b1-next-zero ()
(lambda (msg scope) (lambda (msg scope)
(let ((self actor:*self*)) (let ((self actor:*self*))
(csys:send-create self :cat :e00 :loc "1-0" :connect :succ) (csys:send-create self :cat :e00 :loc "1-0" :value 2 :connect :succ)
(csys:send-create self :cat :e00 :loc "1-1" :connect :succ :op (csys:multiply -1)) (csys:send-create self :cat :e00 :loc "1-1" :value 2
:connect :succ :op (csys:multiply -1))
(csys:send-create self :cat :s00 :loc "0-1" :stage :basic) (csys:send-create self :cat :s00 :loc "0-1" :stage :basic)
;; switch :active ;; switch :active
nil))) nil)))

25
scratch.lisp
View file

@ -1,17 +1,28 @@
;;; cl-scopes/scratch - interactive testing ;;;; cl-scopes/scratch - interactive testing
(asdf:load-system :scopes) ;(asdf:load-system :scopes)
(asdf:load-system :scopes-csys)
(in-package :cl-user) ;(in-package :cl-user)
(use-package :trivial-package-local-nicknames) (use-package :trivial-package-local-nicknames)
;;; real scratch area ;;;; csys stuff
(add-package-local-nickname :environ :scopes/csys/environ)
(add-package-local-nickname :program :scopes/csys/program)
(scopes/util/async:init)
(setf environ:*env* (environ:simple-setup (program:config-basic-1)))
;(environ:send-value '(:s00 "0-1") 2)
;;;; iterator experiments - obsolete?
(defun make-iter () (defun make-iter ()
(let ((pointers (vector nil nil nil))) (let ((pointers (vector nil nil nil)))
#'(lambda (fn) (lambda (fn)
(funcall fn pointers)))) (funcall fn pointers))))
(defun iter-current (it) (defun iter-current (it)
(funcall it #'(lambda (p) (car (svref p 0))))) (funcall it (lambda (p) (car (svref p 0)))))

2
test/test-csys.lisp
View file

@ -31,7 +31,7 @@
(defun setup-config () (defun setup-config ()
(config:add :test-receiver :setup #'tc:setup) (config:add :test-receiver :setup #'tc:setup)
(config:add-action '(:csys :effect :e01) (value-in '(1 2))) (config:add-action '(:csys :effect :e01) (value-in '(1 2)))
(config:add-action '(:csys :effect :e00) (value-in '(1 2))) (config:add-action '(:csys :effect :e00) (value-in '(1 2 3 4)))
;(config:add-action '(:csys :effect) #'tc:check-message) ;(config:add-action '(:csys :effect) #'tc:check-message)
(config:add-action '(:csys) (constantly nil))) (config:add-action '(:csys) (constantly nil)))