mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-16 14:21:48 -08:00
Code Issues Projects Releases Packages Wiki Activity

Fixes to quick-sort so that it does not stall in the worst case scenario (list already sorted).

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2012-02-04 23:57:54 +01:00
parent 72f7b1ea7d
commit 56e1ff2ac7
1 changed files with 36 additions and 21 deletions
Download patch file Download diff file Expand all files Collapse all files

57
src/lsp/seqlib.lsp
View file

@ -769,7 +769,7 @@ evaluates to NIL. See STABLE-SORT."
predicate (si::coerce-to-function predicate))
(if (listp sequence)
(list-merge-sort sequence predicate key)
(quick-sort sequence 0 (truly-the fixnum (length sequence)) predicate key)))
(quick-sort sequence 0 (truly-the fixnum (1- (length sequence))) predicate key)))
(defun list-merge-sort (l predicate key)
@ -831,26 +831,41 @@ evaluates to NIL. See STABLE-SORT."
(function pred key)
(optimize (safety 0))
(si::c-local))
(if (<= end (truly-the fixnum (1+ start)))
seq
(let* ((j start) (k end) (d (elt seq start)) (kd (funcall key d)))
(declare (fixnum j k))
(block outer-loop
(loop (loop (decf k)
(unless (< j k) (return-from outer-loop))
(when (funcall pred (funcall key (elt seq k)) kd)
(return)))
(loop (incf j)
(unless (< j k) (return-from outer-loop))
(unless (funcall pred (funcall key (elt seq j)) kd)
(return)))
(let ((temp (elt seq j)))
(setf (elt seq j) (elt seq k)
(elt seq k) temp))))
(setf (elt seq start) (elt seq j)
(elt seq j) d)
(quick-sort seq start j pred key)
(quick-sort seq (1+ j) end pred key))))
(if (< start end)
(let* ((j (1+ end)))
(declare (fixnum j))
(let* ((i start)
(l (- end start))
(l-half (ash l -1))
(p (+ start l-half))
(d (elt seq p))
(kd (funcall key d)))
(declare (fixnum i p l l-half))
(rotatef (elt seq p) (elt seq start))
(block outer-loop
(loop
(loop
(unless (> (decf j) i) (return-from outer-loop))
(when (funcall pred
(funcall key (elt seq j)) kd)
(return)))
(loop
(unless (< (incf i) j) (return-from outer-loop))
(unless (funcall pred
(funcall key (elt seq i)) kd)
(return)))
(rotatef (elt seq i) (elt seq j))))
(setf (elt seq start) (elt seq j)
(elt seq j) d))
(if (< (truly-the fixnum (- j start))
(truly-the fixnum (- end j)))
(progn
(quick-sort seq start (1- j) pred key)
(quick-sort seq (1+ j) end pred key))
(progn
(quick-sort seq (1+ j) end pred key)
(quick-sort seq start (1- j) pred key))))
seq))
(defun stable-sort (sequence predicate &key key)