;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                          Set Operations                          ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Classes

;;; Set class.
(defclass <set> ()
  (set-elements :type      <list>
                :accessor  set-elements
                :initarg   :elements
                :initvalue '()))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Interface

;;; Create a new set
;;; (define (make-set . values) ...)

;;; Is object an element in the set?
(defgeneric (element? object set))

;;; Return the union of the object and the set
(defgeneric (union object set))

;;; Destructively add object to the set
(defgeneric (insert! object set))

;;; Return the intersection of the two sets
(defgeneric (intersection set1 set2))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Implementation

;;; Create a new set with the values passed to this function
(define (make-set . values)
  (make <set> :elements values))

;;; Return #t if object is in the set, #f otherwise
(defmethod (element? object (set <set>))
  (not (eq? (memq object (set-elements set)) #f)))

;;; Return set with union if it's not already there
(defmethod (union object (set <set>))
  (if (element? object set)
    set
    (make <set> :elements (cons object (set-elements set)))))

;;; Return the union of set1 and set2 (no repeat values)
(defmethod (union (set1 <set>) (set2 <set>))
  (let ((elements1 (set-elements set1))
        (elements2 (set-elements set2)))
    (define (rec-union e1 e2)
      (cond ((null? e1) e2)
            ((memq (head e1) e2)
             (rec-union (tail e1) e2))
            (else
             (rec-union (tail e1) (cons (head e1) e2)))))
    (make <set> :elements (rec-union elements1 elements2))))

;;; Destructively add object to set if not already there
(defmethod (insert! object (set <set>))
  (unless (element? object set)
    (set! (set-elements set) (cons object (set-elements set)))))

;;; Return the intersection of set1 and set2
(defmethod (intersection (set1 <set>) (set2 <set>))
  (let ((elements1 (set-elements set1))
        (elements2 (set-elements set2)))
    (define (weed-out e1 e2 res)
      (cond ((null? e1) res)
            ;; Elements can only show up once in either set, so we can
            ;; add any matches to the result without worry of duplicates
            ((memq (head e1) e2)
             (weed-out (tail e1) e2 (cons (head e1) res)))
            (else
             (weed-out (tail e1) e2 res))))
    (make <set> :elements (weed-out elements1 elements2 '()))))