
(defvar set:equal-op (quote equal) "\
Comparison function used by set operators.
It must be a function of two arguments which returns non-nil only when
the arguments are equivalent.")

(defmacro set:add (elt set) "Adds element ELT to SET and then returns SET.
Uses 'set:equal-op' for comparison.
Use (setq set (set:add elt set)) to assure set is always properly modified." (byte-code "ÂÃ	E	D	Ä	Å	EEDÆÇDDF‡" [elt set cond set:member setq cons t list] 8))

(defun set:combinations (set &optional arity) "\
Returns all possible combinations (subsets) of SET.
Assumes SET is a valid set.  With optional ARITY, returns only subsets with
ARITY members." (byte-code "?ƒ Æ‰ˆÁÇÈÉÊ
\"\"B‚5 ËUƒ 
‚5 ÆXƒ) Ì‚5 ÁËÇÈÉÍ
\"\"*‡" [arity nil set t rest ctr 0 apply nconc mapcar (lambda (elt) (setq arity (1+ arity)) (set:combinations set arity)) 1 (nil) (lambda (first) (setq rest (nthcdr ctr set) ctr (1+ ctr)) (mapcar (quote (lambda (elt) (if (listp elt) (cons first elt) (list first elt)))) (set:combinations rest (1- arity))))] 7))

(defun set:create (&rest elements) "\
Returns a new set created from any number of ELEMENTS or a list of ELEMENTS.
Uses 'set:equal-op' for comparison." (byte-code "ÂÃÄ	@?† 	@<?ƒ 	‚ 	@\"ˆ)‡" [set elements nil mapcar (lambda (elt) (or (set:member elt set) (setq set (cons elt set))))] 3))

(fset (quote set:delete) (quote set:remove))

(defun set:difference (&rest sets) "\
Returns difference of any number of SETS.
Difference is the set of elements in the first set that are not in any of the
other sets.  Uses 'set:equal-op' for comparison." (byte-code "Â	@!ÃÄ	A\"ˆ)‡" [rtn-set sets set:members mapcar (lambda (set) (mapcar (quote (lambda (elt) (set:remove elt rtn-set))) set))] 4))

(defun set:equal (set1 set2) "\
Returns t iff SET1 contains the same members as SET2.  Both must be sets.
Uses 'set:equal-op' for comparison." (byte-code "<… 	<… Â!Â	!U… Ã	\"‡" [set1 set2 set:size set:subset] 5))

(defun set:intersection (&rest sets) "\
Returns intersection of all SETS given as arguments.
Uses 'set:equal-op' for comparison." (byte-code "ÂÃÄ	@\"ˆ)‡" [rtn-set sets nil mapcar (lambda (elt) (or (memq nil (mapcar (quote (lambda (set) (set:member elt set))) (cdr sets))) (setq rtn-set (cons elt rtn-set))))] 3))

(defun set:is (obj) "\
Returns t if OBJ is a set (a list with no repeated elements).
Uses 'set:equal-op' for comparison." (byte-code "<…! Â	@	A\"?… 	A‰… Ãˆ‚ ˆ	?)‡" [obj lst set:member nil] 3))

(fset (quote set:map) (quote mapcar))

(defun set:member (elt set) "\
Returns non-nil if ELT is an element of SET.
The value is actually the tail of SET whose car is ELT.
Uses 'set:equal-op' for comparison." (byte-code "… Ã	@
#?… A‰ˆ‚  ˆ‡" [set set:equal-op elt funcall] 4))

(defun set:members (list) "\
Returns set of unique elements of LIST.
Uses 'set:equal-op' for comparison.  See also 'set:create'." (let (set) (mapcar (quote (lambda (elt) (or (set:member elt set) (setq set (cons elt set))))) list) set))

(defmacro set:remove (elt set) "Removes element ELT from SET and returns new set.
Assumes SET is a valid set.  Uses 'set:equal-op' for comparison.
Use (setq set (set:remove elt set)) to assure set is always properly modified." (byte-code "ÂÃÄ	EDÅ	DDÆÅF‡" [elt set let rest set:member rtn (if rest (cond ((= (length rtn) 1) (setq rtn nil)) ((= (length rest) 1) (setcdr (nthcdr (- (length rtn) 2) rtn) nil)) (t (setcar rest (car (cdr rest))) (setcdr rest (cdr (cdr rest))))))] 5))

(fset (quote set:size) (quote length))

(defun set:subset (sub set) "\
Returns t iff set SUB is a subset of SET.
Uses 'set:equal-op' for comparison." (byte-code "ÁÃÄ
\"ˆ… Á)‡" [is t sub mapcar (lambda (elt) (if is (setq is (set:member elt set))))] 3))

(defun set:union (&rest sets) "\
Returns union of all SETS given as arguments.
Uses 'set:equal-op' for comparison." (byte-code "ÂÃÄÅ	@!\"ˆÃÆ	A\"ˆ)‡" [rtn-set sets nil mapcar (lambda (elt) (cons elt rtn-set)) set:members (lambda (set) (mapcar (quote (lambda (elt) (set:add elt rtn-set))) set))] 5))

(provide (quote set))