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

csys: rename gen-proc special actions, now: prepare, finalize; minor improvements

Browse source
This commit is contained in:
Helmut Merz 2026-10-13 07:59:49 +02:00
parent 05e31c1d68
commit 57cd9b5956
4 changed files with 7 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
csys/csys.lisp
View file

@ -105,11 +105,11 @@
(defun merge-actions (&optional act+ (base (basic-actions))) (defun merge-actions (&optional act+ (base (basic-actions)))
(util:plist-merge base act+)) (util:plist-merge base act+))
(defun gen-proc (actions &key default before after) (defun gen-proc (actions &key default prepare finalize)
(lambda (msg scope) (lambda (msg scope)
(let* ((key (message:action msg)) (let* ((key (message:action msg))
(acts (getf actions key (getf actions :default default)))) (acts (getf actions key (getf actions :default default))))
(dolist (act (alx:flatten (cons before (cons acts (list after))))) (dolist (act (alx:flatten (list prepare acts finalize)))
(when act (when act
(util:mv-bind (nmsg (nscope scope)) (funcall act msg scope) (util:mv-bind (nmsg (nscope scope)) (funcall act msg scope)
(setf msg nmsg scope nscope))))) (setf msg nmsg scope nscope)))))
@ -118,7 +118,7 @@
(defun std-proc (&rest args &key actions &allow-other-keys) (defun std-proc (&rest args &key actions &allow-other-keys)
(let ((actions (or actions (merge-actions args)))) (let ((actions (or actions (merge-actions args))))
(gen-proc actions (gen-proc actions
:after (lambda (msg scope) (forward msg scope))))) :finalize (lambda (msg scope) (forward msg scope)))))
(defun eff-proc (&rest args &key actions &allow-other-keys) (defun eff-proc (&rest args &key actions &allow-other-keys)
(let ((actions (or actions (merge-actions args)))) (let ((actions (or actions (merge-actions args))))
@ -127,7 +127,7 @@
(setf (nth 1 (shape:head msg)) :effect) (setf (nth 1 (shape:head msg)) :effect)
(forward msg scope) (forward msg scope)
(unless (syns scope) (notify msg scope))))) (unless (syns scope) (notify msg scope)))))
(gen-proc actions :after #'forward-eff)))) (gen-proc actions :finalize #'forward-eff))))
(defun forward (msg scope) (defun forward (msg scope)
(when msg (when msg

2
csys/environ.lisp
View file

@ -40,7 +40,7 @@
(defun simple-proc (msg scope) (defun simple-proc (msg scope)
(csys:gen-proc (actions) (csys:gen-proc (actions)
:after (lambda (msg scope) (actor:send (csys:environ scope) msg)))) :finalize (lambda (msg scope) (actor:send (csys:environ scope) msg))))
;;;; eff contact cells ;;;; eff contact cells

5
storage/storage.lisp
View file

@ -84,10 +84,7 @@
;;;; utilities ;;;; utilities
(defun normalize-plist (pl) (defun normalize-plist (pl)
(let ((res nil)) (util:loop-plist pl k v nconc (list (util:to-keyword k) v)))
(alx:doplist (k v pl res)
(push v res)
(push (util:to-keyword k) res))))
(defun ts-string (ts) (defun ts-string (ts)
(format nil "~a" (local-time:universal-to-timestamp ts))) (format nil "~a" (local-time:universal-to-timestamp ts)))

2
test/test-csys.lisp
View file

@ -44,7 +44,7 @@
(let* ((t:*test-suite* (csys:environ scope)) (let* ((t:*test-suite* (csys:environ scope))
(proc (proc
(csys:gen-proc (environ:actions) (csys:gen-proc (environ:actions)
:after (lambda (msg scope) :finalize (lambda (msg scope)
(when msg (when msg
(actor:send (core:mailbox (tc:receiver t:*test-suite*)) msg)))))) (actor:send (core:mailbox (tc:receiver t:*test-suite*)) msg))))))
(funcall proc msg scope))) (funcall proc msg scope)))