(module simple-bag mzscheme
  
  (require "../private/require.ss")
  (require-class)
  (require-contracts)
  (require-lists)
  (require-etc)

  (require ;;"../private/contracts.ss"
           "../private/method.ss"
           "../iterator/iterator-interface.ss"
           "bag-interface.ss"
           "abstract-bag.ss")
  
  (define-syntax (define/bag stx)
    (syntax-case stx ()
      [(_ . REST)
       #'(define/export override bag- . REST)]))
  
  (provide/contract
   [make-simple-bag (([equ? equality/c]
                      [elems (listof any/c)])
                     . ->r . bag/c)]
   [simple-bag% (implementation?/c bag<%>)])
  
  (define (make-simple-bag equ? elems)
    (foldl (lambda (e b)
             (send b insert e))
           (new simple-bag% [equ? equ?] [alist null])
           elems))
  
  ;; This class is here to give an example of the most barebones implementation
  ;; of a bag possible by subclassing abstract-bag% (i.e. we only override
  ;; methods defined in abstract-bag% by define/abstract).
  (define simple-bag%
    (class* abstract-bag% (bag<%>)
      (super-new)
      
      (init-field equ? alist)
      
      (define/private (copy/alist alist)
        (new simple-bag% [equ? equ?] [alist alist]))
      
      (define/bag lookup/count
        (opt-lambda (elem [failure (constant #f)] (success (lambda (e c) e)))
          (let ([ec-pair (srfi1:assoc elem alist equ?)])
            (if ec-pair
                ;; srf1:assoc-cons uses pairs, not lists, so use car/cdr
                ;; instead of first/second.
                (success (car ec-pair) (cdr ec-pair))
                (failure)))))
      
      ;; combine : Integer alist -> alist
      (define/private (combine/count combine elem)
        (bag-lookup/count elem
                          (lambda ()
                            (copy/alist (combine 0 alist)))
                          (lambda (e c)
                            (let ([new-bag (srfi1:alist-delete elem alist equ?)])
                              (copy/alist (combine c new-bag))))))
      
      (define/bag (insert/count elem count)
        (if (positive? count)
            (combine/count (lambda (c alist)
                             (srfi1:alist-cons elem (+ c count) alist))
                           elem)
            this))
      
      (define/bag (remove/count elem count)
        (if (positive? count)
            (combine/count (lambda (c alist)
                             (if (<= c count)
                                 alist
                                 (srfi1:alist-cons elem (- c count) alist)))
                           elem)
            this))
      
      (define/bag (select/count)
        (let ([ec (car alist)])
          (values (car ec) (cdr ec))))
            
      (define/bag (iterator)
        (new simple-counted-iterator% [alist alist]))
      ))
  
  (define simple-counted-iterator%
    (class* object% (counted-iterator<%>)
      (super-new)
      
      (init-field alist)
      
      (define/private (copy/alist alist)
        (new simple-counted-iterator% [alist alist]))
      
      (define/public (end?)
        (null? alist))
      
      (define/public (element)
        (car (first alist)))
      
      (define/public (count)
        (cdr (first alist)))
      
      (define/public (next)
        (copy/alist (rest alist)))
      ))
  )