first try with virtual (restartable) actor loop

core/actor.lisp

@@ -39,10 +39,10 @@
   (when (not (boundp '+quit-message+)) 
     (defconstant +quit-message+ (gensym "QUIT"))))
 
-(defun start (mb bhv &key foreground)
+(defun start (mb bhv &key foreground (listener #'ac-loop))
   (if foreground
     (ac-loop mb bhv)
-    (async:submit-task mb (lambda () (ac-loop mb bhv)))))
+    (async:submit-task mb listener mb bhv)))
 
 (defun stop (mb)
   (send mb +quit-message+))
@@ -52,17 +52,30 @@
     (unless (eq (content msg) +quit-message+)
       (ac-loop mb (or (funcall bhv msg) bhv)))))
 
+(defun ac-vloop (mb bhv)
+  (multiple-value-bind (msg ok) (async:try-rcv mb)
+    (if ok
+      (if (eq (content msg) +quit-message+)
+        nil
+        (ac-vloop mb (or (funcall bhv msg) bhv)))
+      bhv)))
+
 ;;;; the core (classical, i.e. Hewitt) actor API
 ;;;  there is no `become` operation: the behavior just returns the new behavior
 
 (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))
+  (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))))))
 
 ;;;; predefined behaviors
 

test/test-core.lisp

@@ -59,11 +59,11 @@
     (unwind-protect
       (progn
         (test-util)
-        (test-util-async)
         (test-util-crypt)
         (test-util-iter)
         (test-shape)
         (core:setup-services)
+        (test-util-async)
         (test-actor)
         (setf (receiver t:*test-suite*) (core:find-service :test-receiver))
         (test-send))
@@ -87,11 +87,6 @@
     (== (util:plist-add pl :b 1) '(:b 1 :a 0))
     (== pl '(:b 1 :a 0))))
 
-(deftest test-util-async ()
-  (let ((mb (async:make-mb)))
-    (async:submit-task mb (lambda () (sleep 0.1) :done))
-))
-
 (deftest test-util-crypt ()
   (let ((s1 (crypt:create-secret))
         (s2 (crypt:create-secret)))
@@ -114,6 +109,14 @@
     (setf (shape:head-value rec :username) :u1)
     (== (shape:head-value rec :username) :u1)))
 
+(deftest test-util-async ()
+  (let ((mb (async:make-mb)))
+    (async:submit-task mb (lambda () (sleep 0.1) :done))
+    (== (async:try-receive-result mb) nil)
+    (== (async:receive-result mb) :done)
+    (== (async:try-receive-result mb) nil)
+))
+ 
 (deftest test-actor ()
   (let* ((calc (actor:create (actor:calculator)))
          val

util/async.lisp

@@ -33,13 +33,13 @@
   (lpq:pop-queue (queue mb)))
 
 (defun try-rcv (mb)
-  (lpq:peek-queue (queue mb)))
+  (lpq:try-pop-queue (queue mb)))
 
 (defun snd (mb msg)
   (lpq:push-queue msg (queue mb)))
 
-(defun submit-task (mb job)
-  (lp:submit-task (channel mb) job))
+(defun submit-task (mb job &rest args)
+  (apply #'lp:submit-task (channel mb) job args))
 
 (defun receive-result (mb)
   (lp:receive-result (channel mb)))