work in progress: generic send function in core/actor, to be used by core:context
This commit is contained in:
parent
92b26c74bb
commit
80d971bb59
2 changed files with 20 additions and 16 deletions
|
@ -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
|
||||
|
||||
|
|
|
@ -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)))
|
||||
|
|
Loading…
Add table
Reference in a new issue