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

allow the interposition procedures to all be #f in chaperone-hash-set and impersonate-hash-set

Browse Source
This commit is contained in:
Robby Findler 2015-12-27 21:02:20 -06:00
parent 8f2874e4b5
commit bc12019af4
3 changed files with 71 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
pkgs/racket-doc/scribblings/reference/sets.scrbl
View File

@ -696,9 +696,9 @@ Supported for any @racket[st] that @supp{supports} @racket[set->stream].
}
@defproc[(impersonate-hash-set [st mutable-set?]
[ref-proc (-> set? any/c any/c)]
[add-proc (-> set? any/c any/c)]
[remove-proc (-> set? any/c any/c)]
[ref-proc (or/c #f (-> set? any/c any/c))]
[add-proc (or/c #f (-> set? any/c any/c))]
[remove-proc (or/c #f (-> set? any/c any/c))]
[clear-proc (or/c #f (-> set? any)) #f]
[prop impersonator-property?]
[prop-val any/c] ... ...)
@ -719,6 +719,10 @@ Supported for any @racket[st] that @supp{supports} @racket[set->stream].
element being removed. The result of the procedure is the element that actually
gets removed from the set.
If any of the @racket[ref-proc], @racket[add-proc], or @racket[remove-proc] arguments
is @racket[#f], then all three must be and there must be at least one property supplied.
In that case, a more efficient chaperone wrapper is created.
If @racket[clear-proc] is not @racket[#f], it must accept @racket[set] as
an argument and is result is ignored. The fact that @racket[clear-proc]
returns (as opposed to raising an exception or otherwise escaping) grants the
@ -734,9 +738,9 @@ Supported for any @racket[st] that @supp{supports} @racket[set->stream].
}
@defproc[(chaperone-hash-set [st (or/c set? mutable-set?)]
[ref-proc (-> set? any/c any/c)]
[add-proc (-> set? any/c any/c)]
[remove-proc (-> set? any/c any/c)]
[ref-proc (or/c #f (-> set? any/c any/c))]
[add-proc (or/c #f (-> set? any/c any/c))]
[remove-proc (or/c #f (-> set? any/c any/c))]
[clear-proc (or/c #f (-> set? any)) #f]
[prop impersonator-property?]
[prop-val any/c] ... ...)

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

@ -658,4 +658,14 @@
impersonator-prop:p 11)])
(test 11 get-impersonator-prop:p s)))
(let-values ([(impersonator-prop:p has-impersonator-prop:p? get-impersonator-prop:p)
(make-impersonator-property 'p)])
(let ([s (chaperone-hash-set (set) #f #f #f impersonator-prop:p 11)])
(test #t has-impersonator-prop:p? s)))
(let-values ([(impersonator-prop:p has-impersonator-prop:p? get-impersonator-prop:p)
(make-impersonator-property 'p)])
(let ([s (impersonate-hash-set (mutable-set) #f #f #f impersonator-prop:p 11)])
(test 11 get-impersonator-prop:p s)))
(report-errs)

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

@ -358,6 +358,7 @@
who original new))
new)
(add-impersonator-properties
(if ref-proc
(update-custom-set-table
s
(chaperone-hash
@ -371,6 +372,7 @@
(λ (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)
prop-args))
(define (impersonate-hash-set s
@ -387,15 +389,18 @@
remove-proc
clear-proc+props))
(add-impersonator-properties
(if ref-proc
(update-custom-set-table
s
(impersonate-hash
(custom-set-table s)
(λ (hash key) (values (ref-proc (update-custom-set-table s hash) key) (λ (hash key val) val)))
(λ (hash key) (values (ref-proc (update-custom-set-table s hash) key)
(λ (hash key val) val)))
(λ (hash key val) (values (add-proc (update-custom-set-table s hash) key) val))
(λ (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)
prop-args))
(define (add-impersonator-properties without-props prop-args)
@ -425,24 +430,34 @@
'(or/c set-mutable? set-weak?)
'(or/c set? set-mutable? set-weak?)))
0 s ref-proc add-proc clear-proc+props))
(unless (and (procedure? ref-proc)
(procedure-arity-includes? ref-proc 2))
(unless (or (not ref-proc)
(and (procedure? ref-proc)
(procedure-arity-includes? ref-proc 2)))
(apply raise-argument-error
who
"(procedure-arity-includes/c 2)"
"(or/c #f (procedure-arity-includes/c 2))"
1 s ref-proc add-proc clear-proc+props))
(unless (and (procedure? add-proc)
(procedure-arity-includes? add-proc 2))
(unless (or (not add-proc)
(and (procedure? add-proc)
(procedure-arity-includes? add-proc 2)))
(apply raise-argument-error
who
"(procedure-arity-includes/c 2)"
"(or/c #f (procedure-arity-includes/c 2))"
2 s ref-proc add-proc clear-proc+props))
(unless (and (procedure? remove-proc)
(procedure-arity-includes? remove-proc 2))
(unless (or (not remove-proc)
(and (procedure? remove-proc)
(procedure-arity-includes? remove-proc 2)))
(apply raise-argument-error
who
"(procedure-arity-includes/c 2)"
"(or/c #f (procedure-arity-includes/c 2))"
3 s ref-proc add-proc clear-proc+props))
(when (or (not ref-proc) (not add-proc) (not remove-proc))
(unless (and (not ref-proc) (not add-proc) (not remove-proc))
(raise-arguments-error who
"if one of ref-proc, add-proc, or remove-proc is #f, they must all be"
"ref-proc" ref-proc
"add-proc" add-proc
"remove-proc" remove-proc)))
(unless (null? clear-proc+props)
(unless (or (not (car clear-proc+props))
(and (procedure? (car clear-proc+props))
@ -472,6 +487,11 @@
"impersonator-property?"
(+ i (if supplied-clear-proc? 1 0) 4)
s ref-proc add-proc clear-proc+props)))
(unless ref-proc
(when (null? args)
(raise-arguments-error
who
"when ref-proc, add-proc, and remove-proc are #f, at least one property must be supplied")))
(values clear-proc args))
(define (set-check-compatible name s1 s2)