Changeset 4568
 Timestamp:
 10/29/03 13:45:26 (18 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

trunk/j/src/org/armedbear/lisp/sort.lisp
r3866 r4568 2 2 ;;; 3 3 ;;; Copyright (C) 2003 Peter Graves 4 ;;; $Id: sort.lisp,v 1. 4 20030918 18:07:00piso Exp $4 ;;; $Id: sort.lisp,v 1.5 20031029 13:45:26 piso Exp $ 5 5 ;;; 6 6 ;;; This program is free software; you can redistribute it and/or … … 22 22 (export '(sort merge)) 23 23 24 ;;; SORT (from CMUCL) 24 (defun sort (sequence predicate &key key) 25 (if (listp sequence) 26 (sortlist sequence predicate key) 27 (quicksort sequence 0 (length sequence) predicate key))) 25 28 26 ;;; FIXME Only lists are supported for now. 27 (defun sort (sequence predicate &key key) 28 (when (listp sequence) 29 (sortlist sequence predicate key))) 29 ;;; From CMUCL. 30 30 31 31 ;;; Stable Sorting Lists … … 121 121 (return list1)))))) 122 122 123 ;;; From ECL. 124 (defun quicksort (seq start end pred key) 125 (unless key (setq key #'identity)) 126 (if (<= end (1+ start)) 127 seq 128 (let* ((j start) (k end) (d (elt seq start)) (kd (funcall key d))) 129 (block outerloop 130 (loop (loop (decf k) 131 (unless (< j k) (returnfrom outerloop)) 132 (when (funcall pred (funcall key (elt seq k)) kd) 133 (return))) 134 (loop (incf j) 135 (unless (< j k) (returnfrom outerloop)) 136 (unless (funcall pred (funcall key (elt seq j)) kd) 137 (return))) 138 (let ((temp (elt seq j))) 139 (setf (elt seq j) (elt seq k) 140 (elt seq k) temp)))) 141 (setf (elt seq start) (elt seq j) 142 (elt seq j) d) 143 (quicksort seq start j pred key) 144 (quicksort seq (1+ j) end pred key)))) 123 145 124 ;;; MERGE (from ECL) 125 146 ;;; From ECL. 126 147 (defun merge (resulttype sequence1 sequence2 predicate 127 148 &key key
Note: See TracChangeset
for help on using the changeset viewer.