(module table-from-set mzscheme

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

  (require "table-interface.ss"
           "../iterator/iterator-interface.ss"
           "../set/set-interface.ss"
           "../set/unordered-set.ss"
           "../private/method.ss"
           "../private/contracts.ss"
           "../private/binding.ss")

  (provide/contract
   [table-from-set% (implementation?/c table<%>)]
   [make-table-from-set ((set-of/c binding?) . -> . table/c)])

  (define (make-table-from-set set)
    (new table-from-set% [set set]))

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

  (define table-from-set%
    (class* object% (table<%>)
      (super-new)

      (init-field set)

      (define/private (copy/set new-set)
        (new table-from-set% [set new-set]))

      (define/table (sexp)
        (map binding->sexp (send set elements)))

      (define/table (alist)
        (map (lambda (bind) (cons (binding-key bind) (binding-value bind)))
             (send set elements)))

      (define/table (keys)
        (map binding-key (send set elements)))

      (define/table (values)
        (map binding-value (send set elements)))

      (define/table (insert key value)
        (copy/set (send set insert (make-binding key value))))

      (define/table lookup
        (opt-lambda (key [failure (constant #f)] [success identity])
          (send set lookup (make-binding key null)
                failure
                (compose success binding-value))))

      (define/table lookup/key
        (opt-lambda (key [failure (constant #f)] [success (lambda (k v) k)])
          (send set lookup (make-binding key null)
                failure
                (lambda (binding)
                  (success (binding-key binding) (binding-value binding))))))

      (define/table (update key transform)
        (table-lookup/key key
                          (lambda () this)
                          (lambda (k v)
                            (table-insert k (transform k v)))))

      (define/table (update/value key transform)
        (table-update key (lambda (k v) (transform v))))

      (define/table (update/insert key transform value)
        (table-lookup/key key
                          (lambda () (table-insert key value))
                          (lambda (k v)
                            (table-insert k (transform k v)))))

      (define/table (update/insert/value key transform value)
        (table-update/insert key (lambda (k v) (transform v)) value))

      (define/table (iterator)
        (new binding-iterator% [set-iter (send set iterator)]))

      (define/table (remove key)
        (copy/set (send set remove (make-binding key 'placeholder))))

      (define/table (select)
        (let* ([binding (send set select)])
          (values (binding-key binding)
                  (binding-value binding))))

      (define/table (select/key)
        (let*-values ([(key value) (table-select)])
          key))

      (define/table (select/value)
        (let*-values ([(key value) (table-select)])
          value))

      (define/table (empty?)
        (send set empty?))

      (define/table (clear)
        (copy/set (send set clear)))

      (define/table (size)
        (send set size))

      (define/table (contains? key)
        (table-lookup key (lambda () #f) (lambda (any) #t)))

      (define/table (fold combine init)
        (send set fold
              (lambda (binding result)
                (combine (binding-key binding)
                         (binding-value binding)
                         result))
              init))

      (define/table (fold/key combine init)
        (table-fold (lambda (key value result) (combine key result)) init))

      (define/table (fold/value combine init)
        (table-fold (lambda (key value result) (combine value result)) init))

      (define/table (map transform)
        (table-fold (lambda (key value table)
                      (send table insert key (transform key value)))
                    (table-clear)))

      (define/table (map/key transform)
        (table-map (lambda (key value) (transform key))))

      (define/table (map/value transform)
        (table-map (lambda (key value) (transform value))))

      (define/table (filter predicate)
        (copy/set (send set filter
                        (lambda (binding)
                          (predicate (binding-key binding)
                                     (binding-value binding))))))

      (define/table (filter/key predicate)
        (table-filter (lambda (key value) (predicate key))))

      (define/table (filter/value predicate)
        (table-filter (lambda (key value) (predicate value))))

      (define/table (for-each action)
        (send set for-each
              (lambda (binding)
                (action (binding-key binding)
                        (binding-value binding)))))

      (define/table (for-each/key action)
        (table-for-each (lambda (key value) (action key))))

      (define/table (for-each/value action)
        (table-for-each (lambda (key value) (action value))))

      (define/table (all? predicate)
        (send set all?
              (lambda (binding)
                (predicate (binding-key binding)
                           (binding-value binding)))))

      (define/table (all?/key predicate)
        (table-all? (lambda (key value) (predicate key))))

      (define/table (all?/value predicate)
        (table-all? (lambda (key value) (predicate value))))

      (define/table (any? predicate)
        (send set any?
              (lambda (binding)
                (predicate (binding-key binding)
                           (binding-value binding)))))

      (define/table (any?/key predicate)
        (table-any? (lambda (key value) (predicate key))))

      (define/table (any?/value predicate)
        (table-any? (lambda (key value) (predicate value))))

      (define/table union
        (opt-lambda (other [combine (lambda (key one two) one)])
          (send other fold
                (lambda (key value set)
                  (if (table-contains? key)
                      (send set insert key
                            (combine key (table-lookup key) value))
                      (send set insert key value)))
                this)))

      (define/table union/value
        (opt-lambda (other [combine (lambda (one two) one)])
          (table-union other (lambda (key one two) (combine one two)))))

      (define/table intersection
        (opt-lambda (other [combine (lambda (key one two) one)])
          (send other fold
                (lambda (key value set)
                  (if (table-contains? key)
                      (send set insert key
                            (combine key (table-lookup key) value))
                      set))
                (table-clear))))

      (define/table intersection/value
        (opt-lambda (other [combine (lambda (one two) one)])
          (table-intersection other (lambda (key one two) (combine one two)))))

      (define/table (difference other)
        (table-filter/key (lambda (key) (not (send other contains? key)))))

      (define/table (subtable? value=? other)
        (table-all? (lambda (key value1)
                      (send other lookup key
                            (lambda () #f)
                            (lambda (value2) (value=? value1 value2))))))

      (define/table (equal? value=? other)
        (and (send other all?/key (lambda (key) (table-contains? key)))
             (table-subtable? value=? other)))

      ))

  (define binding-iterator%
    (class* object% (indexed-iterator<%>)
      (super-new)

      (init-field set-iter)

      (define/private (copy/iter iter)
        (new binding-iterator% [set-iter iter]))

      (define/public (end?)
        (send set-iter end?))

      (define/public (next)
        (copy/iter (send set-iter next)))

      (define/public (key)
        (binding-key (send set-iter element)))

      (define/public (element)
        (binding-value (send set-iter element)))

      ))

  )