diff --git a/collects/data/integer-set.rkt b/collects/data/integer-set.rkt index b8c0b3dd01..306eaf4056 100644 --- a/collects/data/integer-set.rkt +++ b/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) diff --git a/collects/data/scribblings/integer-set.scrbl b/collects/data/scribblings/integer-set.scrbl index 51b5de8c3a..d5f712b612 100644 --- a/collects/data/scribblings/integer-set.scrbl +++ b/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?]{ diff --git a/collects/tests/data/integer-set.rkt b/collects/tests/data/integer-set.rkt index dd8ec62003..9cde9f8577 100644 --- a/collects/tests/data/integer-set.rkt +++ b/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))) - (make-integer-set '((2 . 2) (6 . 6))) - (make-integer-set '((12 . 12))))) + (list (make-integer-set '((2 . 2) (6 . 6))) + (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)) +