a function which
accepts only two arguments to more than 2 objects.  Functional
programmers usually refer to this as foldl."
  (cond ((null? l) l)
	((null? (cdr l)) (car l))
	(else (reduce-init p (car l) (cdr l)))))

(define (some pred l . rest)
  "PRED is a boolean function of as many arguments as there are list
arguments to `some', i.e., L plus any optional arguments.  PRED is
applied to successive elements of the list arguments in order.  As soon
as one of these applications returns a true value, return that value.
If no application returns a true value, return #f.
All the lists should have the same length."
  (cond ((null? rest)
	 (let mapf ((l l))
	   (and (not (null? l))
		(or (pred (car l)) (mapf (cdr l))))))
	(else (let mapf ((l l) (rest rest))
		(and (not (null? l))
		     (or (apply pred (car l) (map car rest))
			 (mapf (cdr l) (map cdr rest))))))))

(define (every pred l . rest)
  "Return #t iff every application of PRED to L, etc., returns #t.
Analogous to `some' except it returns #t if every application of
PRED is #t and #f otherwise."
  (cond ((null? rest)
	 (let mapf ((l l))
	   (or (null? l)
	       (and (pred (car l)) (mapf (cdr l))))))
	(else (let mapf ((l l) (rest rest))
		(or (null? l)
		    (and (apply pred (car l) (map car rest))
			 (mapf (cdr l) (map cdr rest))))))))

(define (notany pred . ls)
  "Return #t iff every application of PRED to L, etc., returns #f.
Analogous to some but returns #t if no application of PRED returns a
true value or #f as soon as any one does."
  (not (apply some pred ls)))

(define (notevery pred . ls)
  "Return #t iff there is an application of PRED to L, etc., that returns #f.
Analogous to some but returns #t as soon as an application of PRED returns #f,
or #f otherwise."
  (not (apply every pred ls)))

(define (count-if pred l)
  "Return the number of elements in L for which (PRED element) returns true."
  (let loop ((n 0) (l l))
    (cond ((null? l) n)
	  ((pred (car l)) (loop (+ n 1) (cdr l)))
	  (else (loop n (cdr l))))))

(define (find-if pred l)
  "Search for the first element in L for which (PRED element) returns true.
If found, return that element, otherwise return #f."
  (cond ((null? l) #f)
	((pred (car l)) (car l))
	(else (find-if pred (cdr l)))))

(define (member-if pred l)
  "Return the first sublist of L for whose car PRED is true."
  (cond ((null? l) #f)
	((pred (car l)) l)
	(else (member-if pred (cdr l)))))

(define (remove-if pred l)
  "Remove all elements from L where (PRED element) is true.
Return everything that's left."
  (let loop ((l l) (result '()))
    (cond ((null? l) (reverse! result))
	  ((pred (car l)) (loop (cdr l) result))
	  (else (loop (cdr l) (cons (car l) result))))))

(define (remove-if-not pred l)
  "Remove all elements from L where (PRED element) is #f.
Return everything that's left."
  (let loop ((l l) (result '()))
    (cond ((null? l) (reverse! result))
	  ((not (pred (car l))) (loop (cdr l) result))
	  (else (loop (cdr l) (cons (car l) result))))))

(define (delete-if! pred l)
  "Destructive version of `remove-if'."
  (let delete-if ((l l))
    (cond ((null? l) '())
	  ((pred (car l)) (delete-if (cdr l)))
	  (else
	   (set-cdr! l (delete-if (cdr l)))
	   l))))

(define (delete-if-not! pred l)
  "Destructive version of `remove-if-not'."
  (let delete-if-not ((l l))
    (cond ((null? l) '())
	  ((not (pred (car l))) (delete-if-not (cdr l)))
	  (else
	   (set-cdr! l (delete-if-not (cdr l)))
	   l))))

(define (butlast lst n)
  "Return all but the last N elements of LST."
  (letrec ((l (- (length lst) n))
	   (bl (lambda (lst n)
		 (cond ((null? lst) lst)
		       ((positive? n)
			(cons (car lst) (bl (cdr lst) (+ -1 n))))
		       (else '())))))
    (bl lst (if (negative? n)
		(error "negative argument to butlast" n)
		l))))

(define (and? . args)
  "Return #t iff all of ARGS are true."
  (cond ((null? args) #t)
	((car args) (apply and? (cdr args)))
	(else #f)))

(define (or? . args)
  "Return #t iff any of ARGS is true."
  (cond ((null? args) #f)
	((car args) #t)
	(else (apply or? (cdr args)))))

(define (has-duplicates? lst)
  "Return #t iff 2 members of LST are equal?, else #f."
  (cond ((null? lst) #f)
	((member (car lst) (cdr lst)) #t)
	(else (has-duplicates? (cdr lst)))))

(define (pick p l)
  "Apply P to each element of L, returning a list of elts
for which P returns a non-#f value."
  (let loop ((s '())
	     (l l))
    (cond
     ((null? l) 	s)
     ((p (car l))	(loop (cons (car l) s) (cdr l)))
     (else		(loop s (cdr l))))))

(define (pick-mappings p l)
  "Apply P to each element of L, returning a list of the
non-#f return values of P."
  (let loop ((s '())
	     (l l))
    (cond
     ((null? l) 	s)
     ((p (car l)) =>	(lambda (mapping) (loop (cons mapping s) (cdr l))))
     (else		(loop s (cdr l))))))

(define (uniq l)
  "Return a list containing elements of L, with duplicates removed."
  (let loop ((acc '())
	     (l l))
    (if (null? l)
	(reverse! acc)
	(loop (if (memq (car l) acc)
		  acc
		  (cons (car l) acc))
	      (cdr l)))))

;;; common-list.scm ends here