[Places] place/anon place/thunk
This commit is contained in:
parent
bd1c47cce1
commit
7134b95ff1
|
@ -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 ...))]))
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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))
|
||||
|
||||
|
|
Loading…
Reference in New Issue
Block a user