(defun quick-sort (sequence start end predicate key &aux (j 0) (k 0) exch)
  (declare (fixnum start end j k))
  (when (<= end (the fixnum (1+ start)))
        (return-from quick-sort sequence))
  (setq j start)
  (setq k (1- end))
  (do ((d (aref sequence start)))
      ((> j k))
    (do ()
	((or (> j k)
	     (funcall predicate
		      (funcall key (aref sequence k))
		      (funcall key d))))
      (decf k))
    (when (< k start)
	  (quick-sort sequence (1+ start) end predicate key)
	  (return-from quick-sort sequence))
    (do ()
	((or (> j k)
	     (not (funcall predicate
			   (funcall key (aref sequence j))
			   (funcall key d)))))
      (incf j))
    (when (> j k) (return))
    (setf exch (aref sequence k)
	  (aref sequence k) (aref sequence j)
	  (aref sequence j) exch)
    (incf j)
    (decf k))
  (quick-sort sequence start j predicate key)
  (quick-sort sequence j end predicate key)
  sequence)

(defun qsort (seq test &optional (key #'identity) &aux vec s)
  (cond ((null seq) nil)
	((listp seq)
	 (setq vec (coerce seq vector))
	 (quick-sort vec 0 (length seq) test key)
	 (setq s seq)
	 (dotimes (i (length vec))
	    (setf (car s) (aref vec i))
	    (setq s (cdr s)))
	 seq)
	((vectorp seq)
	 (quick-sort seq 0 (length seq) test key)
	 seq) ))



