adjust the places <-> distributed-places connection

Instead of a dynamic-require, the connection goes through a
structure-type property on a `remote-note%' instance.
This commit is contained in:
Matthew Flatt 2013-07-18 17:22:24 -06:00
parent ba553a917e
commit 2fafbc4b79
29 changed files with 85 additions and 29 deletions

View File

@ -0,0 +1,9 @@
#lang info
(define collection 'multi)
(define deps '("base"
"distributed-places-lib"
"racket-doc"
"sandbox-lib"
"scribble-lib"))

View File

@ -6,7 +6,7 @@
racket/place/distributed racket/place/distributed
racket/sandbox racket/sandbox
racket/class racket/class
(except-in "mz.rkt" log-message) (only-in scribblings/reference/mz guidealso)
(for-label (except-in racket/base log-message) (for-label (except-in racket/base log-message)
racket/place/define-remote-server racket/place/define-remote-server
racket/place/distributed racket/place/distributed
@ -24,6 +24,8 @@
@title[#:tag "distributed-places"]{Distributed Places} @title[#:tag "distributed-places"]{Distributed Places}
@author{Kevin Tew}
@guidealso["distributed-places"] @guidealso["distributed-places"]
@defmodule[racket/place/distributed] @defmodule[racket/place/distributed]
@ -154,7 +156,8 @@ the @racket[remote-connection%] instance to respawn the place on the
remote node should it exit or terminate at any time. It can also be a remote node should it exit or terminate at any time. It can also be a
procedure of zero arguments to implement the restart procedure, or it procedure of zero arguments to implement the restart procedure, or it
can be an object that support a @racket[restart] method that takes a can be an object that support a @racket[restart] method that takes a
@tech{place} argument.} @tech[#:doc '(lib "scribblings/reference/reference.scrbl")]{place}
argument.}
@defproc[(spawn-node-supervise-place-at @defproc[(spawn-node-supervise-place-at
[hostname string?] [hostname string?]
@ -379,13 +382,15 @@ node's message router.
@defclass[remote-node% object% (event-container<%>)]{ @defclass[remote-node% object% (event-container<%>)]{
The @racket[node%] instance controls a distributed places node. It Like @racket[node%], but for the remote API to a distributed places
launches compute places and routes inter-node place messages in the
distributed system. This is the remote api to a distributed places
node. Instances of @racket[remote-node%] are returned by node. Instances of @racket[remote-node%] are returned by
@racket[spawn-remote-racket-node], @racket[create-place-node], @racket[spawn-remote-racket-node], and
@racket[spawn-node-supervise-dynamic-place-at], and @racket[spawn-node-supervise-place-at].
@racket[spawn-node-supervise-place-thunk-at].
A @racket[remote-node%] is a @tech[#:doc '(lib
"scribblings/reference/reference.scrbl")]{place location} in the
sense of @racket[place-location?], which means that it can be
supplied as the @racket[#:at] argument to @racket[dynamic-place].
@defconstructor[([listen-port tcp-listen-port? #f] @defconstructor[([listen-port tcp-listen-port? #f]
[restart-on-exit any/c #f])]{ [restart-on-exit any/c #f])]{

View File

@ -0,0 +1,3 @@
#lang info
(define scribblings '(("distributed-places.scrbl" () (net-library))))

View File

@ -812,10 +812,17 @@
(super-new) (super-new)
))) )))
(define place-location<%>
(interface*
()
([prop:place-location
(lambda (remote-node place-path place-func named)
(supervise-place-at remote-node place-path place-func
#:named named))])))
(define remote-node% (define remote-node%
(backlink (backlink
(class* (class* object% (event-container<%> event<%> place-location<%>)
object% (event-container<%> event<%>)
(init-field host-name) (init-field host-name)
(init-field listen-port) (init-field listen-port)
(init-field [cmdline-list #f]) (init-field [cmdline-list #f])
@ -1464,7 +1471,7 @@
#:use-current-ports use-current-ports)) #:use-current-ports use-current-ports))
(define (supervise-place-at remote-node place-path place-func (define (supervise-place-at remote-node place-path place-func
;#:initial-message [initial-message #f] ;;#:initial-message [initial-message #f]
#:restart-on-exit [restart-on-exit #f] #:restart-on-exit [restart-on-exit #f]
#:named [named #f] #:named [named #f]
#:thunk [thunk #f]) #:thunk [thunk #f])

View File

@ -44,6 +44,7 @@
"r5rs" "r5rs"
"r6rs" "r6rs"
"racket-doc" "racket-doc"
"distributed-places-doc"
"racket-index" "racket-index"
"racket-lib" "racket-lib"
"racklog" "racklog"

View File

@ -35,4 +35,5 @@
"syntax-color" "syntax-color"
"scribble" "scribble"
"compatibility-lib" "compatibility-lib"
"future-visualizer")) "future-visualizer"
"distributed-places-doc"))

View File

@ -18,5 +18,4 @@ support for parallelism to improve performance.
@include-section["thread-local.scrbl"] @include-section["thread-local.scrbl"]
@include-section["futures.scrbl"] @include-section["futures.scrbl"]
@include-section["places.scrbl"] @include-section["places.scrbl"]
@include-section["distributed.scrbl"]
@include-section["engine.scrbl"] @include-section["engine.scrbl"]

View File

@ -11,7 +11,8 @@
racket/place racket/place
racket/future racket/future
racket/flonum racket/flonum
racket/fixnum)) racket/fixnum
(only-in racket/place/distributed create-place-node)))
@; ---------------------------------------------------------------------- @; ----------------------------------------------------------------------
@ -127,7 +128,9 @@ are simulated using @racket[thread].}
@defproc[(dynamic-place [module-path (or/c module-path? path?)] @defproc[(dynamic-place [module-path (or/c module-path? path?)]
[start-name symbol?]) [start-name symbol?]
[#:at location (or/c #f place-location?) #f]
[#:named named any/c #f])
place?]{ place?]{
Creates a @tech{place} to run the procedure that is identified by Creates a @tech{place} to run the procedure that is identified by
@ -143,6 +146,9 @@ are simulated using @racket[thread].}
other end of communication for the @tech{place descriptor} returned other end of communication for the @tech{place descriptor} returned
by @racket[place]. by @racket[place].
If @racket[location] is provided, it must be a @tech{place location},
such as a distributed places node produced by @racket[create-place-node].
When the @tech{place} is created, the initial @tech{exit handler} When the @tech{place} is created, the initial @tech{exit handler}
terminates the place, using the argument to the exit handler as the terminates the place, using the argument to the exit handler as the
place's @deftech{completion value}. Use @racket[(exit _v)] to place's @deftech{completion value}. Use @racket[(exit _v)] to
@ -357,4 +363,23 @@ messages:
]} ]}
@deftogether[(
@defthing[prop:place-location struct-type-property?]
@defproc[(place-location? [v any/c]) boolean?]
)]{
A @tech{structure type property} and associated predicate for
implementations of @deftech{place locations}. The value of
@racket[prop:place-location] must be a procedure of four arguments:
the @tech{place location} itself, a module path, a symbol for the
start function exported by the module, and a place name (which can be
@racket[#f] for an anonymous place).
A @tech{place location} can be passed as the @racket[#:at] argument to
@racket[dynamic-place], which in turn simply calls the
@racket[prop:place-location] value of the @tech{place location}.
A distributed places note created with @racket[create-place-node]
is an example of a @tech{place location}.}
@;------------------------------------------------------------------------ @;------------------------------------------------------------------------

View File

@ -10,7 +10,6 @@
racket/place/private/th-place racket/place/private/th-place
racket/place/private/prop racket/place/private/prop
racket/private/streams racket/private/streams
racket/lazy-require
(for-syntax racket/base (for-syntax racket/base
@ -34,7 +33,8 @@
place* place*
(rename-out [pl-place-enabled? place-enabled?]) (rename-out [pl-place-enabled? place-enabled?])
place-dead-evt place-dead-evt
) place-location?
prop:place-location)
(define-syntax (define-pl-func stx) (define-syntax (define-pl-func stx)
(syntax-case stx () (syntax-case stx ()
@ -48,8 +48,6 @@
[(pl-place-enabled?) (pl-func p args ...)] [(pl-place-enabled?) (pl-func p args ...)]
[else (th-func p args ...)])))])) [else (th-func p args ...)])))]))
(lazy-require [racket/place/distributed (supervise-place-at)])
(define (place-channel-put/get ch msg) (define (place-channel-put/get ch msg)
(place-channel-put ch msg) (place-channel-put ch msg)
(place-channel-get ch)) (place-channel-get ch))
@ -67,6 +65,16 @@
(define-pl-func place-message-allowed? p) (define-pl-func place-message-allowed? p)
(define-pl-func place-dead-evt p) (define-pl-func place-dead-evt p)
(define-values (prop:place-location place-location? place-location-ref)
(make-struct-type-property 'place-location
(lambda (v info)
(unless (and (procedure? v)
(procedure-arity-includes? v 4))
(raise-argument-error 'guard-for-prop:place-location
"(procedure-arity-includes/c 4)"
v))
v)))
(define place-break/opt (define place-break/opt
(let ([place-break (lambda (p [kind #f]) (place-break p kind))]) (let ([place-break (lambda (p [kind #f]) (place-break p kind))])
place-break)) place-break))
@ -81,11 +89,9 @@
(define (dynamic-place module-path function #:at [node #f] #:named [named #f]) (define (dynamic-place module-path function #:at [node #f] #:named [named #f])
(cond (cond
[node [node
(unless (collection-file-path "distributed.rkt" "racket" "place" (unless (place-location? node)
#:fail (lambda (x) #f)) (raise-argument-error 'dynamic-place "(or/c place-location? #f)" node))
(raise-arguments-error "dynamic-place" ((place-location-ref node) node module-path function named)]
"distributed places are not available"))
(supervise-place-at node module-path function #:named named)]
[else [else
(start-place 'dynamic-place module-path function (start-place 'dynamic-place module-path function
#f (current-output-port) (current-error-port))])) #f (current-output-port) (current-error-port))]))