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

Add faster non-generic in-*-set sequences

Browse Source 
closes #1217
This commit is contained in:
Stephen Chang 2016-01-20 10:49:58 -05:00
parent 5b37bac183
commit 5ffe007f5c
4 changed files with 122 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -153,6 +153,24 @@ Analogous to @racket[for/list] and @racket[for*/list], but to
construct a @tech{hash set} instead of a list.
}
@deftogether[(
@defproc[(in-immutable-set [st set?]) sequence?]
@defproc[(in-mutable-set [st set-mutable?]) sequence?]
@defproc[(in-weak-set [st set-weak?]) sequence?]
)]{
Explicitly converts a specific kind of @tech{hash set} to a sequence for
use with @racket[for] forms.
As with @racket[in-list] and some other sequence constructors,
@racket[in-immutable-set] is more performant when it appears directly in a
@racket[for] clause.
These sequence constructors are compatible with
@secref["Custom_Hash_Sets" #:doc '(lib "scribblings/reference/reference.scrbl")].
}
@section{Set Predicates and Contracts}
@defproc[(generic-set? [v any/c]) boolean?]{

39
pkgs/racket-test-core/tests/racket/for.rktl
View File

@ -549,5 +549,44 @@
;; for/fold syntax checking
(syntax-test #'(for/fold () bad 1) #rx".*bad sequence binding clauses.*")
;; specific hash set iterators
(err/rt-test (for/sum ([x (in-immutable-set '(1 2))]) x)
exn:fail:contract?
#rx"not a hash set")
(err/rt-test (for/sum ([x (in-mutable-set '(1 2))]) x)
exn:fail:contract?
#rx"not a hash set")
(err/rt-test (for/sum ([x (in-weak-set '(1 2))]) x)
exn:fail:contract?
#rx"not a hash set")
(test 10 'in-hash-set (for/sum ([x (in-immutable-set (set 1 2 3 4))]) x))
(test 10 'in-hash-set (for/sum ([x (in-mutable-set (mutable-set 1 2 3 4))]) x))
(test 10 'in-hash-set (for/sum ([x (in-weak-set (weak-set 1 2 3 4))]) x))
(test 10 'in-hash-set (for/sum ([x (in-immutable-set (seteqv 1 2 3 4))]) x))
(test 10 'in-hash-set (for/sum ([x (in-mutable-set (mutable-seteqv 1 2 3 4))]) x))
(test 10 'in-hash-set (for/sum ([x (in-weak-set (weak-seteqv 1 2 3 4))]) x))
(test 10 'in-hash-set (for/sum ([x (in-immutable-set (seteq 1 2 3 4))]) x))
(test 10 'in-hash-set (for/sum ([x (in-mutable-set (mutable-seteq 1 2 3 4))]) x))
(test 10 'in-hash-set (for/sum ([x (in-weak-set (weak-seteq 1 2 3 4))]) x))
(test 10 'in-hash-set (for/sum ([x (in-immutable-set (list->set '(1 2 3 4)))]) x))
(test 10 'in-hash-set (for/sum ([x (in-mutable-set (list->mutable-set '(1 2 3 4)))]) x))
(test 10 'in-hash-set (for/sum ([x (in-weak-set (list->weak-set '(1 2 3 4)))]) x))
(test 30 'custom-in-hash-set
(let ()
(define-custom-set-types pos-set
#:elem? positive?
(λ (x y recur) (+ x y))
(λ (x recur) x))
(define imm
(make-immutable-pos-set '(1 2 3 4)))
(define m
(make-mutable-pos-set '(1 2 3 4)))
(define w
(make-weak-pos-set '(1 2 3 4)))
(+ (for/sum ([x (in-immutable-set imm)]) x)
(for/sum ([x (in-mutable-set m)]) x)
(for/sum ([x (in-weak-set w)]) x))))
(report-errs)

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

@ -5,6 +5,7 @@
racket/serialize
racket/pretty
racket/sequence
racket/unsafe/ops
(only-in racket/syntax format-symbol)
(only-in racket/generic exn:fail:support)
(for-syntax racket/base racket/syntax))
@ -30,6 +31,10 @@
make-weak-custom-set
make-mutable-custom-set
in-immutable-set
in-mutable-set
in-weak-set
chaperone-hash-set
impersonate-hash-set)
@ -576,6 +581,63 @@
(sequence-map custom-elem-contents keys)
keys))
(define (custom-in-set/checked s)
(unless (custom-set? s)
(raise (exn:fail:contract (format "not a hash set: ~a" s)
(current-continuation-marks))))
(custom-in-set s))
(define (set-immutable? s) (set? s))
;; creates an new id with the given id and format str
(define-for-syntax (mk-id id fmt-str)
(datum->syntax id (string->symbol (format fmt-str (syntax->datum id)))))
(define-syntax (define-in-set-sequence-syntax stx)
(syntax-case stx (set-type:)
[(_ set-type: SETTYPE)
(with-syntax
([IN-SET-NAME (mk-id #'SETTYPE "in-~a-set")]
[-first (mk-id #'SETTYPE "unsafe-~a-hash-iterate-first")]
[-next (mk-id #'SETTYPE "unsafe-~a-hash-iterate-next")]
[-get (mk-id #'SETTYPE "unsafe-~a-hash-iterate-key")]
[-test? (mk-id #'SETTYPE "set-~a?")])
#'(define-sequence-syntax IN-SET-NAME
(lambda () #'custom-in-set/checked)
(lambda (stx)
(syntax-case stx ()
[[(id) (_ set-expr)]
(for-clause-syntax-protect
#'[(id)
(:do-in
;;outer bindings
([(HT fn) (let ([xs set-expr])
(if (custom-set? xs)
(values
(custom-set-table xs)
(if (custom-set-spec xs)
custom-elem-contents
(lambda (x) x)))
(values #f #f)))])
;; outer check
(unless (and HT (-test? HT))
(custom-in-set/checked set-expr))
;; loop bindings
([i (-first HT)])
;; pos check
i
;; inner bindings
([(id) (fn (-get HT i))])
;; pre guard
#t
;; post guard
#t
;; loop args
((-next HT i)))])]
[_ #f]))))]))
(define-in-set-sequence-syntax set-type: immutable)
(define-in-set-sequence-syntax set-type: mutable)
(define-in-set-sequence-syntax set-type: weak)
(struct custom-elem [contents] #:transparent)
(struct custom-spec [elem? wrap intern])

3
racket/collects/racket/set.rkt
View File

@ -21,6 +21,9 @@
set-union! set-intersect! set-subtract! set-symmetric-difference!
in-set
in-immutable-set
in-mutable-set
in-weak-set
set-implements/c
set seteq seteqv