core/actor: first version of bg-actor (=process)

core/actor.lisp

@@ -2,10 +2,13 @@
 
 (defpackage :scopes/core/actor
   (:use :common-lisp)
-  (:local-nicknames (:util :scopes/util))
+  (:local-nicknames (:async :scopes/util/async)
-  (:export #:actor #:become #:create #:send
+                    (:util :scopes/util))
+  (:export #:actor #:bg-actor #:become #:create #:send
+           #:content
+           #:*logger* #:*root*
            #:echo #:inc #:lgi
-           #:calculator #:plus #:minus #:show))
+           #:calculator #:plus #:minus #:show #:send-value))
 
 (in-package :scopes/core/actor)
 
@@ -21,17 +24,33 @@
 (defclass actor ()
   ((behavior :accessor behavior :initarg :behavior :initform #'no-op)))
 
+(defclass bg-actor (actor)
+  ((task :accessor task :initform nil)))
+
+(defgeneric start (ac)
+  (:method ((ac actor)))
+  (:method ((ac bg-actor))
+    (setf (task ac) 
+          (async:make-task 
+            :handle-message #'(lambda (ax msg) 
+                                (funcall (behavior ac) ac msg))))
+    (async:start (task ac))))
+
 (defgeneric deliver (ac msg)
   (:method ((ac actor) msg) 
-    (funcall (behavior ac) ac msg)))
+    (funcall (behavior ac) ac msg))
- 
+  (:method ((ac bg-actor) msg)
-;;;; the core (Hewitt) actor API
+    (async:send (task ac) msg)))
+
+;;;; the core (classical, i.e. Hewitt) actor API
 
 (defun become (ac bhv)
   (setf (behavior ac) bhv))
 
 (defun create (bhv &optional (cls 'actor))
-  (make-instance cls :behavior bhv))
+  (let ((ac (make-instance cls :behavior bhv)))
+    (start ac)
+    ac))
 
 (defun send (addr content &key customer)
   (let ((ac addr) (msg (message content customer))) 
@@ -47,7 +66,18 @@
 (defun echo (ac msg)
   (send (customer msg) msg))
 
-;;;; example behavior: calculator
+;;;; predefined global actors
+
+(defvar *logger* (create #'lgi))
+ 
+(defclass root (actor) ())
+
+(defun root-bhv (ac msg)
+  (send *logger* msg))
+
+(defvar *root* (create #'root-bhv 'root))
+
+ ;;;; example behavior: calculator
 
 (defun calculator (&optional (val 0))
   #'(lambda (ac msg)
@@ -59,4 +89,6 @@
 (defun minus (ac msg val param)
   (become ac (calculator (- val param)))) 
 (defun show (ac msg val param)
+  (send (or (customer msg) *logger*) val))
+(defun send-value (ac msg val param)
   (send (customer msg) val))

test/test-core.lisp

@@ -127,11 +127,17 @@
     (== (shape:head-value rec :username) :u1)))
 
 (deftest test-actor ()
-  (let ((calc (actor:create (actor:calculator))) 
+  (let* ((calc (actor:create (actor:calculator) 'actor:bg-actor)) 
-        (logger (actor:create #'actor:lgi)))
+         val
+         (collector 
+           (actor:create 
+             #'(lambda (ac msg) (setf val (actor:content msg))))))
     (actor:send calc '(actor:plus 2))
     (actor:send calc '(actor:minus 3))
-    (actor:send calc '(actor:show) :customer logger)
+    (actor:send calc '(actor:show))
+    (actor:send calc '(actor:send-value) :customer collector)
+    (sleep 0.1)
+    (== val -1)
     ))
 
 (deftest test-send ()