(module ordered-set mzscheme

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

  (require "set-interface.ss"
           "abstract-set.ss"
           "../iterator/iterator-interface.ss"
           "../private/contracts.ss"
           "../private/method.ss"
           (prefix rb: "../private/red-black-tree.ss"))
  (require-for-syntax "../private/syntax.ss")

  (provide/contract
   [ordered-set% (implementation?/c set<%>)]
   [make-ordered-set (([compare comparison/c]
                       [elems (listof any/c)])
                      . ->r . set/c)])

  (define (make-ordered-set compare elems)
    (new ordered-set% [compare compare] [tree (rb:list->set compare elems)]))

  (define-syntax (define/set stx)
    (syntax-case stx ()
      [(_ . REST) #'(define/export override set- . REST)]))

  (define ordered-set%
    (class* abstract-set% (set<%>)
      (super-new)

      (init-field compare tree)

      (define/private (copy/tree new-tree)
        (new ordered-set%
             [compare compare]
             [tree new-tree]))

      (define/set (elements)
        (rb:elements tree))

      (define/set (insert elem)
        (copy/tree (rb:insert/combiner compare elem tree
                                       ;; Make sure the NEW element is kept
                                       (constant elem))))

      (define/set lookup
        (opt-lambda (elem [failure (constant #f)] [success identity])
          (if (rb:member? compare elem tree)
              (success (rb:get compare elem tree))
              (failure))))

      (define/set (iterator)
        (new rb-tree-iterator% [tree tree] [compare compare]))

      (define/set (remove elem)
        (copy/tree (rb:remove compare elem tree)))

      (define/set (empty?)
        (rb:empty? tree))

      (define/set (clear)
        (copy/tree rb:empty))

      (define/set (size)
        (rb:size tree))

      (define/set (fold f init)
        (rb:fold f init tree))
      
      (define/set (select)
        (rb:find-min tree))

      ))

  (define rb-tree-iterator%
    (class* object% (iterator<%>)
      (super-new)

      (init-field tree compare)

      (define/private (copy/tree new-tree)
        (new rb-tree-iterator% [tree new-tree] [compare compare]))

      (define/public (end?)
        (rb:empty? tree))

      (define/public (element)
        (rb:find-min tree))

      (define/public (next)
        (copy/tree (rb:remove compare (element) tree)))

      ))

  )