; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
; SETS -- from Gambit utilities
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

(define (LIST->SET list)    list)         ; convert list to set
(define (SET->LIST set)     set)          ; convert set to list
(define (SET-EMPTY)         '())          ; the empty set
(define (SET-EMPTY? set)    (null? set))  ; is 'x' the empty set?
(define (SET-MEMBER? x set) (memq x set)) ; is 'x' a member of the 'set'?
(define (SET-SINGLETON x)   (list x))     ; create a set containing only 'x'

(define (SET-ADJOIN set x)                ; add the element 'x' to the 'set'
  (if (memq x set) set (cons x set)))

(define (SET-REMOVE set x)                ; remove the element 'x' from 'set'
  (cond ((null? set)       '())
        ((eq? (car set) x) (cdr set))
        (else              (cons (car set) (set-remove (cdr set) x)))))

(define (SET-EQUAL? s1 s2)
  (cond ((null? s1)         (null? s2))
        ((memq (car s1) s2) (set-equal? (cdr s1) (set-remove s2 (car s1))))
        (else               #f)))

(define (SET-DIFFERENCE set . other-sets) ; return difference of sets
  (define (difference s1 s2)
    (cond ((null? s1)         '())
          ((memq (car s1) s2) (difference (cdr s1) s2))
          (else               (cons (car s1) (difference (cdr s1) s2)))))
  (n-ary difference set other-sets))

(define (SET-UNION . sets)                ; return union of sets
  (define (union s1 s2)
    (cond ((null? s1)         s2)
          ((memq (car s1) s2) (union (cdr s1) s2))
          (else               (cons (car s1) (union (cdr s1) s2)))))
  (n-ary union '() sets))

(define (SET-INTERSECTION set . other-sets) ; return intersection of sets
  (define (intersection s1 s2)
    (cond ((null? s1)         '())
          ((memq (car s1) s2) (cons (car s1) (intersection (cdr s1) s2)))
          (else               (intersection (cdr s1) s2))))
  (n-ary intersection set other-sets))

(define (n-ary function first rest) ;; internal helper
  (if (null? rest)
    first
    (n-ary function (function first (car rest)) (cdr rest))))

(define (SET-KEEP keep? set)
  (cond ((null? set)       '())
        ((keep? (car set)) (cons (car set) (set-keep keep? (cdr set))))
        (else              (set-keep keep? (cdr set)))))

(define (SET-EVERY? pred? set)
  (or (null? set)
      (and (pred? (car set))
           (set-every? pred? (cdr set)))))

(define (SET-MAP proc set)
  (if (null? set)
    '()
    (cons (proc (car set)) (set-map proc (cdr set)))))

(define SET-FOREACH for-each)	;; (set-foreach proc set)	;; KAD

(define (SET-CHOOSE set) ; arbitrarily choose a member of set	;; KAD
  (if (null? set)
      '()
      (car set))
)

;;				--- E O F ---