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

fix problems with non-parallel places

Browse Source 
The implementation of message passing in thread-simulated
places had not kept up with the parallel implementation.
This commit is contained in:
Matthew Flatt 2012-11-05 08:20:32 -07:00
parent 885382e12e
commit f21280e24d
2 changed files with 52 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
collects/racket/place/private/th-place.rkt
View File

@ -70,38 +70,63 @@
(values pch cch)) (values pch cch))
(define (deep-copy x) (define (deep-copy x)
(define ht (make-hasheq))
(define (record v new-v)
(hash-set! ht v new-v)
new-v)
(define (with-placeholder o mk)
(define ph (make-placeholder #f))
(hash-set! ht o ph)
(define new-o (mk))
(placeholder-set! ph new-o)
new-o)
(define (dcw o) (define (dcw o)
(cond (cond
[(ormap (lambda (x) (x o)) (list number? char? boolean? null? void? string? symbol? TH-place-channel?)) o] [(ormap (lambda (x) (x o)) (list number? char? boolean? null? void? string? symbol? TH-place-channel?)) o]
[(hash-ref ht o #f)
=> values]
[(cond [(cond
[(path? o) (path->bytes o)] [(path-for-some-system? o) o]
[(bytes? o) (if (pl-place-shared? o) o (bytes-copy o))] [(bytes? o) (if (pl-place-shared? o) o (record o (bytes-copy o)))]
[(fxvector? o) (if (pl-place-shared? o) o (fxvector-copy o))] [(fxvector? o) (if (pl-place-shared? o) o (record o (fxvector-copy o)))]
[(flvector? o) (if (pl-place-shared? o) o (flvector-copy o))] [(flvector? o) (if (pl-place-shared? o) o (record o (flvector-copy o)))]
[else #f]) [else #f])
=> values] => values]
[(TH-place? o) (dcw (TH-place-ch o))] [(TH-place? o) (dcw (TH-place-ch o))]
[(pair? o) (cons (dcw (car o)) (dcw (cdr o)))] [(pair? o)
[(vector? o) (vector-map! dcw (vector-copy o))] (with-placeholder
o
(lambda ()
(cons (dcw (car o)) (dcw (cdr o)))))]
[(vector? o)
(vector-map! dcw (record o (vector-copy o)))]
[(hash? o)
(with-placeholder
o
(lambda ()
(cond
[(hash-equal? o) [(hash-equal? o)
(for/fold ([nh (hash)]) ([p (in-hash-pairs o)]) (for/fold ([nh (hash)]) ([p (in-hash-pairs o)])
(hash-set nh (dcw (car p)) (dcw (cdr p))))] (hash-set nh (dcw (car p)) (dcw (cdr p))))]
[(hash-eq? o) [(hash-eq? o)
(for/fold ([nh (hasheq)]) ([p (in-hash-pairs o)]) (for/fold ([nh (hasheq)]) ([p (in-hash-pairs o)])
(hash-set nh (dcw (car p)) (dcw (cdr p))))] (hash-set nh (dcw (car p)) (dcw (cdr p))))]
[(hash-eqv? o) [else ; (hash-eqv? o)
(for/fold ([nh (hasheqv)]) ([p (in-hash-pairs o)]) (for/fold ([nh (hasheqv)]) ([p (in-hash-pairs o)])
(hash-set nh (dcw (car p)) (dcw (cdr p))))] (hash-set nh (dcw (car p)) (dcw (cdr p))))])))]
[(struct? o) [(and (struct? o)
(define key (prefab-struct-key o)) (prefab-struct-key o))
(when (not key) =>
(error "Must be a prefab struct")) (lambda (key)
(with-placeholder
o
(lambda ()
(apply make-prefab-struct (apply make-prefab-struct
key key
(map dcw (cdr (vector->list (struct->vector o)))))] (map dcw (cdr (vector->list (struct->vector o))))))))]
[else (raise-mismatch-error 'place-channel-put "cannot transmit a message containing value: " o)])) [else (raise-mismatch-error 'place-channel-put "cannot transmit a message containing value: " o)]))
(dcw x)) (make-reader-graph (dcw x)))
(define (th-place-channel-put pl msg) (define (th-place-channel-put pl msg)

4
collects/tests/racket/place-channel.rkt
View File

@ -89,6 +89,8 @@
(make-immutable-hash l1) (make-immutable-hash l1)
(make-immutable-hasheq l2) (make-immutable-hasheq l2)
(make-immutable-hasheqv l3) (make-immutable-hasheqv l3)
(bytes->path x 'unix)
(bytes->path x 'windows)
))) )))
(define (channel-test-basic-types-master sender ch) (define (channel-test-basic-types-master sender ch)
@ -115,6 +117,8 @@
((make-hash l1) (make-immutable-hash l1)) ((make-hash l1) (make-immutable-hash l1))
((make-hasheq l2) (make-immutable-hasheq l2)) ((make-hasheq l2) (make-immutable-hasheq l2))
((make-hasheqv l3) (make-immutable-hasheqv l3)) ((make-hasheqv l3) (make-immutable-hasheqv l3))
(#"/tmp/unix" (bytes->path #"/tmp/unix" 'unix))
(#"C:\\Windows" (bytes->path #"C:\\Windows" 'windows))
)) ))
(define-place (place-worker ch) (define-place (place-worker ch)