From d2bdc2eca89d6fc040be0f9eb892f0ca49aa50fe Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Sat, 20 Feb 2010 12:23:01 +0000
Subject: [PATCH 1/6] fix test problems

svn: r18221
---
 collects/tests/future/future.ss        |  2 +-
 collects/tests/future/random-future.ss | 11 ++++++-----
 collects/tests/info.ss                 |  1 +
 collects/tests/mzscheme/filelib.ss     | 16 ++++++++--------
 4 files changed, 16 insertions(+), 14 deletions(-)

diff --git a/collects/tests/future/future.ss b/collects/tests/future/future.ss
index 139fc96969..a7d72b642a 100644
--- a/collects/tests/future/future.ss
+++ b/collects/tests/future/future.ss
@@ -1,4 +1,4 @@
-(load-relative "loadtest.ss")
+(load-relative "../mzscheme/loadtest.ss")
 
 (Section 'future)
 (require scheme/future)
diff --git a/collects/tests/future/random-future.ss b/collects/tests/future/random-future.ss
index 8375be9396..ceb691a76f 100644
--- a/collects/tests/future/random-future.ss
+++ b/collects/tests/future/random-future.ss
@@ -186,8 +186,9 @@ Errors/exceptions and other kinds of control?
 (define-namespace-anchor ns-here)
 
 (let loop ([n 100])
-  (printf ".") (flush-output)
-  (let ([p (gen-prog)])
-    (pretty-print p)
-    (eval p (namespace-anchor->namespace ns-here)))
-  (loop (- n 1)))
+  (unless (zero? n)
+    (printf ".") (flush-output)
+    (let ([p (gen-prog)])
+      (pretty-print p)
+      (eval p (namespace-anchor->namespace ns-here)))
+    (loop (- n 1))))
diff --git a/collects/tests/info.ss b/collects/tests/info.ss
index 2e13c2c61a..ff6700f7a2 100644
--- a/collects/tests/info.ss
+++ b/collects/tests/info.ss
@@ -8,6 +8,7 @@
   '("2htdp"
     "aligned-pasteboard"
     "deinprogramm"
+    "future"
     "honu"
     "match"
     "macro-debugger"
diff --git a/collects/tests/mzscheme/filelib.ss b/collects/tests/mzscheme/filelib.ss
index c266201cc9..f0128c8374 100644
--- a/collects/tests/mzscheme/filelib.ss
+++ b/collects/tests/mzscheme/filelib.ss
@@ -80,9 +80,9 @@
 			    (bytes<? (path->bytes a) (path->bytes b)))))])
       (test #t equal? (sort rel) (sort rel2))
 
-      (when (eq? (system-type) 'unix)
-	(system "ln -s filelib.ss filelib-link.ss")
-	(system "ln -s . loop-link")
+      (unless (eq? (system-type) 'windows)
+        (make-file-or-directory-link "filelib.ss" "filelib-link")
+        (make-file-or-directory-link "." "loop-link")
 
 	(test (+ 2 (length rel2))
 	      fold-files 
@@ -92,7 +92,7 @@
 				   [(file-exists? name) 'file]
 				   [(directory-exists? name) 'dir]
 				   [else '???]))
-		(when (member name '("filelib-link.ss" "loop-link"))
+		(when (member name '("filelib-link" "loop-link"))
 		  (test kind name 'link))
 		(add1 accum))
 	      0
@@ -107,14 +107,14 @@
 				   [(file-exists? name) 'file]
 				   [(directory-exists? name) 'dir]
 				   [else '???]))
-		(when (member name '("filelib-link.ss" "loop-link"))
+		(when (member name '("filelib-link" "loop-link"))
 		  (test kind name 'link))
 		(values (add1 accum) #t))
 	      0
 	      #f
 	      #f)
 
-	(system "rm loop-link")
+        (delete-file "loop-link")
 
 	(test (+ 1 (length rel2))
 	      fold-files 
@@ -122,14 +122,14 @@
 		(test kind values (cond
 				   [(file-exists? name) 'file]
 				   [else 'dir]))
-		(when (member name '("filelib-link.ss"))
+		(when (member name '("filelib-link"))
 		  (test kind name 'file))
 		(add1 accum))
 	      0
 	      #f
 	      #t)
 
-	(system "rm filelib-link.ss")
+	(delete-file "filelib-link")
 
 	'done))))
 

From e38e8d88e0990f08d8ed0ad4884ba57fc44038ff Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Sat, 20 Feb 2010 13:00:48 +0000
Subject: [PATCH 2/6] basic set library

svn: r18222
---
 collects/scheme/set.ss                        | 196 ++++++++++++++++++
 collects/scribblings/reference/data.scrbl     |   3 +
 .../scribblings/reference/sequences.scrbl     |   3 +-
 collects/scribblings/reference/sets.scrbl     | 118 +++++++++++
 collects/scribblings/reference/time.scrbl     |   2 +-
 collects/tests/mzscheme/mzlib-tests.ss        |   1 +
 collects/tests/mzscheme/set.ss                | 105 ++++++++++
 7 files changed, 426 insertions(+), 2 deletions(-)
 create mode 100644 collects/scheme/set.ss
 create mode 100644 collects/scribblings/reference/sets.scrbl
 create mode 100644 collects/tests/mzscheme/set.ss

diff --git a/collects/scheme/set.ss b/collects/scheme/set.ss
new file mode 100644
index 0000000000..2056adb58c
--- /dev/null
+++ b/collects/scheme/set.ss
@@ -0,0 +1,196 @@
+#lang scheme/base
+(require (for-syntax scheme/base))
+
+(provide (rename-out [make-set* make-set])
+         make-seteq make-seteqv
+         set? set-eq? set-eqv?
+         set-empty? set-count
+         set-member? set-add set-remove
+         set-union set-intersect set-subtract
+         set-map set-for-each 
+         (rename-out [*in-set in-set]))
+
+(define-struct set (ht)
+  #:property prop:equal+hash (list 
+                              (lambda (set1 set2 =?)
+                                (=? (set-ht set1) (set-ht set2)))
+                              (lambda (set hc) (add1 (hc (set-ht set))))
+                              (lambda (set hc) (add1 (hc (set-ht set)))))
+  #:property prop:sequence (lambda (v) (*in-set v)))
+
+(define make-set*
+  (let ([make-set (lambda elems
+                    (make-set (make-immutable-hash (map (lambda (k) (cons k #t)) elems))))])
+    make-set))
+(define (make-seteq . elems)
+  (make-set (make-immutable-hasheq (map (lambda (k) (cons k #t)) elems))))
+(define (make-seteqv . elems)
+  (make-set (make-immutable-hasheqv (map (lambda (k) (cons k #t)) elems))))
+
+(define (set-eq? set)
+  (unless (set? set) (raise-type-error 'set-eq? "set" 0 set))
+  (hash-eq? (set-ht set)))
+(define (set-eqv? set)
+  (unless (set? set) (raise-type-error 'set-eqv? "set" 0 set))
+  (hash-eqv? (set-ht set)))
+
+(define (set-empty? set)
+  (unless (set? set) (raise-type-error 'set-empty? "set" 0 set))
+  (zero? (hash-count (set-ht set))))
+
+(define (set-count set)
+  (unless (set? set) (raise-type-error 'set-count "set" 0 set))
+  (hash-count (set-ht set)))
+
+(define (set-member? set v)
+  (unless (set? set) (raise-type-error 'set-member? "set" 0 set v))
+  (hash-ref (set-ht set) v #f))
+
+(define (set-add set v)
+  (unless (set? set) (raise-type-error 'set-add "set" 0 set v))
+  (make-set (hash-set (set-ht set) v #t)))
+
+(define (set-remove set v)
+  (unless (set? set) (raise-type-error 'set-remove "set" 0 set v))
+  (make-set (hash-remove (set-ht set) v)))
+
+(define set-union
+  (case-lambda
+   [(set) 
+    (unless (set? set) (raise-type-error 'set-union "set" 0 set))
+    set]
+   [(set set2)
+    (unless (set? set) (raise-type-error 'set-union "set" 0 set set2))
+    (unless (set? set2) (raise-type-error 'set-union "set" 1 set set2))
+    (let ([ht (set-ht set)]
+          [ht2 (set-ht set2)])
+      (unless (and (eq? (hash-eq? ht) (hash-eq? ht2))
+                   (eq? (hash-eqv? ht) (hash-eqv? ht2)))
+        (raise-mismatch-error 'set-union "set's equivalence predicate is not the same as the first set: "
+                              set2))
+      (let-values ([(ht ht2)
+                    (if ((hash-count ht2) . > . (hash-count ht))
+                        (values ht2 ht)
+                        (values ht ht2))])
+        (make-set
+         (for/fold ([ht ht]) ([v (in-hash-keys ht2)])
+           (hash-set ht v #t)))))]
+   [(set . sets)
+    (for ([s (in-list (cons set sets))]
+          [i (in-naturals)])
+      (unless (set? s) (apply raise-type-error 'set-union "set" i sets)))
+    (for/fold ([set set]) ([set2 (in-list sets)])
+      (set-union set set2))]))
+
+(define (empty-like ht)
+  (cond
+   [(hash-eqv? ht) #hasheqv()]
+   [(hash-eq? ht) #hasheq()]
+   [else #hash()]))
+
+(define set-intersect
+  (case-lambda
+   [(set) 
+    (unless (set? set) (raise-type-error 'set-intersect "set" 0 set))
+    set]
+   [(set set2)
+    (unless (set? set) (raise-type-error 'set-intersect "set" 0 set set2))
+    (unless (set? set2) (raise-type-error 'set-intersect "set" 1 set set2))
+    (let ([ht1 (set-ht set)]
+          [ht2 (set-ht set2)])
+      (unless (and (eq? (hash-eq? ht1) (hash-eq? ht2))
+                   (eq? (hash-eqv? ht1) (hash-eqv? ht2)))
+        (raise-mismatch-error 'set-union "set's equivalence predicate is not the same as the first set: "
+                              set2))
+      (let-values ([(ht1 ht2) (if ((hash-count ht1) . < . (hash-count ht2))
+                                  (values ht1 ht2)
+                                  (values ht2 ht1))])
+        (make-set
+         (for/fold ([ht (empty-like (set-ht set))]) ([v (in-hash-keys ht1)])
+           (if (hash-ref ht2 v #f)
+               (hash-set ht v #t)
+               ht)))))]
+   [(set . sets)
+    (for ([s (in-list (cons set sets))]
+          [i (in-naturals)])
+      (unless (set? s) (apply raise-type-error 'set-intersect "set" i sets)))
+    (for/fold ([set set]) ([set2 (in-list sets)])
+      (set-intersect set set2))]))
+
+(define set-subtract
+  (case-lambda
+   [(set) 
+    (unless (set? set) (raise-type-error 'set-subtract "set" 0 set))
+    set]
+   [(set set2)
+    (unless (set? set) (raise-type-error 'set-subtract "set" 0 set set2))
+    (unless (set? set2) (raise-type-error 'set-subtract "set" 1 set set2))
+    (let ([ht1 (set-ht set)]
+          [ht2 (set-ht set2)])
+      (unless (and (eq? (hash-eq? ht1) (hash-eq? ht2))
+                   (eq? (hash-eqv? ht1) (hash-eqv? ht2)))
+        (raise-mismatch-error 'set-union "set's equivalence predicate is not the same as the first set: "
+                              set2))
+      (if ((* 2 (hash-count ht1)) . < . (hash-count ht2))
+          ;; Add elements from ht1 that are not in ht2:
+          (make-set
+           (for/fold ([ht (empty-like ht1)]) ([v (in-hash-keys ht1)])
+             (if (hash-ref ht2 v #f)
+                 ht
+                 (hash-set ht v #t))))
+          ;; Remove elements from ht1 that are in ht2
+          (make-set
+           (for/fold ([ht ht1]) ([v (in-hash-keys ht2)])
+             (hash-remove ht v)))))]
+   [(set . sets)
+    (for ([s (in-list (cons set sets))]
+          [i (in-naturals)])
+      (unless (set? s) (apply raise-type-error 'set-subtract "set" i sets)))
+    (for/fold ([set set]) ([set2 (in-list sets)])
+      (set-subtract set set2))]))
+
+(define (set-map set proc)
+  (unless (set? set) (raise-type-error 'set-map "set" 0 set proc))
+  (unless (and (procedure? proc)
+               (procedure-arity-includes? proc 1))
+    (raise-type-error 'set-map "procedure (arity 1)" 1 set proc))
+  (for/list ([v (in-set set)])
+    (proc v)))
+
+(define (set-for-each set proc)
+  (unless (set? set) (raise-type-error 'set-for-each "set" 0 set proc))
+  (unless (and (procedure? proc)
+               (procedure-arity-includes? proc 1))
+    (raise-type-error 'set-for-each "procedure (arity 1)" 1 set proc))
+  (for ([v (in-set set)])
+    (proc v)))
+
+(define (in-set set)
+  (unless (set? set) (raise-type-error 'in-set "set" 0 set))
+  (in-hash-keys (set-ht set)))
+
+(define-sequence-syntax *in-set
+  (lambda () #'in-set)
+  (lambda (stx)
+    (syntax-case stx ()
+      [[(id) (_ st)]
+       #`[(id)
+          (:do-in
+           ;; outer bindings:
+           ([(ht) (let ([s st]) (if (set? s) (set-ht s) (list s)))])
+           ;; outer check:
+           (unless (hash? ht)
+             ;; let `in-set' report the error:
+             (in-set (car ht)))
+           ;; loop bindings:
+           ([pos (hash-iterate-first ht)])
+           ;; pos check
+           pos
+           ;; inner bindings
+           ([(id) (hash-iterate-key ht pos)])
+           ;; pre guard
+           #t
+           ;; post guard
+           #t
+           ;; loop args
+           ((hash-iterate-next ht pos)))]])))
diff --git a/collects/scribblings/reference/data.scrbl b/collects/scribblings/reference/data.scrbl
index 1a06144792..25dd6272c2 100644
--- a/collects/scribblings/reference/data.scrbl
+++ b/collects/scribblings/reference/data.scrbl
@@ -215,6 +215,9 @@ Sets the content of @scheme[box] to @scheme[v].}
 @; ----------------------------------------------------------------------
 @include-section["dicts.scrbl"]
 
+@; ----------------------------------------------------------------------
+@include-section["sets.scrbl"]
+
 @; ----------------------------------------------------------------------
 @include-section["procedures.scrbl"]
 
diff --git a/collects/scribblings/reference/sequences.scrbl b/collects/scribblings/reference/sequences.scrbl
index f75567b0c1..d9a9f243c3 100644
--- a/collects/scribblings/reference/sequences.scrbl
+++ b/collects/scribblings/reference/sequences.scrbl
@@ -444,7 +444,8 @@ of the generator.
 
 (define introspective-generator (generator ((yield 1))))
 (introspective-generator)
-(introspective-generator (lambda () (generator-state introspective-generator)))
+(introspective-generator 
+ (lambda () (generator-state introspective-generator)))
 (generator-state introspective-generator)
 (introspective-generator)
 ]}
diff --git a/collects/scribblings/reference/sets.scrbl b/collects/scribblings/reference/sets.scrbl
new file mode 100644
index 0000000000..a1e790fb98
--- /dev/null
+++ b/collects/scribblings/reference/sets.scrbl
@@ -0,0 +1,118 @@
+#lang scribble/doc
+@(require "mz.ss"
+          (for-label scheme/set))
+
+@title[#:tag "sets"]{Sets}
+
+@(define (mutable-key-caveat)
+  @elemref['(caveat "mutable-keys")]{caveat concerning mutable keys})
+
+A @deftech{set} represents a set of distinct elements. For a given
+set, elements are equivalent via @scheme[equal?], @scheme[eqv?], or
+@scheme[eq?]. Two sets are @scheme[equal?] they use the same
+key-comparison procedure (@scheme[equal?], @scheme[eqv?], or
+@scheme[eq?]) and have equivalent elements. A set can be used as a
+@tech{sequence} (see @secref["sequences"]).
+
+For sets that contain elements that are mutated, then operations on
+the set become unpredictable in much the same way that @tech{hash
+table} operations are unpredictable when keys are mutated.
+
+@note-lib-only[scheme/set]
+
+@defproc[(set? [v any/c]) boolean?]{
+
+Returns @scheme[#t] if @scheme[v] is a @tech{set}, @scheme[#f]
+otherwise.}
+
+@defproc[(set-eqv? [set set?]) boolean?]{
+
+Returns @scheme[#t] if @scheme[set] compares elements with @scheme[eqv?],
+@scheme[#f] if it compares with @scheme[equal?] or @scheme[eq?].}
+
+@defproc[(set-eq? [set set?]) boolean?]{
+
+Returns @scheme[#t] if @scheme[set] compares elements with @scheme[eq?],
+@scheme[#f] if it compares with @scheme[equal?] or @scheme[eqv?].}
+
+@deftogether[(
+@defproc[(make-set [v any/c] ...) set?]
+@defproc[(make-seteqv [v any/c] ...) set?]
+@defproc[(make-seteq [v any/c] ...) set?]
+)]{
+
+Creates a set that uses @scheme[equal?], @scheme[eq?], or
+@scheme[eqv?], respectively, to compare elements.  The given
+@scheme[v]s are added to the set. The elements are added in the order
+that they appear as @scheme[v]s, so in the first two cases, an earlier
+element that is @scheme[equal?] or @scheme[eqv?] but not @scheme[eq?]
+to a later element takes precedence over the later element.}
+
+@defproc[(set-member? [set set?] [v any/c]) boolean?]{
+
+Returns @scheme[#t] if @scheme[v] is in @scheme[set], @scheme[#f]
+otherwise.}
+
+@defproc[(set-add [set set?] [v any/c]) set?]{
+
+@margin-note{Like operations on immutable hash tables, ``constant
+time'' set operations actually require @math{O(log N)} time for a set
+of size @math{N}.}
+
+Produces a set that includes @scheme[v] plus all elements of of
+@scheme[set]. This operation runs constant time.}
+
+
+@defproc[(set-remove [set set?] [v any/c]) set?]{
+
+Produces a set that includes all elements of @scheme[set] except
+@scheme[v]. This operation runs in constant time.}
+
+
+@defproc[(set-union [set set?] ...+) set?]{
+
+Produces a set that includes all elements of all given @scheme[set]s,
+which must all use the same equivalence predicate (@scheme[equal?],
+@scheme[eq?], or @scheme[eqv?]). This operation runs in time
+proportional to the total size of all given @scheme[set]s except for
+the largest.}
+
+
+@defproc[(set-intersect [set set?] ...+) set?]{
+
+Produces a set that includes only the elements in all of the given
+@scheme[set]s, which must all use the same equivalence predicate
+(@scheme[equal?], @scheme[eq?], or @scheme[eqv?]). This operation
+runs in time proportional to the total size of all given
+@scheme[set]s except for the largest.}
+
+
+@defproc[(set-subtract [set set?] ...+) set?]{
+
+Produces a set that includes all elements the first @scheme[set]s that
+are not present in any of the other given @scheme[sets]s.  All of the
+given @scheme[set]s must use the same equivalence predicate
+(@scheme[equal?], @scheme[eq?], or @scheme[eqv?]).  This operation
+runs in time proportional to the total size of all given
+@scheme[set]s except the first one.}
+
+
+@defproc[(set-map [set set?]
+                  [proc (any/c . -> . any/c)])
+         (listof any/c)]{
+
+Applies the procedure @scheme[proc] to each element in
+@scheme[set] in an unspecified order, accumulating the results
+into a list.}
+
+@defproc[(set-for-each [set set?]
+                       [proc (any/c . -> . any)])
+         void?]{
+
+Applies @scheme[proc] to each element in @scheme[set] (for the
+side-effects of @scheme[proc]) in an unspecified order.}
+
+@defproc[(in-set [set set?]) sequence?]{
+
+Explicitly converts a set to a sequence for use with @scheme[for] and
+other forms.}
diff --git a/collects/scribblings/reference/time.scrbl b/collects/scribblings/reference/time.scrbl
index 9a75a27980..9e7694df2b 100644
--- a/collects/scribblings/reference/time.scrbl
+++ b/collects/scribblings/reference/time.scrbl
@@ -123,7 +123,7 @@ result is the result of @scheme[expr].}
 
 @section[#:tag "date-string"]{Date Utilities}
 
-@defmodule[scheme/date]
+@note-lib-only[scheme/date]
 
 @defproc[(date->string [date date?][time? any/c #f]) string?]{
 
diff --git a/collects/tests/mzscheme/mzlib-tests.ss b/collects/tests/mzscheme/mzlib-tests.ss
index 99a1f257ad..348484968b 100644
--- a/collects/tests/mzscheme/mzlib-tests.ss
+++ b/collects/tests/mzscheme/mzlib-tests.ss
@@ -13,6 +13,7 @@
 (load-in-sandbox "filelib.ss")
 (load-in-sandbox "portlib.ss")
 (load-in-sandbox "threadlib.ss")
+(load-in-sandbox "set.ss")
 (load-in-sandbox "date.ss")
 (load-in-sandbox "compat.ss")
 (load-in-sandbox "cmdline.ss")
diff --git a/collects/tests/mzscheme/set.ss b/collects/tests/mzscheme/set.ss
new file mode 100644
index 0000000000..631a8b0af4
--- /dev/null
+++ b/collects/tests/mzscheme/set.ss
@@ -0,0 +1,105 @@
+(load-relative "loadtest.ss")
+
+(Section 'sets)
+(require scheme/set)
+
+;; ----------------------------------------
+
+(test #t set? (make-set))
+(test #t set-empty? (make-set))
+(test #t set? (make-set 1 2 3))
+(test #f set-empty? (make-set 1 2 3))
+(test #t set? (make-seteq))
+(test #t set-empty? (make-seteq))
+(test #t set? (make-seteq 1 2 3))
+(test #f set-empty? (make-seteq 1 2 3))
+(test #t set? (make-seteqv))
+(test #t set-empty? (make-seteqv))
+(test #t set? (make-seteqv 1 2 3))
+(test #f set-empty? (make-seteqv 1 2 3))
+
+(test #f set-eq? (make-set 1 2 3))
+(test #f set-eqv? (make-set 1 2 3))
+(test #t set-eq? (make-seteq 1 2 3))
+(test #f set-eqv? (make-seteq 1 2 3))
+(test #f set-eq? (make-seteqv 1 2 3))
+(test #t set-eqv? (make-seteqv 1 2 3))
+
+(test 3 set-count (make-set (string #\a) "b" "c" (string #\a)))
+(test 4 set-count (make-seteqv (string #\a) "b" "c" (string #\a)))
+(test 4 set-count (make-seteq (string #\a) "b" "c" (string #\a)))
+
+(test #t set-member? (make-set 1 2 3) 1)
+(test #t set-member? (make-set 1 2 3) 2)
+(test #t set-member? (make-set 1 2 3) 3)
+(test #f set-member? (make-set 1 2 3) 4)
+
+(let ([s (make-set 1 2 3)])
+  (test #t equal? s (set-add (set-add (set-add (make-set) 1) 2) 3))
+  (test #t equal? (make-seteq 1 2 3) (make-seteq 1 2 3))
+  (test #t equal? (make-seteq 1 2 3) (make-seteq 3 2 1))
+  (test #t equal? (make-seteqv 1 2 3) (make-seteqv 1 2 3))
+  (test #f equal? s (make-seteq 1 2 3))
+  (test #f equal? s (make-seteqv 1 2 3))
+  (test #f equal? (make-seteq 1 2 3) (make-seteqv 1 2 3))
+
+  (test #t set-member? (set-add s 5) 3)
+  (test #t set-member? (set-add s 5) 5)
+  (test #f set-member? (set-add s 5) 4)
+
+  (test #t set-member? (set-remove s 5) 3)
+  (test #f set-member? (set-remove s 3) 3)
+
+  (test 3 set-count (set-union s))
+  (test 6 set-count (set-union s (make-set 3 4 5 6)))
+  (test 6 set-count (set-union (make-set 3 4 5 6) s))
+  (test 8 set-count (set-union (make-set 3 4 5 6) s (make-set 1 10 100)))
+
+  (test (make-seteq 1 2 3) set-union (make-seteq 1 2) (make-seteq 3))
+  (test (make-seteqv 1 2 3) set-union (make-seteqv 1 2) (make-seteqv 3))
+
+  (test s set-intersect s)
+  (test (make-set 3) set-intersect s (make-set 5 4 3 6))
+  (test (make-set 3) set-intersect (make-set 5 4 3 6) s)
+  (test (make-seteq 3) set-intersect (make-seteq 5 4 3 6) (make-seteq 1 2 3))
+  (test (make-seteqv 3) set-intersect (make-seteqv 5 4 3 6) (make-seteqv 1 2 3))
+  (test (make-set 3 2) set-intersect s (make-set 5 2 3))
+  (test (make-seteq 3 2) set-intersect (make-seteq 1 2 3) (make-seteq 5 2 3))
+  (test (make-set 2) set-intersect s (make-set 5 2 3) (make-set 2 20 200))
+  (test (make-seteq 2) set-intersect (make-seteq 1 2 3) (make-seteq 5 2 3) (make-seteq 2 20 200))
+
+  (test s set-subtract s)
+  (test (make-set) set-subtract s s)
+  (test s set-subtract s (make-set 100))
+  (test (make-set 1 3) set-subtract s (make-set 2 100))
+  (test (make-seteq 100) set-subtract (make-seteq 2 100) (make-seteq 1 2 3))
+  (test (make-seteq 9 100) set-subtract (make-seteq 2 100 1000 9) (make-seteq 1 2 3) (make-seteq 1000 5))
+
+  (let ([try-mismatch (lambda (set-op)
+                        (err/rt-test (set-op (make-seteqv 1 2) (make-set 3)))
+                        (err/rt-test (set-op (make-seteqv 1 2) (make-seteq 3)))
+                        (err/rt-test (set-op (make-set 1 2) (make-seteq 3)))
+                        (err/rt-test (set-op (make-set 1 2) (make-set 4) (make-seteq 3)))
+                        (err/rt-test (set-op (make-set 1 2) (make-seteq 3) (make-set 4)))
+                        (err/rt-test (set-op (make-seteq 3) (make-set 1 2) (make-set 4))))])
+    (try-mismatch set-union)
+    (try-mismatch set-intersect)
+    (try-mismatch set-subtract))
+
+  (test #t andmap negative? (set-map s -))
+  (test 3 length (set-map s +))
+
+  (let ([v 0])
+    (set-for-each s (lambda (n) (set! v (+ v n))))
+    (test 6 values v))
+
+  (test '(1 2 3) sort (for/list ([v s]) v) <)
+  (test '(1 2 3) sort (for/list ([v (in-set s)]) v) <)
+  (test '(1 2 3) sort (let ([seq (in-set s)]) (for/list ([v seq]) v)) <)
+        
+
+  (void))
+
+;; ----------------------------------------
+
+(report-errs)

From 457a2da675f3142eafbb9b94f4e6ec1c31e3c123 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Sat, 20 Feb 2010 13:39:51 +0000
Subject: [PATCH 3/6] try again to fix tests

svn: r18223
---
 collects/tests/future/random-future.ss | 6 ++++--
 1 file changed, 4 insertions(+), 2 deletions(-)

diff --git a/collects/tests/future/random-future.ss b/collects/tests/future/random-future.ss
index ceb691a76f..36ca737393 100644
--- a/collects/tests/future/random-future.ss
+++ b/collects/tests/future/random-future.ss
@@ -84,7 +84,9 @@ Errors/exceptions and other kinds of control?
 
 |#
 
-(random-seed 2)
+(let ([v (modulo (current-milliseconds) 1000)])
+  (printf "using seed ~a\n" v)
+  (random-seed v))
 
 (define-language fut
   ;; single value, non-error expressions
@@ -185,7 +187,7 @@ Errors/exceptions and other kinds of control?
 
 (define-namespace-anchor ns-here)
 
-(let loop ([n 100])
+(let loop ([n 32])
   (unless (zero? n)
     (printf ".") (flush-output)
     (let ([p (gen-prog)])

From eb46f9524610a2c4907c7be800b4c48116b4c74c Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Sat, 20 Feb 2010 14:58:10 +0000
Subject: [PATCH 4/6] doc corrections

svn: r18224
---
 collects/scribblings/reference/numbers.scrbl | 2 +-
 collects/scribblings/reference/unsafe.scrbl  | 5 +++--
 2 files changed, 4 insertions(+), 3 deletions(-)

diff --git a/collects/scribblings/reference/numbers.scrbl b/collects/scribblings/reference/numbers.scrbl
index ab4b086697..1fb34737c9 100644
--- a/collects/scribblings/reference/numbers.scrbl
+++ b/collects/scribblings/reference/numbers.scrbl
@@ -596,7 +596,7 @@ but faster and in constant time when @scheme[n] is positive.
                             [start exact-nonnegative-integer?] 
                             [end (and/c exact-nonnegative-integer?
                                         (start . <= . end))])
-         boolean?]{
+         exact-integer?]{
 
 Returns
 
diff --git a/collects/scribblings/reference/unsafe.scrbl b/collects/scribblings/reference/unsafe.scrbl
index d0c581e7ef..06de73b20a 100644
--- a/collects/scribblings/reference/unsafe.scrbl
+++ b/collects/scribblings/reference/unsafe.scrbl
@@ -70,8 +70,9 @@ the result is always a @tech{fixnum}. The @scheme[unsafe-fxlshift] and
 @scheme[unsafe-fxlshift] is a positive (i.e., left) shift, and
 @scheme[unsafe-fxrshift] is a negative (i.e., right) shift, where the
 number of bits to shift must be less than the number of bits used to
-represent a @tech{fixnum}, and the result is effectively
-@scheme[bitwise-and]ed with the most negative @tech{fixnum}.}
+represent a @tech{fixnum}. In the case of @scheme[unsafe-fxlshift],
+bits in the result beyond the the number of bits used to represent a
+@tech{fixnum} are effectively replaced with a copy of the high bit.}
 
 
 @deftogether[(

From ac2c537b8fd667d8f15ff34d1eea94d3c94ca82b Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Sat, 20 Feb 2010 15:20:27 +0000
Subject: [PATCH 5/6] clarified bitwise-bit-field and bitwise-bit-set?

svn: r18225
---
 collects/scribblings/reference/numbers.scrbl | 26 +++++++++++++++-----
 1 file changed, 20 insertions(+), 6 deletions(-)

diff --git a/collects/scribblings/reference/numbers.scrbl b/collects/scribblings/reference/numbers.scrbl
index 1fb34737c9..631b168062 100644
--- a/collects/scribblings/reference/numbers.scrbl
+++ b/collects/scribblings/reference/numbers.scrbl
@@ -586,8 +586,12 @@ produces @scheme[+nan.0] in the case that neither @scheme[y] nor
 @defproc[(bitwise-bit-set? [n exact-integer?] [m exact-nonnegative-integer?])
          boolean?]{
 
-Returns @scheme[(not (zero? (bitwise-and n (arithmetic-shift 1 m))))],
-but faster and in constant time when @scheme[n] is positive.
+Returns @scheme[#t] when the @scheme[m]th bit of @scheme[n] is set in @scheme[n]'s
+        (semi-infinite) two's complement representation.
+                   
+This is equivalent to
+@scheme[(not (zero? (bitwise-and n (arithmetic-shift 1 m))))],
+but is faster and runs in constant time when @scheme[n] is positive.
 
 @mz-examples[(bitwise-bit-set? 5 0) (bitwise-bit-set? 5 2) (bitwise-bit-set? -5 (expt 2 700))]}
 
@@ -598,20 +602,30 @@ but faster and in constant time when @scheme[n] is positive.
                                         (start . <= . end))])
          exact-integer?]{
 
-Returns
+Extracts the bits between position @scheme[start] and @scheme[(- end 1)] (inclusive)
+from @scheme[n] and shifts them down to the least significant portion of the number.
+
+This is equivalent to this computation,
 
 @schemeblock[
 (bitwise-and (sub1 (arithmetic-shift 1 (- end start)))
              (arithmetic-shift n (- start)))
 ]
 
-but in constant time when @scheme[n] is positive, @scheme[start] and
+but it runs in constant time when @scheme[n] is positive, @scheme[start] and
 @scheme[end] are fixnums, and @scheme[(- end start)] is no more than
 the maximum width of a fixnum.
 
-@mz-examples[(bitwise-bit-field 13 1 1)
+Each pair of examples below uses the same numbers, but shows the result in
+both binary and as integers.
+
+@mz-examples[(format "~b" (bitwise-bit-field (string->number "1101" 2) 1 1))
+             (bitwise-bit-field 13 1 1)
+             (format "~b" (bitwise-bit-field (string->number "1101" 2) 1 3))
              (bitwise-bit-field 13 1 3)
-             (bitwise-bit-field 13 1 4)]}
+             (format "~b" (bitwise-bit-field (string->number "1101" 2) 1 4))
+             (bitwise-bit-field 13 1 4)]
+}
 
 
 @defproc[(arithmetic-shift [n exact-integer?] [m exact-integer?])

From 92717e0f0bd794ffa0955a5b128b716a5d6790b5 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Sat, 20 Feb 2010 17:16:54 +0000
Subject: [PATCH 6/6] used stderr when tests fail

svn: r18226
---
 collects/tests/framework/main.ss | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/collects/tests/framework/main.ss b/collects/tests/framework/main.ss
index 5b10ada2c7..0f6c45696b 100644
--- a/collects/tests/framework/main.ss
+++ b/collects/tests/framework/main.ss
@@ -105,15 +105,15 @@
 
 (exit (cond
         [(not (null? jumped-out-tests))
-         (printf "Test suites ended with exns ~s\n" jumped-out-tests)
+         (fprintf (current-error-port) "Test suites ended with exns ~s\n" jumped-out-tests)
          1]
         [(null? failed-tests)
          (printf "All tests passed.\n")
          0]
         [else
-         (debug-printf schedule "FAILED tests:\n")
+         (fprintf (current-error-port) "FAILED tests:\n")
          (for-each (lambda (failed-test)
-                     (debug-printf schedule "  ~a // ~a\n"
+                     (fprintf (current-error-port) "  ~a // ~a\n"
                                    (car failed-test) (cdr failed-test)))
                    failed-tests)
          1]))