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

This commit is contained in:
Helmut Merz 2025-05-04 08:44:18 +02:00
parent 9389edfc57
commit bca410ea6b
5 changed files with 20 additions and 42 deletions

View file

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

View file

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

View file

@ -132,7 +132,6 @@
(collector (collector
(actor:create (actor:create
#'(lambda (ac msg) (setf val (actor:content msg)))))) #'(lambda (ac msg) (setf val (actor:content msg))))))
(actor:start calc)
(actor:send calc '(actor:plus 2)) (actor:send calc '(actor:plus 2))
(actor:send calc '(actor:minus 3)) (actor:send calc '(actor:minus 3))
(actor:send calc '(actor:show)) (actor:send calc '(actor:show))
@ -147,4 +146,4 @@
(msg-exp (message:create '(:test :dummy) :data "dummy payload"))) (msg-exp (message:create '(:test :dummy) :data "dummy payload")))
(expect rcvr msg-exp) (expect rcvr msg-exp)
(== (core:name rcvr) :test-receiver) (== (core:name rcvr) :test-receiver)
(core:send rcvr msg))) (actor:send rcvr msg)))

View file

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

View file

@ -91,7 +91,6 @@
(defun message-handler (ctx env &key html-responder) (defun message-handler (ctx env &key html-responder)
(let* ((resp (response:setup ctx env :html-responder html-responder)) (let* ((resp (response:setup ctx env :html-responder html-responder))
(iact (actor:create #'core:handle-message 'response:interaction :response resp)) (iact (actor:create #'core:handle-message 'response:interaction :response resp))
;(iact (make-instance 'response:interaction :response resp))
(msg (message:create (msg (message:create
(head env) :data (plist (post-data env)) :customer iact))) (head env) :data (plist (post-data env)) :customer iact)))
(util:lgd msg) (util:lgd msg)