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

csys: simplify action definitions via *-proc with basic-actions as default

Browse source
This commit is contained in:
Helmut Merz 2026-08-05 07:52:41 +02:00
parent 69a9c425dd
commit 83f1bab7a8
3 changed files with 34 additions and 40 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

18
csys/csys.lisp
View file

@ -12,7 +12,8 @@
#:make-program #:create-zero #:make-program #:create-zero
#:neuron #:std-proc #:eff-proc #:neuron #:std-proc #:eff-proc
#:handle-action #:forward #:notify #:handle-action #:forward #:notify
#:basic-actions #:no-op #:value-add #:create #:connect #:basic-actions #:merge-actions
#:no-op #:value-add #:create #:connect
#:multiply #:multiply
#:send-create #:send-connect)) #:send-create #:send-connect))
@ -98,21 +99,26 @@
;;;; message handlers, proc steps ;;;; message handlers, proc steps
(defun std-proc (&key (default (remember)) actions) (defun merge-actions (&optional act+ (base (basic-actions)))
(util:plist-merge base act+))
(defun std-proc (&rest args &key actions &allow-other-keys)
(let ((actions (or actions (merge-actions args))))
(lambda (msg scope) (lambda (msg scope)
(util:mv-bind (nmsg (nscope scope)) (util:mv-bind (nmsg (nscope scope))
(handle-action msg scope :default default :actions actions) (handle-action msg scope :actions actions)
(when nmsg (forward nmsg (syns nscope))) (when nmsg (forward nmsg (syns nscope)))
(update nscope)))) (update nscope)))))
(defun eff-proc (&key actions) (defun eff-proc (&rest args &key actions &allow-other-keys)
(let ((actions (or actions (merge-actions args))))
(lambda (msg scope) (lambda (msg scope)
(util:mv-bind (nmsg (nscope scope)) (util:mv-bind (nmsg (nscope scope))
(handle-action msg scope :default (no-op) :actions actions) (handle-action msg scope :default (no-op) :actions actions)
(when nmsg (when nmsg
(setf (nth 1 (shape:head nmsg)) :effect) (setf (nth 1 (shape:head nmsg)) :effect)
(notify nmsg nscope)) (notify nmsg nscope))
(update nscope)))) (update nscope)))))
(defun handle-action (msg scope &key (default (no-op)) actions) (defun handle-action (msg scope &key (default (no-op)) actions)
(let* ((key (message:action msg)) (let* ((key (message:action msg))

32
csys/program.lisp
View file

@ -14,15 +14,11 @@
(defun basic-0 () (defun basic-0 ()
(csys:make-program (csys:make-program
(list '(:c00 :initial) (csys:std-proc :actions (b0-actions-zero-initial)) (list '(:c00 :initial) (csys:std-proc :next (b0-next-zero))
'(:e01 :initial) (csys:eff-proc :actions (csys:basic-actions)) '(:e01 :initial) (csys:eff-proc)
':default (csys:std-proc :actions (csys:basic-actions))))) ':default (csys:std-proc))))
(defun b0-actions-zero-initial () (defun b0-next-zero ()
(util:plist-merge (csys:basic-actions)
(list :next (b0-next-zero-initial))))
(defun b0-next-zero-initial ()
(lambda (msg scope) (lambda (msg scope)
(let ((self actor:*self*)) (let ((self actor:*self*))
(csys:send-create self :cat :e01 :connect :succ) (csys:send-create self :cat :e01 :connect :succ)
@ -35,16 +31,12 @@
(defun basic-1 () (defun basic-1 ()
(csys:make-program (csys:make-program
(list '(:s00 :initial) (csys:std-proc :actions (b1-zero-actions-initial)) (list '(:s00 :initial) (csys:std-proc :next (b1-next-zero))
'(:s00 :basic) (csys:std-proc :actions (b1-one-actions-basic)) '(:s00 :basic) (csys:std-proc :next (b1-next-one))
'(:e00 :default) (csys:eff-proc :actions (csys:basic-actions)) '(:e00 :default) (csys:eff-proc)
':default (csys:std-proc :actions (csys:basic-actions))))) ':default (csys:std-proc))))
(defun b1-zero-actions-initial () (defun b1-next-zero ()
(util:plist-merge (csys:basic-actions)
(list :next (b1-next-zero-initial))))
(defun b1-next-zero-initial ()
(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" :connect :succ)
@ -53,11 +45,7 @@
;; switch :active ;; switch :active
nil))) nil)))
(defun b1-one-actions-basic () (defun b1-next-one ()
(util:plist-merge (csys:basic-actions)
(list :next (b1-next-one-basic))))
(defun b1-next-one-basic ()
(lambda (msg scope) (lambda (msg scope)
(let ((self actor:*self*) (let ((self actor:*self*)
(env (csys:environ scope))) (env (csys:environ scope)))

4
test/test-csys.lisp
View file

@ -78,7 +78,7 @@
(deftest test-basic-1 () (deftest test-basic-1 ()
(let ((env (setup-test (program:basic-1) :zero-cat :s00))) (let ((env (setup-test (program:basic-1) :zero-cat :s00)))
(sleep 0.1) (sleep 0.1)
(environ:send-value env 1 :cat :s00 :loc "0-1") (environ:send-value env 1 :cat :s00 :loc "0-0")
;(environ:send-value env 2 :cat :s00 :loc "0-1") (environ:send-value env 2 :cat :s00 :loc "0-1")
(sleep 0.1) (sleep 0.1)
(core:shutdown))) (core:shutdown)))