(module abstract-set mzscheme (require "../private/require.ss") (require-class) (require-contracts) (require-etc) (require "set-interface.ss" "../private/method.ss") (provide/contract [abstract-set% (implementation?/c set<%>)]) (define-syntax (define/set stx) (syntax-case stx () [(_ . REST) #'(define/export public set- . REST)])) (define-syntax (define/abstract stx) (syntax-case stx () [(_ NAME) #'(define/set (NAME . args) (error 'NAME "abstract"))])) (define abstract-set% (class* object% (set<%>) (super-new) (define/abstract clear) (define/abstract elements) (define/abstract insert) (define/abstract lookup) (define/abstract iterator) (define/abstract remove) (define/abstract empty?) (define/abstract size) (define/abstract select) (define/set (member? elem) (set-lookup elem (lambda () #f) (lambda (any) #t))) (define/set (fold combine init) (recur loop ([result init] [iter (set-iterator)]) (if (send iter end?) result (loop (combine (send iter element) result) (send iter next))))) (define/set (map transform) (set-fold (lambda (elem set) (send set insert (transform elem))) (set-clear))) (define/set (for-each action) (set-fold (lambda (elem _) (action elem)) (void))) (define/set (filter predicate) (set-fold (lambda (elem set) (if (predicate elem) (send set insert elem) set)) (set-clear))) (define/set (all? predicate) (recur loop ([iter (set-iterator)]) (if (send iter end?) #t (and (predicate (send iter element)) (loop (send iter next)))))) (define/set (any? predicate) (not (set-all? (compose not predicate)))) (define/set union (opt-lambda (other [combine (lambda (one two) one)]) (send other fold (lambda (elem set) (if (set-member? elem) (send set insert (combine (set-lookup elem) elem)) (send set insert elem))) this))) (define/set intersection (opt-lambda (other [combine (lambda (one two) one)]) (send other fold (lambda (elem set) (if (set-member? elem) (send set insert (combine (set-lookup elem) elem)) set)) (set-clear)))) (define/set (difference other) (set-filter (lambda (elem) (not (send other member? elem))))) (define/set (subset? other) (set-all? (lambda (elem) (send other member? elem)))) (define/set (equal? other) (and (set-subset? other) (send other subset? this))) )) )