core: use actor API: get rid of old send and do-start function definitions

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 #:start #:stop
+  (:export #:actor #:bg-actor #:fg-actor #:make-actor #:start #:stop
            #:become #:create #:send
            #:message #:content #:customer
            #:*logger* #:*root*
@@ -44,6 +44,9 @@
   (:method ((ac bg-actor)) 
     (async:stop (task ac))))
 
+(defun make-actor (bhv &optional (cls 'actor) &rest args &key &allow-other-keys)
+  (apply #'make-instance cls :behavior bhv args))
+
 (defun make-task (ac &optional (cls 'async:bg-task))
   (async:make-task :cls cls
                    :handle-message 
@@ -55,8 +58,8 @@
   (setf (behavior ac) bhv))
 
 (defun create (bhv &optional (cls 'actor) &rest args &key &allow-other-keys)
-  (let ((ac (apply #'make-instance cls :behavior bhv args)))
-    ;(start ac)
+  (let ((ac (apply #'make-actor bhv cls args)))
+    (start ac)
     ac))
 
 (defgeneric send (addr content &key &allow-other-keys)

core/core.lisp

@@ -14,7 +14,7 @@
   (:export #:action-spec #:define-actions
            #:*root* #:default-setup #:actions 
            #:find-service #:run-services #:setup-services #:shutdown
-           #:base-context #:context #:add-action #:config #:name #:send
+           #:base-context #:context #:add-action #:config #:name
            #:handle-message
            #:do-print #:echo))
 
@@ -73,28 +73,6 @@
 
 (defclass root-service (service actor:fg-actor) ())
 
-(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))
-    (async:start (task ctx)))
-  (:method ((ctx root-service)) 
-    (setf (task ctx) 
-          (async:make-task :cls 'async:fg-task :handle-message #'handle-message))
-    (async:start (task ctx))))
-
-(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 #'actor:create #'handle-message cls :config cfg :name (config:name cfg) args))
 
@@ -105,24 +83,24 @@
 
 (defun setup-services (&optional (cfg config:*root*))
   (async:init)
-  (setf *root* (actor:create #'handle-message 'root-service :config cfg))
+  (setf *root* (actor:make-actor #'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 (task *root*) 
-    (actor:stop *root*))
-  (async:finish))
- 
  (defun run-services (&optional (cfg config:*root*))
    (unwind-protect
      (progn
        (setup-services cfg)
-       (do-start *root*))
+       (actor:start *root*))
      (shutdown)))
  
+ (defun shutdown ()
+  (dolist (ctx (alx:hash-table-values (services *root*)))
+    (funcall (config:shutdown (config ctx)) ctx))
+  (if (task *root*) 
+    (actor:stop *root*))
+  (async:finish))
+
 (defun add-action (ctx pat hdlr)
   (let* ((acts (actions ctx))
          (act (find-action pat acts)))
@@ -137,8 +115,7 @@
       (when child
         (dolist (a (config:actions cfg))
           (add-action child (car a) (cadr a)))
-        (setf (gethash (config:name cfg) services) child)
-        (do-start child)))))
+        (setf (gethash (config:name cfg) services) child)))))
 
 (defgeneric handle-message (ctx msg)
   (:method ((ctx base-context) msg)
@@ -158,7 +135,7 @@
       (let* ((h (shape:head msg))
              (new-msg (message:create `(,domain ,action ,@(cddr h))
                                       :data (shape:data msg))))
-        (send cust new-msg))
+        (actor:send cust new-msg))
       (util:lgw "customer missing" msg))))
 
 (defun do-print (ctx msg)

test/test-core.lisp

@@ -132,7 +132,6 @@
          (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))
@@ -147,4 +146,4 @@
         (msg-exp (message:create '(:test :dummy) :data "dummy payload")))
     (expect rcvr msg-exp)
     (== (core:name rcvr) :test-receiver)
-    (core:send rcvr msg)))
+    (actor:send rcvr msg)))

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

@@ -91,7 +91,6 @@
 (defun message-handler (ctx env &key html-responder)
   (let* ((resp (response:setup ctx env :html-responder html-responder))
          (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)