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

fix chaperone-hash-set and impersonate-hash-set for custom-set-types

Browse Source
This commit is contained in:
Robby Findler 2015-12-28 16:58:08 -06:00
parent e08188aeda
commit 50405a2ca9
2 changed files with 109 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
pkgs/racket-test-core/tests/racket/set.rktl
View File

@ -636,6 +636,37 @@
(λ (s e) (+ e 1)) (λ (s e) (+ e 1))
(λ (s l) l) (λ (s l) l)
(λ (s l) l)))) (λ (s l) l))))
(test #t zero?
(let ([ele #f])
(set-first (impersonate-hash-set (weak-set 0)
(λ (s e) (set! ele e))
(λ (s l) l)
(λ (s l) l)))
ele))
(test #t zero?
(let ([ele #f])
(define-custom-set-types set2 equal? equal-hash-code)
(define ele #f)
(set-first
(chaperone-hash-set (set-add (make-immutable-set2) 0)
(λ (s e) (set! ele e) e)
(λ (s l) l)
(λ (s l) l)))
ele))
(test #t zero?
(let ([ele #f])
(define-custom-set-types set2 equal? equal-hash-code)
(define ele #f)
(define s (make-weak-set2))
(set-add! s 0)
(set-first
(impersonate-hash-set s
(λ (s e) (set! ele e) e)
(λ (s l) l)
(λ (s l) l)))
ele))
(let-values ([(impersonator-prop:p has-impersonator-prop:p? get-impersonator-prop:p) (let-values ([(impersonator-prop:p has-impersonator-prop:p? get-impersonator-prop:p)
(make-impersonator-property 'p)]) (make-impersonator-property 'p)])
(let ([s (chaperone-hash-set (set) (λ (s l) l) (λ (s l) l) (λ (s l) l) impersonator-prop:p 11)]) (let ([s (chaperone-hash-set (set) (λ (s l) l) (λ (s l) l) (λ (s l) l) impersonator-prop:p 11)])

102
racket/collects/racket/private/set-types.rkt
View File

@ -357,24 +357,67 @@
"~s did not return a chaperone of ~e, got ~e" "~s did not return a chaperone of ~e, got ~e"
who original new)) who original new))
new) new)
(define (chaperone-hash-set-hash-ref-proc hash key)
(values (check-it 'ref-proc key (ref-proc (update-custom-set-table s hash) key))
(λ (hash key val) val)))
(define (chaperone-hash-set-hash-set-proc hash key val)
(values (check-it 'add-proc key (add-proc (update-custom-set-table s hash) key))
val))
(define (chaperone-hash-set-hash-remove-proc hash key)
(check-it 'remove-proc key (remove-proc (update-custom-set-table s hash) key)))
(define (chaperone-hash-set-hash-key-proc hash key)
(check-it 'ref-proc key (ref-proc (update-custom-set-table s hash) key)))
(define chaperone-hash-set-hash-clear-proc
(and clear-proc (λ (hash) (clear-proc (update-custom-set-table s hash)))))
(add-impersonator-properties (add-impersonator-properties
(if ref-proc (if ref-proc
(update-custom-set-table (chap-or-imp-hash-set s
s chaperone-hash
(chaperone-hash chaperone-hash-set-hash-ref-proc
(custom-set-table s) chaperone-hash-set-hash-set-proc
(λ (hash key) chaperone-hash-set-hash-remove-proc
(values (check-it 'ref-proc key (ref-proc (update-custom-set-table s hash) key)) chaperone-hash-set-hash-key-proc
(λ (hash key val) val))) chaperone-hash-set-hash-clear-proc)
(λ (hash key val)
(values (check-it 'add-proc key (add-proc (update-custom-set-table s hash) key))
val))
(λ (hash key) (check-it 'remove-proc key (remove-proc (update-custom-set-table s hash) key)))
(λ (hash key) (check-it 'ref-proc key (ref-proc (update-custom-set-table s hash) key)))
(and clear-proc (λ (hash) (clear-proc (update-custom-set-table s hash))))))
s) s)
prop-args)) prop-args))
(define (chap-or-imp-hash-set s
chaperone-or-impersonate-hash
c/i-hash-set-hash-ref-proc
c/i-hash-set-hash-set-proc
c/i-hash-set-hash-remove-proc
c/i-hash-set-hash-key-proc
c/i-hash-set-hash-clear-proc)
(define rewrap
(and (custom-set-spec s)
(custom-spec-wrap (custom-set-spec s))))
(update-custom-set-table
s
(if (custom-set-spec s)
(chaperone-or-impersonate-hash
(custom-set-table s)
(λ (hash key)
(define-values (a b)
(c/i-hash-set-hash-ref-proc hash (custom-elem-contents key)))
(values (rewrap a) b))
(λ (hash key val)
(define-values (a b)
(c/i-hash-set-hash-set-proc hash key (custom-elem-contents key)))
(values (rewrap a) b))
(λ (hash key)
(rewrap (c/i-hash-set-hash-remove-proc hash (custom-elem-contents key))))
(λ (hash key)
(rewrap (c/i-hash-set-hash-key-proc hash (custom-elem-contents key))))
c/i-hash-set-hash-clear-proc)
(chaperone-or-impersonate-hash
(custom-set-table s)
c/i-hash-set-hash-ref-proc
c/i-hash-set-hash-set-proc
c/i-hash-set-hash-remove-proc
c/i-hash-set-hash-key-proc
c/i-hash-set-hash-clear-proc))))
(define (impersonate-hash-set s (define (impersonate-hash-set s
ref-proc ref-proc
add-proc add-proc
@ -388,18 +431,29 @@
add-proc add-proc
remove-proc remove-proc
clear-proc+props)) clear-proc+props))
(define impersonate-hash-set-hash-ref-proc
(λ (hash key) (values (ref-proc (update-custom-set-table s hash) key)
(λ (hash key val) val))))
(define impersonate-hash-set-hash-set-proc
(λ (hash key val) (values (add-proc (update-custom-set-table s hash) key) val)))
(define impersonate-hash-set-hash-remove-proc
(λ (hash key) (remove-proc (update-custom-set-table s hash) key)))
(define impersonate-hash-set-hash-key-proc
(λ (hash key) (ref-proc (update-custom-set-table s hash) key)))
(define impersonate-hash-set-hash-clear-proc
(and clear-proc (λ (hash) (clear-proc (update-custom-set-table s hash)))))
(define rewrap
(and (custom-set-spec s)
(custom-spec-wrap (custom-set-spec s))))
(add-impersonator-properties (add-impersonator-properties
(if ref-proc (if ref-proc
(update-custom-set-table (chap-or-imp-hash-set s
s impersonate-hash
(impersonate-hash impersonate-hash-set-hash-ref-proc
(custom-set-table s) impersonate-hash-set-hash-set-proc
(λ (hash key) (values (ref-proc (update-custom-set-table s hash) key) impersonate-hash-set-hash-remove-proc
(λ (hash key val) val))) impersonate-hash-set-hash-key-proc
(λ (hash key val) (values (add-proc (update-custom-set-table s hash) key) val)) impersonate-hash-set-hash-clear-proc)
(λ (hash key) (remove-proc (update-custom-set-table s hash) key))
(λ (hash key) (ref-proc (update-custom-set-table s hash) key))
(and clear-proc (λ (hash) (clear-proc (update-custom-set-table s hash))))))
s) s)
prop-args)) prop-args))
@ -547,7 +601,7 @@
(sequence-map custom-elem-contents keys) (sequence-map custom-elem-contents keys)
keys)) keys))
(struct custom-elem [contents]) (struct custom-elem [contents] #:transparent)
(struct custom-spec [elem? wrap intern]) (struct custom-spec [elem? wrap intern])