diff --git a/core/actor.lisp b/core/actor.lisp index 59323eb..2015bd8 100644 --- a/core/actor.lisp +++ b/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) diff --git a/core/core.lisp b/core/core.lisp index 75779aa..96955e7 100644 --- a/core/core.lisp +++ b/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,23 +83,23 @@ (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 () + (defun run-services (&optional (cfg config:*root*)) + (unwind-protect + (progn + (setup-services cfg) + (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 run-services (&optional (cfg config:*root*)) - (unwind-protect - (progn - (setup-services cfg) - (do-start *root*)) - (shutdown))) (defun add-action (ctx pat hdlr) (let* ((acts (actions ctx)) @@ -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) diff --git a/test/test-core.lisp b/test/test-core.lisp index 085f353..7b16edc 100644 --- a/test/test-core.lisp +++ b/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))) diff --git a/test/test-web.lisp b/test/test-web.lisp index 9a55b93..07f010c 100644 --- a/test/test-web.lisp +++ b/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 diff --git a/web/server.lisp b/web/server.lisp index 5f64e35..fa13a1f 100644 --- a/web/server.lisp +++ b/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)