[Places] place/anon place/thunk

This commit is contained in:
Kevin Tew 2011-04-22 14:13:06 -06:00
parent bd1c47cce1
commit 7134b95ff1
3 changed files with 54 additions and 26 deletions

View File

@ -6,7 +6,8 @@
'#%place-struct
racket/fixnum
racket/flonum
racket/vector)
racket/vector
(for-syntax racket/base))
(provide place
place-sleep
@ -19,6 +20,9 @@
place?
place-channel-send/receive
processor-count
place/anon
place/thunk
define-place
(rename-out [pl-place-enabled? place-enabled?]))
(define-struct TH-place (th ch cust)
@ -124,3 +128,33 @@
(define-pl place-channel-receive pl-place-channel-receive th-place-channel-receive)
(define-pl place-channel? pl-place-channel? th-place-channel?)
(define-pl place? pl-place? TH-place?)
(define-syntax-rule (define-syntax-case (N a ...) b ...)
(define-syntax (N stx)
(syntax-case stx ()
[(_ a ...) b ...])))
(define-for-syntax (gen-create-place stx)
(syntax-case stx ()
[(_ ch body ...)
(with-syntax ([interal-def-name
(syntax-local-lift-expression #'(lambda (ch) body ...))]
[funcname #'OBSCURE_FUNC_NAME_%#%])
(syntax-local-lift-provide #'(rename interal-def-name funcname))
#'(let ([module-path (resolved-module-path-name
(variable-reference->resolved-module-path
(#%variable-reference)))])
(place module-path (quote funcname))))]))
(define-syntax (place/thunk stx)
(with-syntax ([create-place (gen-create-place stx)])
#'(lambda () create-place)))
(define-syntax (place/anon stx)
(gen-create-place stx))
(define-syntax (define-place stx)
(syntax-case stx ()
[(_ (name ch) body ...)
#'(define name (place/thunk ch body ...))]))

View File

@ -127,6 +127,25 @@ racket
Terminates the place indicated by @racket[p],
}
@defform[(place/thunk place-channel? body ...)]{
In-line definition of a place worker body, which is lifted up to module scope.
@racket[place/thunk] closes over only module scope variables.
Returns a thunk for creating the described place.
}
@defform[(place/anon place-channel? body ...)]{
In-line definition of a place worker body, which is lifted up to module scope.
@racket[place/anon] closes over only module scope variables.
Returns the place descriptor for the newly constructed place.
}
@defform[(define-place (place-name-id place-channel-id) body ...)]{
In-line definition of a place worker body, which is lifted up to module scope.
@racket[define-place] closes over only module scope variables.
Defines a procedure for creating the described place.
}
@defproc[(place-channel) (values place-channel? place-channel?)]{
Returns two @tech{place channels}. Data sent through the first

View File

@ -371,28 +371,3 @@
(define module-path (path->string (resolved-module-path-name (variable-reference->resolved-module-path (#%variable-reference)))))
(parallel-do-event-loop module-path 'name initalmsg wq worker-count)
(queue/results wq))]))
(define-syntax-rule (define-syntax-case (N a ...) b ...)
(define-syntax (N stx)
(syntax-case stx ()
[(_ a ...) b ...])))
(define-for-syntax (gen-create-place stx)
(syntax-case stx ()
[(_ ch body ...)
(with-syntax ([interal-def-name
(syntax-local-lift-expression #'(lambda (ch) body ...))]
[funcname #'OBSCURE_FUNC_NAME_%#%])
(syntax-local-lift-provide #'(rename interal-def-name funcname))
#'(let ([module-path (resolved-module-path-name
(variable-reference->resolved-module-path
(#%variable-reference)))])
(place module-path (quote funcname))))]))
(define-syntax (place/thunk stx)
(with-syntax ([create-place (gen-create-place stx)])
#'(lambda () create-place)))
(define-syntax (place/anon stx)
(gen-create-place stx))