work in progress: generic send function in core/actor, to be used by core:context

This commit is contained in:
Helmut Merz 2025-05-02 20:49:40 +02:00
parent 92b26c74bb
commit 80d971bb59
2 changed files with 20 additions and 16 deletions

View file

@ -4,7 +4,8 @@
(:use :common-lisp)
(:local-nicknames (:async :scopes/util/async)
(:util :scopes/util))
(:export #:actor #:bg-actor #:become #:create #:send
(:export #:actor #:bg-actor #:fg-actor
#:become #:create #:send
#:message #:content #:customer
#:*logger* #:*root*
#:echo #:inc #:lgi
@ -27,20 +28,18 @@
(defclass bg-actor (actor)
((task :accessor task :initform nil)))
(defclass fg-actor (bg-actor) ())
(defgeneric start (ac)
(:method ((ac actor)))
(:method ((ac bg-actor))
(setf (task ac)
(async:make-task
:handle-message #'(lambda (ax msg)
(funcall (behavior ac) ac msg))))
(setf (task ac) (make-task ac))
(async:start (task ac))))
(defgeneric deliver (ac msg)
(:method ((ac actor) msg)
(funcall (behavior ac) ac msg))
(:method ((ac bg-actor) msg)
(async:send (task ac) msg)))
(defun make-task (ac &optional (cls 'async:bg-task))
(async:make-task :cls cls
:handle-message
#'(lambda (ax msg) (funcall (behavior ac) ac msg))))
;;;; the core (classical, i.e. Hewitt) actor API
@ -52,9 +51,14 @@
(start ac)
ac))
(defun send (addr content &key customer)
(defgeneric send (addr content &key &allow-other-keys)
(:method ((addr t) (content t) &key customer &allow-other-keys)
(let ((ac addr) (msg (message content customer)))
(deliver ac msg)))
(send ac msg)))
(:method ((ac actor) (msg message) &key &allow-other-keys)
(funcall (behavior ac) ac msg))
(:method ((ac bg-actor) (msg message) &key &allow-other-keys)
(async:send (task ac) msg)))
;;;; predefined behaviors

View file

@ -2,7 +2,7 @@
(defpackage :scopes/core
(:use :common-lisp)
(:local-nicknames (actor :scopes/core/actor)
(:local-nicknames (:actor :scopes/core/actor)
(:async :scopes/util/async)
(:config :scopes/config)
(:message :scopes/core/message)
@ -68,10 +68,10 @@
(name :reader name :initarg :name)
(services :reader services :initform (make-hash-table))))
(defclass service (context)
(defclass service (context actor:bg-actor)
((task :accessor task :initform nil)))
(defclass root-service (service) ())
(defclass root-service (service actor:actor) ())
(defgeneric do-start (ctx)
(:method ((ctx context)))