Changeset 13852
 Timestamp:
 02/04/12 19:08:03 (10 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

trunk/abcl/src/org/armedbear/lisp/sort.lisp
r13838 r13852 37 37 (sequence::seqdispatch sequence 38 38 (sortlist sequence predicate key) 39 (quick sort sequence 0 (length sequence) predicate key)39 (quicksort sequence 0 (1 (length sequence)) predicate (or key #'identity)) 40 40 (apply #'sequence:sort sequence predicate args))) 41 41 … … 183 183 (return list1)))))) 184 184 185 # 186 <> dc:author "Jorge Tavares" ; 187 dc:description 188 """ 189 The quicksort function picks the pivot by selecting a midpoint and 190 also sorts the smaller partition first. These are enough to avoid the 191 stack overflow problem as reported. I've performed some tests and it 192 looks it is correct 193 """" . 194 # 195 ;;; 196 ;;; QUICKSORT 197 ;;;  the pivot is a middle point 198 ;;;  sorts the smaller partition first 199 ;;; 200 (defun quicksort (vector start end predicate key) 201 (declare (type fixnum start end) 202 (type function predicate key)) 203 (if (< start end) 204 (let* ((i start) 205 (j (1+ end)) 206 (p (+ start (ash ( end start) 1))) 207 (d (aref vector p)) 208 (kd (funcall key d))) 209 (rotatef (aref vector p) (aref vector start)) 210 (block outerloop 211 (loop 212 (loop 213 (unless (> (decf j) i) (returnfrom outerloop)) 214 (when (funcall predicate 215 (funcall key (aref vector j)) kd) 216 (return))) 217 (loop 218 (unless (< (incf i) j) (returnfrom outerloop)) 219 (unless (funcall predicate 220 (funcall key (aref vector i)) kd) 221 (return))) 222 (rotatef (aref vector i) (aref vector j)))) 223 (setf (aref vector start) (aref vector j) 224 (aref vector j) d) 225 (if (< ( j start) ( end j)) 226 (progn 227 (quicksort vector start (1 j) predicate key) 228 (quicksort vector (1+ j) end predicate key)) 229 (progn 230 (quicksort vector (1+ j) end predicate key) 231 (quicksort vector start (1 j) predicate key)))) 232 vector)) 233 234 ;;; DEPRECATED  to be removed in abcl1.4 185 235 ;;; From ECL. 186 236 (defun quicksort (seq start end pred key)
Note: See TracChangeset
for help on using the changeset viewer.