(module hashed-set mzscheme
(require "../private/require.ss")
(require-contracts)
(require-lists)
(require-compare)
(require-etc)
(require-class)
(require "../private/method.ss"
"set-interface.ss"
"abstract-set.ss"
"../iterator/iterator-interface.ss"
"unordered-set.ss"
"../table/ordered-table.ss")
(provide/contract
[hashed-set% (implementation?/c set<%>)]
[make-hashed-set (([hash hash-fn/c]
[equ? equality/c]
[elems (listof any/c)])
. ->r . set/c)])
(define (make-hashed-set hash equ? elems)
(foldl (lambda (elem set) (send set insert elem))
(new hashed-set%
[hash hash] [equ? equ?]
[groups (make-ordered-table number-compare null null)])
elems))
(define-syntax (define/set stx)
(syntax-case stx ()
[(_ . REST) #'(define/export override set- . REST)]))
(define hashed-set%
(class* abstract-set% (set<%>)
(super-new)
(init-field hash equ? groups)
(define/private (copy/groups new-groups)
(new hashed-set% [hash hash] [equ? equ?] [groups new-groups]))
(define/private (copy/group key group)
(if (send group empty?)
(copy/groups (send groups remove key))
(copy/groups (send groups insert key group))))
(define/private (get-group key)
(send groups lookup key
(lambda () (make-unordered-set equ? null))))
(define/set (clear)
(copy/groups (send groups clear)))
(define/set (elements)
(apply append
(map (lambda (group) (send group elements))
(map second (send groups sexp)))))
(define/set (insert elem)
(let* ([key (hash elem)])
(copy/group key (send (get-group key) insert elem))))
(define/set lookup
(opt-lambda (elem [failure (constant #f)] [success identity])
(send (get-group (hash elem)) lookup elem failure success)))
(define/set (iterator)
(new hashed-iterator% [group-iter (send groups iterator)]))
(define/set (remove elem)
(let* ([key (hash elem)])
(copy/group key (send (get-group key) remove elem))))
(define/set (empty?)
(send groups empty?))
(define/set (size)
(send groups fold/value
(lambda (group total)
(+ (send group size) total))
0))
(define/set (select)
(send (send groups select/value) select))
))
(define hashed-iterator%
(class* object% (iterator<%>)
(super-new)
(init-field group-iter)
(define/private (copy/group-iter new-iter)
(new hashed-iterator% [group-iter new-iter]))
(define/public (end?)
(send group-iter end?))
(define/public (element)
(send (send (send group-iter element) iterator) element))
(define/public (next)
(new append-iterator%
[first (send (send (send group-iter element) iterator) next)]
[second (copy/group-iter (send group-iter next))]))
))
(define append-iterator%
(class* object% (iterator<%>)
(super-new)
(init-field first second)
(define/private (copy/first new-first)
(new append-iterator% [first new-first] [second second]))
(define/public (end?)
(and (send first end?) (send second end?)))
(define/public (element)
(if (send first end?)
(send second element)
(send first element)))
(define/public (next)
(if (send first end?)
(send second next)
(copy/first (send first next))))
))
)