suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Bind channel properly in place/context.

Browse Source 
Closes #1169.
This commit is contained in:
Sam Tobin-Hochstadt 2015-12-15 14:26:00 -05:00
parent 074202bdd2
commit e5c5feca6d
3 changed files with 13 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
pkgs/racket-test-core/tests/racket/place-utils.rkt
View File

@ -87,3 +87,10 @@
|# |#
])) ]))
(module place-test-submod racket/base
(require racket/place)
(provide p)
(define (p x)
(place-channel-get (place/context ch
(place-channel-put ch x)))))

4
pkgs/racket-test-core/tests/racket/place.rktl
View File

@ -102,4 +102,8 @@
(test (not (place-enabled?)) place-message-allowed? (cons v 1)) (test (not (place-enabled?)) place-message-allowed? (cons v 1))
(test (not (place-enabled?)) place-message-allowed? (vector v))) (test (not (place-enabled?)) place-message-allowed? (vector v)))
(require (submod "place-utils.rkt" place-test-submod))
(test 0 p 0)
(report-errs) (report-errs)

4
racket/collects/racket/place.rkt
View File

@ -238,7 +238,7 @@
(define-syntax (place/context stx) (define-syntax (place/context stx)
(syntax-parse stx (syntax-parse stx
[(_ ch:id body:expr ...) [(_ ch:id body:expr ...)
(define b #'(let () body ...)) (define b #'(lambda (ch) body ...))
(define/with-syntax b* (local-expand b 'expression null)) (define/with-syntax b* (local-expand b 'expression null))
(define/with-syntax (fvs ...) (free-vars #'b*)) (define/with-syntax (fvs ...) (free-vars #'b*))
(define/with-syntax (i ...) (for/list ([(v i) (in-indexed (syntax->list #'(fvs ...)))]) i)) (define/with-syntax (i ...) (for/list ([(v i) (in-indexed (syntax->list #'(fvs ...)))]) i))
@ -246,7 +246,7 @@
#'(let () #'(let ()
(define p (place ch (let* ([v (place-channel-get ch)] (define p (place ch (let* ([v (place-channel-get ch)]
[fvs (vector-ref v i)] ...) [fvs (vector-ref v i)] ...)
b*))) (b* ch))))
(define vec (vector fvs ...)) (define vec (vector fvs ...))
(for ([e (in-vector vec)] (for ([e (in-vector vec)]
[n (in-list (syntax->list (quote-syntax (fvs ...))))]) [n (in-list (syntax->list (quote-syntax (fvs ...))))])