chibi-scheme/lib/srfi/1/lset.scm

;; lset.scm -- list set library
;; Copyright (c) 2009-2012 Alex Shinn.  All rights reserved.
;; BSD-style license: http://synthcode.com/license.txt

(define (lset<= eq . sets)
  (if (null? sets)
      #t
      (let lp1 ((set1 (car sets)) (sets (cdr sets)))
        (if (null? sets)
            #t
            (let ((set2 (car sets)))
              (let lp2 ((ls set1))
                (if (pair? ls)
                    (and (member (car ls) set2 eq) (lp2 (cdr ls)))
                    (lp1 set2 (cdr sets)))))))))

(define (lset= eq . sets)
  (and (apply lset<= eq sets)
       (apply lset<= (lambda (b a) (eq a b)) (reverse sets))))

(define (lset-adjoin eq set . elts)
  (lset-union2 eq set elts))

(define (lset-union2 eq a b)
  (if (null? b)
      a
      (lset-union2 eq (if (member (car b) a eq) a (cons (car b) a)) (cdr b))))

(define (lset-union eq . sets)
  (reduce (lambda (a b) (lset-union2 eq b a)) '() sets))

(define (lset-intersection eq . sets)
  (reduce (lambda (a b) (filter (lambda (x) (member x a eq)) b)) '() sets))

(define (lset-diff2 eq a b)
  (remove (lambda (x) (member x a eq)) b))

(define (lset-difference eq . sets)
  (reduce (lambda (a b) (lset-diff2 eq a b)) '() sets))

(define (lset-xor eq . sets)
  (reduce (lambda (a b) (append (lset-diff2 eq a b) (lset-diff2 eq b a)))
          '()
          sets))

(define (lset-diff+intersection eq . sets)
  (values (apply lset-difference eq sets) (apply lset-intersection eq sets)))

(define lset-diff+intersection! lset-diff+intersection)
(define lset-xor! lset-xor)
(define lset-difference! lset-difference)
(define lset-intersection! lset-intersection)
(define lset-union! lset-union)