|
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