core: use actor API as base for context and message handling: basically working

core/actor.lisp

@@ -4,7 +4,7 @@
   (:use :common-lisp)
   (:local-nicknames (:async :scopes/util/async)
                     (:util :scopes/util))
-  (:export #:actor #:bg-actor #:fg-actor
+  (:export #:actor #:bg-actor #:fg-actor #:start #:stop
            #:become #:create #:send
            #:message #:content #:customer
            #:*logger* #:*root*
@@ -34,8 +34,16 @@
   (:method ((ac actor)))
   (:method ((ac bg-actor))
     (setf (task ac) (make-task ac))
+    (async:start (task ac)))
+  (:method ((ac fg-actor))
+    (setf (task ac) (make-task ac 'async:fg-task))
     (async:start (task ac))))
 
+(defgeneric stop (ac)
+  (:method ((ac actor)))
+  (:method ((ac bg-actor)) 
+    (async:stop (task ac))))
+
 (defun make-task (ac &optional (cls 'async:bg-task))
   (async:make-task :cls cls
                    :handle-message 
@@ -46,9 +54,9 @@
 (defun become (ac bhv)
   (setf (behavior ac) bhv))
 
-(defun create (bhv &optional (cls 'actor))
+(defun create (bhv &optional (cls 'actor) &rest args &key &allow-other-keys)
-  (let ((ac (make-instance cls :behavior bhv)))
+  (let ((ac (apply #'make-instance cls :behavior bhv args)))
-    (start ac)
+    ;(start ac)
     ac))
 
 (defgeneric send (addr content &key &allow-other-keys)

core/core.lisp

@@ -60,7 +60,7 @@
 
 (defvar *root* nil)
 
-(defclass base-context ()
+(defclass base-context (actor:actor)
   ((actions :accessor actions :initform nil)))
 
 (defclass context (base-context) 
@@ -71,9 +71,12 @@
 (defclass service (context actor:bg-actor)
   ((task :accessor task :initform nil)))
 
-(defclass root-service (service actor:actor) ())
+(defclass root-service (service actor:fg-actor) ())
 
-(defgeneric do-start (ctx)
+(defun do-start (ctx)
+  (actor:start ctx))
+
+(defgeneric x-do-start (ctx)
   (:method ((ctx context)))
   (:method ((ctx service)) 
     (setf (task ctx) (async:make-task :handle-message #'handle-message))
@@ -83,14 +86,17 @@
           (async:make-task :cls 'async:fg-task :handle-message #'handle-message))
     (async:start (task ctx))))
 
-(defgeneric send (rcvr msg)
+(defun send (rcvr msg)
+  (actor:send rcvr msg))
+
+(defgeneric x-send (rcvr msg)
   (:method ((rcvr base-context) msg)
     (handle-message rcvr msg))
   (:method ((rcvr service) msg)
     (async:send (task rcvr) msg)))
 
  (defun default-setup (cfg &optional (cls 'context) &rest args &key &allow-other-keys)
-  (apply #'make-instance cls :config cfg :name (config:name cfg) args))
+   (apply #'actor:create #'handle-message cls :config cfg :name (config:name cfg) args))
 
 (defun find-service (name &optional (parent *root*))
   (with-slots (services) parent
@@ -99,15 +105,15 @@
 
 (defun setup-services (&optional (cfg config:*root*))
   (async:init)
-  (setf *root* (make-instance 'root-service :config cfg))
+  (setf *root* (actor:create #'handle-message 'root-service :config cfg))
   (dolist (c (reverse (config:children cfg)))
     (add-service *root* c)))
 
 (defun shutdown ()
   (dolist (ctx (alx:hash-table-values (services *root*)))
     (funcall (config:shutdown (config ctx)) ctx))
-  (if (and (task *root*)) 
+  (if (task *root*) 
-    (async:stop (task *root*)))
+    (actor:stop *root*))
   (async:finish))
  
  (defun run-services (&optional (cfg config:*root*))

test/test-core.lisp

@@ -132,6 +132,7 @@
          (collector 
            (actor:create 
              #'(lambda (ac msg) (setf val (actor:content msg))))))
+    (actor:start calc)
     (actor:send calc '(actor:plus 2))
     (actor:send calc '(actor:minus 3))
     (actor:send calc '(actor:show))

test/test-web.lisp

@@ -37,7 +37,7 @@
           (test-fileserver client)
           (test-message client)
           (sleep 0.1)))
-      (core:shutdown)
+      ;(core:shutdown)
       (t:show-result))))
 
 ;;;; the tests

web/server.lisp

@@ -2,7 +2,8 @@
 
 (defpackage :scopes/web/server
   (:use :common-lisp)
-  (:local-nicknames (:config :scopes/config)
+  (:local-nicknames (:actor :scopes/core/actor)
+                    (:config :scopes/config)
                     (:core :scopes/core)
                     (:message :scopes/core/message)
                     (:response :scopes/web/response)
@@ -89,7 +90,8 @@
 
 (defun message-handler (ctx env &key html-responder)
   (let* ((resp (response:setup ctx env :html-responder html-responder))
-         (iact (make-instance 'response:interaction :response resp))
+         (iact (actor:create #'core:handle-message 'response:interaction :response resp))
+         ;(iact (make-instance 'response:interaction :response resp))
          (msg (message:create 
                 (head env) :data (plist (post-data env)) :customer iact)))
     (util:lgd msg)