Merge unstable/place with racket/place.
This commit is contained in:
parent
91c422bb66
commit
4ee1864941
|
@ -262,6 +262,13 @@ The @racket[place] binding is protected in the same way as
|
||||||
The @racket[place*] binding is protected in the same way as
|
The @racket[place*] binding is protected in the same way as
|
||||||
@racket[dynamic-place].}
|
@racket[dynamic-place].}
|
||||||
|
|
||||||
|
@defform[(open-place id body ...+)]{
|
||||||
|
Like @racket[place], but @racket[body ...] may have free lexical
|
||||||
|
variables, which are automatically sent to the newly-created place.
|
||||||
|
Note that these variables must have values accepted by
|
||||||
|
@racket[place-message-allowed?], otherwise an @exnraise[exn:fail:contract].
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
@defproc[(place-wait [p place?]) exact-integer?]{
|
@defproc[(place-wait [p place?]) exact-integer?]{
|
||||||
Returns the @tech{completion value} of the place indicated by @racket[p],
|
Returns the @tech{completion value} of the place indicated by @racket[p],
|
||||||
|
|
|
@ -13,7 +13,9 @@
|
||||||
|
|
||||||
|
|
||||||
(for-syntax racket/base
|
(for-syntax racket/base
|
||||||
racket/syntax))
|
racket/syntax
|
||||||
|
syntax/parse
|
||||||
|
syntax/free-vars))
|
||||||
|
|
||||||
(provide (protect-out dynamic-place
|
(provide (protect-out dynamic-place
|
||||||
dynamic-place*)
|
dynamic-place*)
|
||||||
|
@ -31,6 +33,7 @@
|
||||||
processor-count
|
processor-count
|
||||||
(protect-out place
|
(protect-out place
|
||||||
place*)
|
place*)
|
||||||
|
open-place
|
||||||
(rename-out [pl-place-enabled? place-enabled?])
|
(rename-out [pl-place-enabled? place-enabled?])
|
||||||
place-dead-evt
|
place-dead-evt
|
||||||
place-location?
|
place-location?
|
||||||
|
@ -228,3 +231,25 @@
|
||||||
(not (module-predefined? `(quote ,name))))
|
(not (module-predefined? `(quote ,name))))
|
||||||
(error who "the enclosing module's resolved name is not a path or predefined"))
|
(error who "the enclosing module's resolved name is not a path or predefined"))
|
||||||
(start-place-func who (if (symbol? name) `(quote ,name) name) func-name in out err))
|
(start-place-func who (if (symbol? name) `(quote ,name) name) func-name in out err))
|
||||||
|
|
||||||
|
(define-syntax (open-place stx)
|
||||||
|
(syntax-parse stx
|
||||||
|
[(_ ch:id body:expr ...)
|
||||||
|
(define b #'(let () body ...))
|
||||||
|
(define/with-syntax b* (local-expand b 'expression null))
|
||||||
|
(define/with-syntax (fvs ...) (free-vars #'b*))
|
||||||
|
(define/with-syntax (i ...) (for/list ([(v i) (in-indexed (syntax->list #'(fvs ...)))]) i))
|
||||||
|
(define/with-syntax (v p) (generate-temporaries '(v p)))
|
||||||
|
#'(let ()
|
||||||
|
(define p (place ch (let* ([v (place-channel-get ch)]
|
||||||
|
[fvs (vector-ref v i)] ...)
|
||||||
|
b*)))
|
||||||
|
(define vec (vector fvs ...))
|
||||||
|
(for ([e (in-vector vec)]
|
||||||
|
[n (in-list (syntax->list (quote-syntax (fvs ...))))])
|
||||||
|
(unless (place-message-allowed? e)
|
||||||
|
(raise-arguments-error 'open-place
|
||||||
|
"free variable values must be allowable as place messages"
|
||||||
|
(symbol->string (syntax-e n)) e)))
|
||||||
|
(place-channel-put p vec)
|
||||||
|
p)]))
|
||||||
|
|
Loading…
Reference in New Issue
Block a user