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:
parent
ba553a917e
commit
2fafbc4b79
|
@ -0,0 +1,9 @@
|
||||||
|
#lang info
|
||||||
|
|
||||||
|
(define collection 'multi)
|
||||||
|
|
||||||
|
(define deps '("base"
|
||||||
|
"distributed-places-lib"
|
||||||
|
"racket-doc"
|
||||||
|
"sandbox-lib"
|
||||||
|
"scribble-lib"))
|
|
@ -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])]{
|
|
@ -0,0 +1,3 @@
|
||||||
|
#lang info
|
||||||
|
|
||||||
|
(define scribblings '(("distributed-places.scrbl" () (net-library))))
|
|
@ -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])
|
|
@ -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"
|
||||||
|
|
|
@ -35,4 +35,5 @@
|
||||||
"syntax-color"
|
"syntax-color"
|
||||||
"scribble"
|
"scribble"
|
||||||
"compatibility-lib"
|
"compatibility-lib"
|
||||||
"future-visualizer"))
|
"future-visualizer"
|
||||||
|
"distributed-places-doc"))
|
||||||
|
|
|
@ -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"]
|
||||||
|
|
|
@ -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}.}
|
||||||
|
|
||||||
@;------------------------------------------------------------------------
|
@;------------------------------------------------------------------------
|
||||||
|
|
|
@ -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))]))
|
||||||
|
|
Loading…
Reference in New Issue
Block a user