(module hashed-set mzscheme

  (require "../private/require.ss")
  (require-contracts)
  (require-lists)
  (require-compare)
  (require-etc)
  (require-class)

  (require "../private/contracts.ss"
           "../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))))

      ))

  )