|
23 | 23 | (sem (bt2:make-semaphore) :type bt2:semaphore) |
24 | 24 | (thread nil :type (or null bt2:thread))) |
25 | 25 |
|
26 | | -(defun resolve-actor (actor) |
27 | | - (etypecase actor |
28 | | - (actor actor) |
29 | | - (symbol (gethash actor *registry*)))) |
| 26 | +(defmethod resolve-actor ((actor symbol)) |
| 27 | + (gethash actor *registry*)) |
30 | 28 |
|
31 | | -(defun process-message (actor msg) |
| 29 | +(defmethod process-message ((actor actor) msg) |
32 | 30 | (let ((*self* actor)) |
33 | 31 | (setf (actor-store actor) |
34 | 32 | (multiple-value-list |
35 | 33 | (handler-case (apply (actor-behav actor) msg) |
36 | 34 | (error (c) (funcall (actor-fail actor) c))))))) |
37 | 35 |
|
38 | | -(defun run-actor (actor) |
| 36 | +(defmethod run-actor ((actor actor)) |
39 | 37 | "Run main event loop for actor." |
40 | 38 | (loop (let ((sig (q:qpop (actor-queue actor)))) |
41 | 39 | (etypecase sig |
|
50 | 48 | (null |
51 | 49 | (bt2:wait-on-semaphore (actor-sem actor))))))) |
52 | 50 |
|
53 | | -(defun send-signal (actor sig) |
| 51 | +(defmethod send-signal ((actor actor) sig) |
54 | 52 | (unless (actor-openp actor) |
55 | 53 | (error (format nil "Message sent to closed actor: ~w" actor))) |
56 | 54 | (q:qpush (actor-queue actor) sig) |
57 | 55 | (bt2:signal-semaphore (actor-sem actor))) |
58 | 56 |
|
59 | | -(defun close-actor (actor &aux (actor (resolve-actor actor))) |
60 | | - "Send a close-signal to an actor." |
61 | | - (send-signal actor (make-close-signal)) |
62 | | - (setf (actor-openp actor) nil)) |
63 | | - |
64 | | -(defun join-actor (actor &aux (actor (resolve-actor actor))) |
65 | | - "Wait for an actor to finish computing." |
66 | | - (bt2:join-thread (actor-thread actor)) |
67 | | - (apply #'values (actor-store actor))) |
68 | | - |
69 | | -(defun destroy-actor (actor &aux (actor (resolve-actor actor))) |
70 | | - "Immediately destroy an actor's thread." |
71 | | - (remhash (actor-name actor) *registry*) |
72 | | - (bt2:destroy-thread (actor-thread actor))) |
| 57 | +(defgeneric close-actor (actor) |
| 58 | + (:documentation "Send a close-signal to an actor.") |
| 59 | + (:method ((actor actor)) |
| 60 | + (send-signal actor (make-close-signal)) |
| 61 | + (setf (actor-openp actor) nil)) |
| 62 | + (:method ((actor t)) |
| 63 | + (close-actor (resolve-actor actor)))) |
| 64 | + |
| 65 | +(defgeneric join-actor (actor) |
| 66 | + (:documentation "Wait for an actor to finish computing.") |
| 67 | + (:method ((actor actor)) |
| 68 | + (bt2:join-thread (actor-thread actor)) |
| 69 | + (apply #'values (actor-store actor))) |
| 70 | + (:method ((actor t)) |
| 71 | + (join-actor (resolve-actor actor)))) |
| 72 | + |
| 73 | +(defgeneric destroy-actor (actor) |
| 74 | + (:documentation "Immediately destroy an actor's thread.") |
| 75 | + (:method ((actor actor)) |
| 76 | + (remhash (actor-name actor) *registry*) |
| 77 | + (bt2:destroy-thread (actor-thread actor))) |
| 78 | + (:method ((actor t)) |
| 79 | + (destroy-actor (resolve-actor actor)))) |
73 | 80 |
|
74 | 81 | (defun close-and-join-actors (&rest actors) |
75 | 82 | (mapc #'close-actor actors) |
76 | 83 | (mapc #'join-actor actors)) |
77 | 84 |
|
78 | | -(defun send (actor &rest args &aux (actor (resolve-actor actor))) |
79 | | - "Asyncronously send a message to an actor." |
80 | | - (send-signal actor (make-async-signal :msg args))) |
81 | | - |
82 | | -(defun ask (actor &rest args &aux (actor (resolve-actor actor))) |
83 | | - "Syncronously send a message and await a response from an actor" |
84 | | - (let ((sem (bt2:make-semaphore))) |
85 | | - (send-signal actor (make-sync-signal :msg args :sem sem)) |
86 | | - (bt2:wait-on-semaphore sem) |
87 | | - (apply #'values (actor-store actor)))) |
| 85 | +(defgeneric send (actor &rest args) |
| 86 | + (:documentation "Asyncronously send a message to an actor.") |
| 87 | + (:method ((actor actor) &rest args) |
| 88 | + (send-signal actor (make-async-signal :msg args))) |
| 89 | + (:method ((actor t) &rest args) |
| 90 | + (apply #'send (cons (resolve-actor actor) args)))) |
| 91 | + |
| 92 | +(defgeneric ask (actor &rest args) |
| 93 | + (:documentation "Syncronously send a message and await a response from an actor") |
| 94 | + (:method ((actor actor) &rest args) |
| 95 | + (let ((sem (bt2:make-semaphore))) |
| 96 | + (send-signal actor (make-sync-signal :msg args :sem sem)) |
| 97 | + (bt2:wait-on-semaphore sem) |
| 98 | + (apply #'values (actor-store actor)))) |
| 99 | + (:method ((actor t) &rest args) |
| 100 | + (apply #'ask (cons (resolve-actor actor) args)))) |
88 | 101 |
|
89 | 102 | (defmacro define-actor (name state args &body body) |
90 | 103 | "This macro creates a function named `name' that spawns an instance of |
|
0 commit comments