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

36
csys/csys.lisp
View file

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

32
csys/program.lisp
View file

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

4
test/test-csys.lisp
View file

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