Make integer-sets implement generic interfaces

Supports gen:stream, gen:equal+hash, gen:custom-write

collects/data/integer-set.rkt

@@ -2,7 +2,10 @@
 
 ;; a library for integer interval sets
 
-(require racket/contract/base)
+(require racket/contract/base
+         racket/match
+         racket/stream
+         unstable/custom-write)
 
 (provide well-formed-set?
          (contract-out
@@ -44,7 +47,34 @@
 ;; set is the union of the ranges.  The ranges must be disjoint and
 ;; increasing.  Further, adjacent ranges must have at least
 ;; one number between them.
-(define-struct integer-set (contents) #:mutable)
+(define-struct integer-set (contents) #:mutable
+  #:methods gen:custom-write
+  [(define write-proc
+     (make-constructor-style-printer
+      (λ (set) 'integer-set)
+      (λ (set) (integer-set-contents set))))]
+  #:methods gen:equal+hash
+  [(define (equal-proc s1 s2 rec-equal?)
+     (rec-equal? (integer-set-contents s1)
+                 (integer-set-contents s2)))
+   (define (hash-proc set rec-hash)
+     (rec-hash (integer-set-contents set)))
+   (define (hash2-proc set rec-hash)
+     (rec-hash (integer-set-contents set)))]
+  #:methods gen:stream
+  [(define (stream-empty? set)
+     (null? (integer-set-contents set)))
+   (define (stream-first set)
+     (define contents (integer-set-contents set))
+     ;; the contract lets us assume non-null
+     (caar contents))
+   (define (stream-rest set)
+     (define contents (integer-set-contents set))
+     (match-define (cons low hi) (car contents))
+     (make-integer-set
+      (if (= low hi)
+          (cdr contents)
+          (cons (cons (+ 1 low) hi) contents))))])
 
 ;; well-formed-set? : X -> bool
 (define (well-formed-set? x)

collects/data/scribblings/integer-set.scrbl

@@ -5,6 +5,8 @@
                      racket/contract
                      (except-in racket/base
                                 foldr)))
+@(define (racket-tech pre)
+   (tech #:doc '(lib "scribblings/reference/reference.scrbl") pre))
 
 @title[#:tag "integer-set"]{Integer Sets}
 
@@ -33,6 +35,8 @@ For example: @racket['((-1 . 2) (4 . 10))] is a well-formed-set as is
 @racket['((1 . 5) (-3 . -1))], @racket['((5 . 1))], and @racket['((1
 . 5) (3 . 6))] are not.
 
+An integer set implements the @racket-tech{stream} and
+@racket-tech{sequence} generic interfaces.
 
 @defproc[(make-integer-set [wfs well-formed-set?]) integer-set?]{
 

collects/tests/data/integer-set.rkt

@@ -1,5 +1,6 @@
 #lang racket/base
 (require data/integer-set
+         racket/stream
          rackunit)
 
 (test-equal? "integer-set"
@@ -43,12 +44,19 @@
 (check-true (member? (get-integer s1) s1))
 (check-false (get-integer (make-integer-set '())))
 
-;; TODO: custom equal?
-#;
 (check-equal? (partition (list (make-integer-set '((1 . 2) (5 . 10)))
                                (make-integer-set '((2 . 2) (6 . 6) (12 . 12)))))
-              (list (make-integer-set '((1 . 1) (5 . 5) (7 . 10)))
+              (list (make-integer-set '((2 . 2) (6 . 6)))
-                    (make-integer-set '((2 . 2) (6 . 6)))
+                    (make-integer-set '((12 . 12)))
-                    (make-integer-set '((12 . 12)))))
+                    (make-integer-set '((1 . 1) (5 . 5) (7 . 10)))))
 
 (check-true (subset? (make-integer-set '((1 . 1))) s2))
+
+;; check gen:stream
+(check-equal? (stream-first s1) -1)
+(check-equal? (stream-first (stream-rest s1)) 0)
+(check-equal? (stream-first (stream-rest s2)) 3)
+(check-true (stream-empty? (make-integer-set '())))
+(check-false (stream-empty? s1))
+(check-equal? (stream->list (stream-map add1 s2)) '(2 4))
+