From 5ffe007f5caa5b630fc6a58ac3cceafe84f7d211 Mon Sep 17 00:00:00 2001 From: Stephen Chang Date: Wed, 20 Jan 2016 10:49:58 -0500 Subject: [PATCH] Add faster non-generic in-*-set sequences closes #1217 --- .../scribblings/reference/sets.scrbl | 18 ++++++ pkgs/racket-test-core/tests/racket/for.rktl | 39 ++++++++++++ racket/collects/racket/private/set-types.rkt | 62 +++++++++++++++++++ racket/collects/racket/set.rkt | 3 + 4 files changed, 122 insertions(+) diff --git a/pkgs/racket-doc/scribblings/reference/sets.scrbl b/pkgs/racket-doc/scribblings/reference/sets.scrbl index 63d0b1aff3..77fed2efa5 100644 --- a/pkgs/racket-doc/scribblings/reference/sets.scrbl +++ b/pkgs/racket-doc/scribblings/reference/sets.scrbl @@ -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?]{ diff --git a/pkgs/racket-test-core/tests/racket/for.rktl b/pkgs/racket-test-core/tests/racket/for.rktl index 9b537e7c90..3aa5dc56d3 100644 --- a/pkgs/racket-test-core/tests/racket/for.rktl +++ b/pkgs/racket-test-core/tests/racket/for.rktl @@ -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) diff --git a/racket/collects/racket/private/set-types.rkt b/racket/collects/racket/private/set-types.rkt index cce77ae187..3cac666e70 100644 --- a/racket/collects/racket/private/set-types.rkt +++ b/racket/collects/racket/private/set-types.rkt @@ -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]) diff --git a/racket/collects/racket/set.rkt b/racket/collects/racket/set.rkt index 9c0fd16673..a525dd3626 100644 --- a/racket/collects/racket/set.rkt +++ b/racket/collects/racket/set.rkt @@ -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