;; This buffer is for notes you don't want to save, and for Lisp evaluation.
;; If you want to create a file, visit that file with C-x C-f,
;; then enter the text in that file's own buffer.

(require 'quack)


(define (adjoin obj lst) (if (memv obj lst) lst (cons obj lst)))
;@
(define union
  (letrec ((onion
	    (lambda (lst1 lst2)
	      (if (null? lst1)
		  lst2
		  (onion (cdr lst1) (comlist:adjoin (car lst1) lst2))))))
    (lambda (lst1 lst2)
      (cond ((null? lst1) lst2)
	    ((null? lst2) lst1)
	    ((null? (cdr lst1)) (comlist:adjoin (car lst1) lst2))
	    ((null? (cdr lst2)) (comlist:adjoin (car lst2) lst1))
	    ((< (length lst2) (length lst1)) (onion (reverse lst2) lst1))
	    (else (onion (reverse lst1) lst2))))))
;@
(define (intersection lst1 lst2)
  (if (null? lst2)
      lst2
      (let build-intersection ((lst1 lst1)
			       (result '()))
	(cond ((null? lst1) (reverse result))
	      ((memv (car lst1) lst2)
	       (build-intersection (cdr lst1) (cons (car lst1) result)))
	      (else
	       (build-intersection (cdr lst1) result))))))
;@
(define (set-difference lst1 lst2)
  (if (null? lst2)
      lst1
      (let build-difference ((lst1 lst1)
			     (result '()))
	(cond ((null? lst1) (reverse result))
	      ((memv (car lst1) lst2) (build-difference (cdr lst1) result))
	      (else (build-difference (cdr lst1) (cons (car lst1) result)))))))
;@
(define (subset? lst1 lst2)
  (or (eq? lst1 lst2)
      (let loop ((lst1 lst1))
	(or (null? lst1)
	    (and (memv (car lst1) lst2)
		 (loop (cdr lst1)))))))
;@
(define (position obj lst)
  (define pos (lambda (n lst)
		(cond ((null? lst) #f)
		      ((eqv? obj (car lst)) n)
		      (else (pos (+ 1 n) (cdr lst))))))
  (pos 0 lst))

above are the originals from comlist.scm
XXXX

(define mem
  (lambda (obj lst . pred-equal?)
    (cond
      ((null? lst) #f)
      ((null? pred-equal?) (memv obj lst))
      (#t
        (let ((pred (car pred-equal?)))
        (if (pred obj (car lst)) lst
          (mem obj (cdr lst) pred)))))))

;(define (adjoin obj lst) (if (memv obj lst) lst (cons obj lst)))

(define adjoi
  (lambda (obj lst . pred-equal?)
    (cond
      ((null? lst) (list obj))
      ((null? pred-equal?) (adjoin obj lst))
      (#t
        (if (mem obj lst (car pred-equal?))
          lst
          (cons obj lst))))))


;@
(define unio
  (letrec ((onio
	    (lambda (lst1 lst2 . pred-equal?)
              (if (null? pred-equal?)
                (if (null? lst1)
		  lst2
		  (onio (cdr lst1) (comlist:adjoin (car lst1) lst2) pred-equal?)))))
(lambda (lst1 lst2 . p-equal?)
      (cond ((null? lst1) lst2)
	    ((null? lst2) lst1)
	    ((null? (cdr lst1)) (comlist:adjoin (car lst1) lst2))
	    ((null? (cdr lst2)) (comlist:adjoin (car lst2) lst1))
	    ((< (length lst2) (length lst1)) (onio (reverse lst2) lst1))
	    (else (onio (reverse lst1) lst2))))))

;@
(define (intersection lst1 lst2)
  (if (null? lst2)
      lst2
      (let build-intersection ((lst1 lst1)
			       (result '()))
	(cond ((null? lst1) (reverse result))
	      ((memv (car lst1) lst2)
	       (build-intersection (cdr lst1) (cons (car lst1) result)))
	      (else
	       (build-intersection (cdr lst1) result))))))
;@
(define (set-difference lst1 lst2)
  (if (null? lst2)
      lst1
      (let build-difference ((lst1 lst1)
			     (result '()))
	(cond ((null? lst1) (reverse result))
	      ((memv (car lst1) lst2) (build-difference (cdr lst1) result))
	      (else (build-difference (cdr lst1) (cons (car lst1) result)))))))
;@
(define (subset? lst1 lst2)
  (or (eq? lst1 lst2)
      (let loop ((lst1 lst1))
	(or (null? lst1)
	    (and (memv (car lst1) lst2)
		 (loop (cdr lst1)))))))
;@
(define (position obj lst)
  (define pos (lambda (n lst)
		(cond ((null? lst) #f)
		      ((eqv? obj (car lst)) n)
		      (else (pos (+ 1 n) (cdr lst))))))
  (pos 0 lst))