#:use-module (ice-9 match)
#:use-module (ice-9 pretty-print)
#:use-module (8sync agenda)
- #:use-module (8sync repl)
#:export (;; utilities... ought to go in their own module
big-random-number
big-random-number-string
actor-id-hive
actor-id-string
+ actor-am-i-alive?
+
build-actions
define-simple-actor
call-with-message msg-receive msg-val
- ez-run-hive
+ run-hive
bootstrap-message
serialize-message write-message
(call/ec find-message-handler))
(apply method actor message (message-body message)))
+(define-syntax-rule (build-actions (symbol method) ...)
+ "Construct an alist of (symbol . method), where the method is wrapped
+with wrap-apply to facilitate live hacking and allow the method definition
+to come after class definition."
+ (list
+ (cons (quote symbol)
+ (wrap-apply method)) ...))
+
(define-class <actor> ()
;; An address object
(id #:init-keyword #:id
;; @@: There's no reason not to use #:class instead of
;; #:each-subclass anywhere in this file, except for
;; Guile bug #25211 (#:class is broken in Guile 2.2)
- #:allocation #:each-subclass)
+ #:allocation #:each-subclass
+ #:getter actor-message-handler)
;; This is the default, "simple" way to inherit and process messages.
- (actions #:init-value '()
+ (actions #:init-value (build-actions
+ ;; Default cleanup method is to do nothing.
+ (*cleanup* (const #f)))
#:allocation #:each-subclass))
-(define-method (actor-message-handler (actor <actor>))
- (slot-ref actor 'message-handler))
-
;;; So these are the nicer representations of addresses.
;;; However, they don't serialize so easily with scheme read/write, so we're
;;; using the simpler cons cell version below for now.
;;
(define (make-address actor-id hive-id)
- (cons actor-id hive-id))
+ (vector actor-id hive-id))
(define (address-actor-id address)
- (car address))
+ (vector-ref address 0))
(define (address-hive-id address)
- (cdr address))
+ (vector-ref address 1))
(define (address->string address)
(string-append (address-actor-id address) "@"
(define %current-actor
(make-parameter #f))
+(define (actor-am-i-alive? actor)
+ (hive-resolve-local-actor (actor-hive actor) (actor-id actor)))
+
\f
;;; Actor utilities
;;; ===============
-(define-syntax-rule (build-actions (symbol method) ...)
- "Construct an alist of (symbol . method), where the method is wrapped
-with wrap-apply to facilitate live hacking and allow the method definition
-to come after class definition."
- (list
- (cons (quote symbol)
- (wrap-apply method)) ...))
-
(define-syntax-rule (define-simple-actor class action ...)
(define-class class (<actor>)
(actions #:init-value (build-actions action ...)
(build-actions
;; This is in the case of an ambassador failing to forward a
;; message... it reports it back to the hive
- (*failed-forward* hive-handle-failed-forward))))
+ (*failed-forward* hive-handle-failed-forward)
+ (*cleanup-all* hive-handle-cleanup-all))))
(define-method (hive-handle-failed-forward (hive <hive>) message)
"Handle an ambassador failing to forward a message"
'TODO)
+(define-method (hive-handle-cleanup-all (hive <hive>) message)
+ "Send a message to all actors in our registry to clean themselves up."
+ ;; Unfortunately we have to do this hack and run over the list
+ ;; twice, because hash-for-each would result in an unrewindable
+ ;; continuation.
+ (define actor-ids
+ (hash-map->list (lambda (actor-id actor) actor-id)
+ (hive-actor-registry hive)))
+ (for-each (lambda (actor-id)
+ (<- hive actor-id '*cleanup*))
+ actor-ids))
+
(define* (make-hive #:key hive-id)
(let ((hive (make <hive>
#:id (make-address
(big-random-number-string))))))
;; Set the hive's actor reference to itself
(set! (actor-hive hive) hive)
+ ;; Register the actor with itself
+ (hive-register-actor! hive hive)
hive))
(define-method (hive-id (hive <hive>))
;;; 8sync bootstrap utilities
;;; =========================
-(define* (ez-run-hive hive initial-tasks #:key repl-server)
- "Start up an agenda and run HIVE in it with INITIAL-TASKS.
-
-Should we start up a cooperative REPL for live hacking? REPL-SERVER
-wants to know! You can pass it #t or #f, or if you want to specify a port,
-an integer."
- (let* ((queue (list->q initial-tasks))
- (agenda (make-agenda #:pre-unwind-handler print-error-and-continue
- #:queue queue)))
- (cond
- ;; If repl-server is an integer, we'll use that as the port
- ((integer? repl-server)
- (spawn-and-queue-repl-server! agenda repl-server))
- (repl-server
- (spawn-and-queue-repl-server! agenda)))
- (start-agenda agenda)))
+(define* (run-hive hive initial-tasks)
+ "Start up an agenda and run HIVE in it with INITIAL-TASKS."
+ (dynamic-wind
+ (const #f)
+ (lambda ()
+ (let* ((queue (list->q initial-tasks))
+ (agenda (make-agenda #:pre-unwind-handler print-error-and-continue
+ #:queue queue)))
+ (start-agenda agenda)))
+ ;; Run cleanup
+ (lambda ()
+ (run-hive-cleanup hive))))
+
+(define (run-hive-cleanup hive)
+ (let ((queue (list->q (list (bootstrap-message hive (actor-id hive)
+ '*cleanup-all*)))))
+ (start-agenda
+ (make-agenda #:queue queue))))
(define (bootstrap-message hive to-id action . message-body-args)
(wrap
projects / 8sync.git / blobdiff