(module unordered-set mzscheme
(require "../private/require.ss")
(require-contracts)
(require-etc)
(require-lists)
(require-class)
(require "set-interface.ss"
"abstract-set.ss"
"../iterator/iterator-interface.ss"
"../private/method.ss")
(require-for-syntax "../private/syntax.ss")
(provide/contract
[unordered-set% (implementation?/c set<%>)]
[make-unordered-set (([equ? equality/c]
[elems (listof any/c)])
. ->r . set/c)])
(define (make-unordered-set equ? elems)
(new unordered-set% [equ? equ?] [elems elems]))
(define-syntax (define/set stx)
(syntax-case stx ()
[(_ . REST) #'(define/export override set- . REST)]))
(define unordered-set%
(class* abstract-set% (set<%>)
(super-new)
(init-field equ? elems)
(define/private (copy/list new-list)
(new unordered-set%
[equ? equ?]
[elems new-list]))
(define/set (elements) elems)
(define/set (insert elem)
(copy/list (cons elem (filter (lambda (other)
(not (equ? other elem)))
elems))))
(define/set lookup
(opt-lambda (elem [failure (constant #f)] [success identity])
(recur loop ([search elems])
(if (null? search)
(failure)
(if (equ? (car search) elem)
(success (car search))
(loop (cdr search)))))))
(define/set (iterator)
(new list-iterator% [elements elems]))
(define/set (remove elem)
(copy/list (filter (lambda (other) (not (equ? other elem))) elems)))
(define/set (empty?)
(null? elems))
(define/set (clear)
(copy/list null))
(define/set (size)
(length elems))
(define/set (fold f init)
(foldl f init elems))
(define/set (filter f)
(copy/list (filter f elems)))
(define/set (all? f)
(andmap f elems))
(define/set (any? f)
(ormap f elems))
(define/set (select)
(car elems))
))
(define list-iterator%
(class* object% (iterator<%>)
(super-new)
(init-field elements)
(define/private (copy/list new-list)
(new list-iterator% [elements new-list]))
(define/public (end?)
(null? elements))
(define/public (element)
(car elements))
(define/public (next)
(copy/list (cdr elements)))
))
)