Add faster non-generic in-*-set sequences

closes #1217

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?]{

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)

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])

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