From 93f9a5a83524e20f34ca7c37318e843e30960dab Mon Sep 17 00:00:00 2001 From: Helmut Merz Date: Mon, 27 Jul 2026 09:24:59 +0200 Subject: [PATCH] work in progress: :next action; minor fixes and rearrangements --- core/actor.lisp | 2 +- csys/csys.lisp | 5 +++-- csys/environ.lisp | 6 +++--- test/test-csys.lisp | 16 ++++++++++------ 4 files changed, 17 insertions(+), 12 deletions(-) diff --git a/core/actor.lisp b/core/actor.lisp index 2a44b2f..473c31f 100644 --- a/core/actor.lisp +++ b/core/actor.lisp @@ -61,7 +61,7 @@ (let ((*self* tsk)) (handler-case (funcall bhv msg) (error (err) - (util:lg :error "behavior" msg tsk bhv err)) + (util:lg :error "behavior" msg err)) ;(invoke-debugger err)) ))) diff --git a/csys/csys.lisp b/csys/csys.lisp index cc3164f..d4f2f10 100644 --- a/csys/csys.lisp +++ b/csys/csys.lisp @@ -97,8 +97,9 @@ (lambda (msg scope) (util:mv-bind (nmsg (nscope scope)) (handle-action msg scope :default (no-op) :actions actions) - (setf (nth 1 (shape:head nmsg)) :effect) - (when nmsg (notify nmsg nscope)) + (when nmsg + (setf (nth 1 (shape:head nmsg)) :effect) + (notify nmsg nscope)) (update nscope)))) (defun handle-action (msg scope &key (default (no-op)) actions) diff --git a/csys/environ.lisp b/csys/environ.lisp index 6277ea3..596b81a 100644 --- a/csys/environ.lisp +++ b/csys/environ.lisp @@ -37,9 +37,9 @@ (when addr (register-cell (cells scope) addr new)) ;;;send :next message / create more cells: - ;(actor:send new - ; (message:create (list (message:domain msg) :next) :data (shape:data msg)) - msg)) + (actor:send new + (message:create (list (message:domain msg) :next) :data (shape:data msg))) + nil)) (defun forward (msg scope) (dolist (cell (find-cells (cells scope) (message:addr msg))) diff --git a/test/test-csys.lisp b/test/test-csys.lisp index c91da83..45755b7 100644 --- a/test/test-csys.lisp +++ b/test/test-csys.lisp @@ -37,7 +37,7 @@ (let ((t:*test-suite* (csys:environ scope))) (util:mv-bind (nmsg (scope scope)) (csys:handle-action msg scope :actions (environ:actions)) - (util:lgi nmsg (tc:receiver t:*test-suite*)) + (util:lgi msg nmsg) (when nmsg (actor:send (core:mailbox (tc:receiver t:*test-suite*)) nmsg))))) @@ -60,18 +60,22 @@ (csys:create-zero prg env) env)) +;;;; test-specific actions + (defun test-program () (csys:make-program (csys:eff-proc :actions (actions-zero)))) -(defun next-zero () - (lambda (msg scope) - (util:lgi msg) - nil)) - (defun actions-zero () (let ((acts (csys:basic-actions))) (setf (getf acts :next) (next-zero)) acts)) + +(defun next-zero () + (lambda (msg scope) + (util:lgi msg) + nil)) + +;;;; test definitions (deftest test-basic-0 () (let ((env (setup-test (test-program)))