#lang scheme
(require "private/common.ss")
(provide set? list->set set->list empty empty?
         intersection difference union xor
         intersections differences unions xors
         adjoin add contains?
         for/set for*/set)

(define-struct set (elts))

(define (list->set ls)
  (make-set (for/hasheq ([x ls])
              (values x #t))))

(define (set->list set)
  (for/list ([(key value) (set-elts set)])
    key))

(define (intersection set . sets)
  (make-set (foldr intersection-eq1 (set-elts set) (map set-elts sets))))

(define (intersections sets)
  (make-set (foldr1 intersection-eq1 (map set-elts sets))))

(define (difference set . sets)
  (make-set (foldl difference-eq1 (set-elts set) (map set-elts sets))))

(define (differences sets)
  (make-set (foldl1 difference-eq1 (map set-elts sets))))

(define empty (make-set #hasheq()))

(define (empty? set)
  (zero? (hash-count (set-elts set))))

(define (unions sets)
  (make-set (foldr union1 #hasheq() (map set-elts sets))))

(define (union . sets)
  (unions sets))

(define (xor . sets)
  (xors sets))

(define (xors sets)
  (make-set (foldr xor-eq1 #hasheq() (map set-elts sets))))

(define (adjoin set . elts)
  (union set (list->set elts)))

(define (add elt set)
  (adjoin set elt))

(define (contains? set elt)
  (hash-ref (set-elts set) elt (lambda () #f)))

(define-syntax-rule (for/set (for-clause ...) body0 body ...)
  (make-set (for/hash (for-clause ...)
              (values (let () body0 body ...) #t))))
  
(define-syntax-rule (for*/set (for-clause ...) body0 body ...)
  (make-set (for*/hash (for-clause ...)
              (values (let () body0 body ...) #t))))

;(define (set<=? . sets)
;  ...)
;
;(define (set=? . sets)
;  ...)