diff --git a/core/actor.lisp b/core/actor.lisp index 9953034..59323eb 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 + (: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)) - (let ((ac (make-instance cls :behavior bhv))) - (start ac) +(defun create (bhv &optional (cls 'actor) &rest args &key &allow-other-keys) + (let ((ac (apply #'make-instance cls :behavior bhv args))) + ;(start ac) ac)) (defgeneric send (addr content &key &allow-other-keys) diff --git a/core/core.lisp b/core/core.lisp index eddcf80..75779aa 100644 --- a/core/core.lisp +++ b/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*)) - (async:stop (task *root*))) + (if (task *root*) + (actor:stop *root*)) (async:finish)) (defun run-services (&optional (cfg config:*root*)) diff --git a/test/test-core.lisp b/test/test-core.lisp index 4417be7..085f353 100644 --- a/test/test-core.lisp +++ b/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)) diff --git a/test/test-web.lisp b/test/test-web.lisp index 07f010c..9a55b93 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 8979c0e..5f64e35 100644 --- a/web/server.lisp +++ b/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)