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