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

fix some bugs in the traversal function in any-wrap that I introduced

Browse Source 
Also, rename the function so that errors like this don't take me as long to find
This commit is contained in:
Robby Findler 2013-12-12 22:37:11 -06:00
parent ecc1facdaa
commit 1f1550ae55
1 changed files with 15 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/utils/any-wrap.rkt
View File

@ -30,13 +30,13 @@
;; field is immutable ;; field is immutable
(values (values
(list* (make-struct-field-accessor ref n) (list* (make-struct-field-accessor ref n)
(lambda (s v) (t v)) (lambda (s v) (any-wrap/traverse neg-party v))
res) res)
(cdr imms)) (cdr imms))
;; field is mutable ;; field is mutable
(values (values
(list* (make-struct-field-accessor ref n) (list* (make-struct-field-accessor ref n)
(lambda (s v) (t v)) (lambda (s v) (any-wrap/traverse neg-party v))
(make-struct-field-mutator set! n) (make-struct-field-mutator set! n)
(lambda (s v) (fail neg-party s)) (lambda (s v) (fail neg-party s))
res) res)
@ -48,17 +48,17 @@
(when skipped? (fail neg-party s)); "Opaque struct type!" (when skipped? (fail neg-party s)); "Opaque struct type!"
(apply chaperone-struct s (extract-functions type))) (apply chaperone-struct s (extract-functions type)))
(define (t neg-party v) (define (any-wrap/traverse neg-party v)
(match v (match v
[(? base-val?) [(? base-val?)
v] v]
[(cons x y) (cons (t neg-party x) (t neg-party y))] [(cons x y) (cons (any-wrap/traverse neg-party x) (any-wrap/traverse neg-party y))]
[(? vector? (? immutable?)) [(? vector? (? immutable?))
;; fixme -- should have an immutable for/vector ;; fixme -- should have an immutable for/vector
(vector->immutable-vector (vector->immutable-vector
(for/vector #:length (vector-length v) (for/vector #:length (vector-length v)
([i (in-vector v)]) (t neg-party i)))] ([i (in-vector v)]) (any-wrap/traverse neg-party i)))]
[(? box? (? immutable?)) (box-immutable (t neg-party (unbox v)))] [(? box? (? immutable?)) (box-immutable (any-wrap/traverse neg-party (unbox v)))]
;; fixme -- handling keys properly makes it not a chaperone ;; fixme -- handling keys properly makes it not a chaperone
;; [(? hasheq? (? immutable?)) ;; [(? hasheq? (? immutable?))
;; (for/hasheq ([(k v) (in-hash v)]) (values k v))] ;; (for/hasheq ([(k v) (in-hash v)]) (values k v))]
@ -68,25 +68,26 @@
[(? (λ (e) [(? (λ (e)
(and (hash? e) (immutable? e) (and (hash? e) (immutable? e)
(not (hash-eqv? e)) (not (hash-eq? e))))) (not (hash-eqv? e)) (not (hash-eq? e)))))
(for/hash ([(k v) (in-hash v)]) (values (t neg-party k) (t neg-party v)))] (for/hash ([(k v) (in-hash v)]) (values (any-wrap/traverse neg-party k)
(any-wrap/traverse neg-party v)))]
[(? vector?) (chaperone-vector v [(? vector?) (chaperone-vector v
(lambda (v i e) (t neg-party e)) (lambda (v i e) (any-wrap/traverse neg-party e))
(lambda (v i e) (fail neg-party v)))] (lambda (v i e) (fail neg-party v)))]
[(? box?) (chaperone-box v [(? box?) (chaperone-box v
(lambda (v e) (t neg-party e)) (lambda (v e) (any-wrap/traverse neg-party e))
(lambda (v e) (fail neg-party v)))] (lambda (v e) (fail neg-party v)))]
[(? hash?) (chaperone-hash v [(? hash?) (chaperone-hash v
(lambda (h k) (lambda (h k)
(values k (lambda (h k v) (t neg-party v)))) ;; ref (values k (lambda (h k v) (any-wrap/traverse neg-party v)))) ;; ref
(lambda (h k n) (lambda (h k n)
(if (immutable? v) (if (immutable? v)
(values k n) (values k n)
(fail neg-party v))) ;; set (fail neg-party v))) ;; set
(lambda (h v) v) ;; remove (lambda (h v) v) ;; remove
(lambda (h k) (t neg-party k)))] ;; key (lambda (h k) (any-wrap/traverse neg-party k)))] ;; key
[(? evt?) (chaperone-evt v (lambda (e) (values e t)))] [(? evt?) (chaperone-evt v (lambda (e) (values e (λ (v) (any-wrap/traverse neg-party v)))))]
[(? set?) [(? set?)
(for/set ([i (in-set v)]) (t neg-party i))] (for/set ([i (in-set v)]) (any-wrap/traverse neg-party i))]
;; could do something with generic sets here if they had ;; could do something with generic sets here if they had
;; chaperones, or if i could tell if they were immutable. ;; chaperones, or if i could tell if they were immutable.
[(? struct?) (wrap-struct neg-party v)] [(? struct?) (wrap-struct neg-party v)]
@ -100,7 +101,7 @@
(contract (promise/c any-wrap/c) v (contract (promise/c any-wrap/c) v
(blame-positive b) (blame-negative b))] (blame-positive b) (blame-negative b))]
[_ (fail neg-party v)])) [_ (fail neg-party v)]))
(λ (v) (λ (neg-party) (t neg-party v)))) (λ (v) (λ (neg-party) (any-wrap/traverse neg-party v))))
(define any-wrap/c (define any-wrap/c
(make-chaperone-contract (make-chaperone-contract