(module abstract-bag mzscheme

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

  (require (lib "11.ss" "srfi")
           "bag-interface.ss"
           "../private/method.ss")

  (provide/contract
   [abstract-bag% (implementation?/c bag<%>)])

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

  (define-syntax (define/abstract stx)
    (syntax-case stx ()
      [(_ NAME)
       #'(define/bag (NAME . args)
           (error 'NAME "abstract"))]))

  (define abstract-bag%
    (class* object% (bag<%>)
      (super-new)

      ;; Only these four methods need to be overridden in order to make a bag.
      ;; Of course, the other methods can be overridden with more efficient
      ;; implementations.
      (define/abstract insert/count)
      (define/abstract select/count)
      (define/abstract iterator)
      (define/abstract lookup/count)
      (define/abstract remove/count)

      (define/bag (select)
        (let-values ([(elem count) (bag-select/count)])
          elem))
      
      (define/private (ec-map f)
        (bag-fold/count (lambda (e c i)
                          (cons (f e c) i))
                        null))

      (define/bag (elements)
        (ec-map (lambda (e c) e)))
      (define/bag (alist)
        (ec-map cons))
      (define/bag (sexp)
        (ec-map list))
      
      (define/bag (empty?)
        (null? (bag-elements)))
      
      (define/bag (clear)
        (bag-fold/count (lambda (e c i)
                          (send i remove/count e c))
                        this))

      (define/bag lookup
        (opt-lambda (elem [failure (constant #f)] [success identity])
          (bag-lookup/count elem failure (lambda (e c) (success e)))))
      
      (define/bag (insert elem)
        (bag-insert/count elem 1))
      
      (define/bag (insert* . elems)
        (bag-fold (lambda (e b)
                    (send b insert e))
                  this))
      
      (define/bag (remove elem)
        (bag-remove/count elem 1))
      
      (define/bag (remove* . elems)
        (foldl (lambda (e b)
                 (send b remove e))
               this
               elems))
      
      (define/bag (remove/all elem)
        (bag-lookup/count elem 
                          (constant this)
                          (lambda (e c)
                            (bag-remove/count e c))))
      
      (define/bag (count elem)
        (bag-lookup/count elem (constant 0) (lambda (e c) c)))
      
      ;; size-helper : {Bag Elem} [Boolean] -> Integer
      (define/private size-helper
        (opt-lambda ([unique? #f])
          (bag-fold/count (lambda (e c i)
                            (+ i (if unique? 1 c)))
                          0)))
      
      (define/bag (size)
        (size-helper #f))
      
      (define/bag (size/unique)
        (size-helper #t))
      
      (define/bag (member? elem)
        (bag-lookup elem (constant #f) (constant #t)))
      
      (define/bag (fold/count combine init)
        (recur loop ([result init]
                     [iter (bag-iterator)])
          (if (send iter end?)
              result
              (loop (combine (send iter element)
                             (send iter count)
                             result)
                    (send iter next)))))

      (define/bag (fold combine init)
        (bag-fold/count (lambda (e c i) (combine e i)) init))

      (define/bag (map/count transform)
        (bag-fold/count (lambda (e c i)
                          (send i insert/count (transform e c) c))
                        (bag-clear)))
      
      (define/bag (map transform)
        (bag-map/count (lambda (e c)
                         (transform e))))

      (define/bag (for-each/count action)
        (bag-fold/count (lambda (elem count _) (action elem count)) (void)))
      
      (define/bag (for-each action)
        (bag-for-each/count (lambda (e c) (action e))))

      (define/bag (filter/count pred?)
        (bag-fold/count (lambda (e c i)
                          (if (pred? e c)
                              (send i insert/count e c)
                              i))
                  (bag-clear)))
      
      (define/bag (filter pred?)
        (bag-filter/count (lambda (e c) (pred? e))))
      
      (define/bag (all?/count pred?)
        (bag-fold/count (lambda (e c i)
                          (and i (pred? e c)))
                        #t))
      
      (define/bag (all? pred?)
        (bag-all?/count (lambda (e c) (pred? e))))
      
      (define/bag (any?/count pred?)
        (bag-fold/count (lambda (e c i)
                          (or i (pred? e c)))
                        #f))
      
      (define/bag (any? pred?)
        (bag-any?/count (lambda (e c) (pred? e))))
      
      (define/private (combine-with/count new-bag b2 le gt)
        (send b2 fold/count
              (lambda (e c2 new-bag)
                (let ([c1 (bag-count e)])
                  (if (<= c1 c2)
                      (le new-bag e c1 c2)
                      (gt new-bag e c1 c2))))
              new-bag))

      (define/bag (union that)
        (send that fold/count
              (lambda (e2 c2 result)
                (bag-lookup/count
                 e2
                 (lambda () (send result insert/count e2 c2))
                 (lambda (e1 c1)
                   (if (> c2 c1)
                       (send result insert/count e1 (- c2 c1))
                       result))))
              this))

      (define/bag (intersection that)
        (send that fold/count
              (lambda (e2 c2 result)
                (bag-lookup/count
                 e2
                 (lambda () result)
                 (lambda (e1 c1) (send result insert/count e1 (min c1 c2)))))
              (bag-clear)))

      (define/bag (difference b2)
        (send b2 fold/count
              (lambda (e c2 new-bag)
                (let ([c1 (bag-count e)])
                  (if (<= c1 c2)
                      (send new-bag remove/all e)
                      (send new-bag remove/count e (- c1 c2)))))
              this))
      
      (define/bag (subbag? b2)
        (bag-all?/count (lambda (e c)
                          (<= c (send b2 count e)))))

      (define/bag (equal? b2)
        (and (bag-subbag? b2)
             (send b2 subbag? this)))
      
      ))

  )