X-Git-Url: https://jxself.org/git/?p=8sync.git;a=blobdiff_plain;f=8sync%2Fsystems%2Factors.scm;h=e33a88b3658eb514da2dd21b04d85e1f6305f322;hp=8f00d570d9f5880d901a6063334e59e047d3f4d0;hb=15d004d6a653a4302deae1a64a516b3ebb0da873;hpb=5b3a0e8de367ddff6b132aa92e7786bc31cede4b diff --git a/8sync/systems/actors.scm b/8sync/systems/actors.scm index 8f00d57..e33a88b 100644 --- a/8sync/systems/actors.scm +++ b/8sync/systems/actors.scm @@ -35,7 +35,6 @@ actor-id - actor-hive actor-message-handler ;;; Commenting out the
type for now; @@ -59,6 +58,9 @@ hive-id hive-create-actor hive-create-actor* + create-actor create-actor* + self-destruct + make-message message? message-to message-action message-from @@ -69,8 +71,10 @@ send-message send-message-wait reply-message reply-message-wait + <- <-wait <-reply <-reply-wait + ez-run-hive - hive-bootstrap-message + bootstrap-message serialize-message write-message serialize-message-pretty pprint-message @@ -80,8 +84,8 @@ (define %random-state (make-parameter (random-state-from-platform))) -;; Probably bigger than necessary -(define random-number-size (expt 10 50)) +;; Same size as a uuid4 I think... +(define random-number-size (expt 2 128)) (define (big-random-number) (random random-number-size (%random-state))) @@ -116,9 +120,11 @@ (define-record-type (make-message-intern id to from action - body in-reply-to wants-reply ; do we need hive-proxy? - ;; Are these still needed? - replied deferred-reply) + body in-reply-to wants-reply + replied + ;; @@: Not used yet. + ;; Will we ever find a real use case? + deferred-reply) message? (id message-id) (to message-to) @@ -198,7 +204,7 @@ If key not found and DFLT not provided, throw an error." (message (make-message (hive-gen-message-id hive) to-id (actor-id from-actor) action (kwarg-list-to-alist message-body-args)))) - (8sync (hive-process-message hive message)))) + (8sync-nowait (hive-process-message hive message)))) (define (send-message-wait from-actor to-id action . message-body-args) "Send a message from an actor to another, but wait until we get a response" @@ -225,7 +231,7 @@ If key not found and DFLT not provided, throw an error." (actor-id from-actor) '*reply* (kwarg-list-to-alist message-body-args) #:in-reply-to (message-id original-message)))) - (8sync (hive-process-message hive new-message)))) + (8sync-nowait (hive-process-message hive new-message)))) (define (reply-message-wait from-actor original-message . message-body-args) @@ -242,6 +248,16 @@ If key not found and DFLT not provided, throw an error." (abort-to-prompt abort-to from-actor new-message))) +;;; Aliases! +;;; See: http://mumble.net/~jar/articles/oo-moon-weinreb.html +;;; (also worth seeing: http://mumble.net/~jar/articles/oo.html ) + +(define <- send-message) +(define <-wait send-message-wait) +(define <-reply reply-message) +(define <-reply-wait reply-message-wait) + + ;;; Main actor implementation ;;; ========================= @@ -468,13 +484,12 @@ more compact following syntax: (call-with-prompt (hive-prompt hive) thunk (lambda (kont actor message) - (let ((hive (actor-hive actor))) - ;; Register the coroutine - (hash-set! (hive-waiting-coroutines hive) - (message-id message) - (cons (actor-id actor) kont)) - ;; Send off the message - (8sync (hive-process-message hive message)))))) + ;; Register the coroutine + (hash-set! (hive-waiting-coroutines hive) + (message-id message) + (cons (actor-id actor) kont)) + ;; Send off the message + (8sync (hive-process-message hive message))))) (define (process-local-message) (let ((actor (resolve-actor-to))) @@ -549,7 +564,6 @@ so this gets called from the nicer hive-create-actor interface. See that method for documentation." (let* ((actor-id (hive-gen-actor-id hive id-cookie)) (actor (apply make actor-class - ;; @@: If we switch to a hive-proxy, do it here #:hive hive #:id actor-id init))) @@ -557,37 +571,43 @@ that method for documentation." ;; return the actor id actor-id)) -(define* (hive-create-actor hive actor-class - #:key - (init '()) - id-cookie) +(define* (hive-create-actor hive actor-class #:rest init) + (%hive-create-actor hive actor-class + init #f)) + +(define* (hive-create-actor* hive actor-class id-cookie #:rest init) (%hive-create-actor hive actor-class init id-cookie)) -(define-syntax hive-create-actor* - (syntax-rules () - "Create an instance of actor-class attached to this hive. -Return the new actor's id. -Used internally, and used for bootstrapping a fresh hive. + +;;; Various API methods for actors to interact with the system +;;; ========================================================== + +;; TODO: move send-message and friends here...? + +(define* (create-actor from-actor actor-class #:rest init) + "Create an instance of actor-class. Return the new actor's id. + +This is the method actors should call directly (unless they want +to supply an id-cookie, in which case they should use +create-actor*)." + (8sync (%hive-create-actor (actor-hive from-actor) actor-class + init #f))) + -Note that actors should generally not call this method directly. -Instead, actors should call create-actor." - ((_ args ... (init-args ...)) - (hive-create-actor args ... - #:init (list init-args ...))))) +(define* (create-actor* from-actor actor-class id-cookie #:rest init) + "Create an instance of actor-class. Return the new actor's id. +Like create-actor, but permits supplying an id-cookie." + (8sync (%hive-create-actor (actor-hive from-actor) actor-class + init id-cookie))) -;; TODO: Give actors this instead of the actual hive reference -(define-class () - (send-message #:getter proxy-send-message - #:init-keyword #:send-message) - (create-actor #:getter proxy-create-actor - #:init-keyword #:create-actor)) -;; Live the hive proxy, but has access to the hive itself... -(define-class () - (hive #:init-keyword #:hive)) +(define (self-destruct actor) + "Remove an actor from the hive." + (hash-remove! (hive-actor-registry (actor-hive actor)) + (actor-id actor))) @@ -611,7 +631,7 @@ an integer." (spawn-and-queue-repl-server! agenda))) (start-agenda agenda))) -(define (hive-bootstrap-message hive to-id action . message-body-args) +(define (bootstrap-message hive to-id action . message-body-args) (wrap (apply send-message hive to-id action message-body-args)))