fix problems with non-parallel places
The implementation of message passing in thread-simulated places had not kept up with the parallel implementation.
This commit is contained in:
parent
885382e12e
commit
f21280e24d
|
@ -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
|
||||||
[(hash-equal? o)
|
o
|
||||||
(for/fold ([nh (hash)]) ([p (in-hash-pairs o)])
|
(lambda ()
|
||||||
(hash-set nh (dcw (car p)) (dcw (cdr p))))]
|
(cons (dcw (car o)) (dcw (cdr o)))))]
|
||||||
[(hash-eq? o)
|
[(vector? o)
|
||||||
(for/fold ([nh (hasheq)]) ([p (in-hash-pairs o)])
|
(vector-map! dcw (record o (vector-copy o)))]
|
||||||
(hash-set nh (dcw (car p)) (dcw (cdr p))))]
|
[(hash? o)
|
||||||
[(hash-eqv? o)
|
(with-placeholder
|
||||||
(for/fold ([nh (hasheqv)]) ([p (in-hash-pairs o)])
|
o
|
||||||
(hash-set nh (dcw (car p)) (dcw (cdr p))))]
|
(lambda ()
|
||||||
[(struct? o)
|
(cond
|
||||||
(define key (prefab-struct-key o))
|
[(hash-equal? o)
|
||||||
(when (not key)
|
(for/fold ([nh (hash)]) ([p (in-hash-pairs o)])
|
||||||
(error "Must be a prefab struct"))
|
(hash-set nh (dcw (car p)) (dcw (cdr p))))]
|
||||||
(apply make-prefab-struct
|
[(hash-eq? o)
|
||||||
key
|
(for/fold ([nh (hasheq)]) ([p (in-hash-pairs o)])
|
||||||
(map dcw (cdr (vector->list (struct->vector o)))))]
|
(hash-set nh (dcw (car p)) (dcw (cdr p))))]
|
||||||
|
[else ; (hash-eqv? o)
|
||||||
|
(for/fold ([nh (hasheqv)]) ([p (in-hash-pairs o)])
|
||||||
|
(hash-set nh (dcw (car p)) (dcw (cdr p))))])))]
|
||||||
|
[(and (struct? o)
|
||||||
|
(prefab-struct-key o))
|
||||||
|
=>
|
||||||
|
(lambda (key)
|
||||||
|
(with-placeholder
|
||||||
|
o
|
||||||
|
(lambda ()
|
||||||
|
(apply make-prefab-struct
|
||||||
|
key
|
||||||
|
(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)
|
||||||
|
|
|
@ -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)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user