From 2042748fc892898f3874aa72cef7ebcbb7ff0e72 Mon Sep 17 00:00:00 2001
From: Helmut Merz <helmutm@cy55.de>
Date: Sun, 15 Jun 2025 16:13:36 +0200
Subject: [PATCH] work in progress: actor based on restartable-task with
 thread-safe status flag

---
 core/actor.lisp |  9 +++++----
 util/async.lisp | 17 +++++++++++++++--
 2 files changed, 20 insertions(+), 6 deletions(-)

diff --git a/core/actor.lisp b/core/actor.lisp
index ab100b5..6945277 100644
--- a/core/actor.lisp
+++ b/core/actor.lisp
@@ -39,10 +39,10 @@
   (when (not (boundp '+quit-message+)) 
     (defconstant +quit-message+ (gensym "QUIT"))))
 
-(defun start (mb bhv &key foreground (listener #'ac-loop))
+(defun start (mb bhv &key foreground)
   (if foreground
     (ac-loop mb bhv)
-    (async:submit-task mb listener mb bhv)))
+    (async:submit-task mb #'ac-loop mb bhv)))
 
 (defun stop (mb)
   (send mb +quit-message+))
@@ -66,14 +66,15 @@
 (defun create (bhv)
   (let ((mb (async:make-mb))) 
     (start mb bhv)
-    (start mb bhv :listener #'ac-vloop)
     mb))
 
 (defun send (mb msg)
   ;(util:lgi msg)
+  (async:snd mb msg))
+
+(defun vsend (mb msg)
   (async:snd mb msg)
   (multiple-value-bind (bhv done) (async:try-receive-result mb)
-    (util:lgi done)
     (if (and done bhv)
       (async:submit-task mb (lambda () (ac-vloop mb bhv))))))
 
diff --git a/util/async.lisp b/util/async.lisp
index c9e295c..183722d 100644
--- a/util/async.lisp
+++ b/util/async.lisp
@@ -4,7 +4,8 @@
   (:use :common-lisp)
   (:local-nicknames (:lp :lparallel)
                     (:lpq :lparallel.queue))
-  (:export #:init #:finish #:make-ch #:make-mb #:rcv #:try-rcv #:snd 
+  (:export #:init #:finish #:make-ch #:make-mb #:make-task #:rcv #:try-rcv #:snd 
+           #:mailbox #:task #:restartable-task #:behavior #:status
            #:submit-task #:receive-result #:try-receive-result))
 
 (in-package :scopes/util/async)
@@ -20,7 +21,7 @@
   (when lp:*kernel*
     (lp:end-kernel)))
 
-;;;; higher-level mailbox / task / channel combination
+;;;; simple task = mailbox with result channel
 
 (defclass mailbox ()
   ((queue :reader queue :initform (lpq:make-queue))
@@ -47,3 +48,15 @@
 (defun try-receive-result (mb)
   (lp:try-receive-result (channel mb))) 
  
+;;;; tasks - with behavior and thread-safe status
+
+(defclass task (mailbox)
+  ((behavior :accessor behavior :initarg :behavior)))
+
+(defclass restartable-task (task)
+  ((status :reader status 
+           :initform (lp:make-channel :fixed-capacity 1 :initial-contents '(:new)))))
+
+(defun make-task (bhv &key restartable (cls 'task))
+  (if restartable (setf cls 'restartable-task))
+  (make-instance cls :behavior bhv))