Changeset 4568


Ignore:
Timestamp:
10/29/03 13:45:26 (18 years ago)
Author:
piso
Message:

SORT: support vectors as well as lists.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/j/src/org/armedbear/lisp/sort.lisp

    r3866 r4568  
    22;;;
    33;;; Copyright (C) 2003 Peter Graves
    4 ;;; $Id: sort.lisp,v 1.4 2003-09-18 18:07:00 piso Exp $
     4;;; $Id: sort.lisp,v 1.5 2003-10-29 13:45:26 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    2222(export '(sort merge))
    2323
    24 ;;; SORT (from CMUCL)
     24(defun sort (sequence predicate &key key)
     25  (if (listp sequence)
     26      (sort-list sequence predicate key)
     27      (quick-sort sequence 0 (length sequence) predicate key)))
    2528
    26 ;;; FIXME Only lists are supported for now.
    27 (defun sort (sequence predicate &key key)
    28   (when (listp sequence)
    29     (sort-list sequence predicate key)))
     29;;; From CMUCL.
    3030
    3131;;; Stable Sorting Lists
     
    121121            (return list-1))))))
    122122
     123;;; From ECL.
     124(defun quick-sort (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 outer-loop
     130          (loop (loop (decf k)
     131                  (unless (< j k) (return-from outer-loop))
     132                  (when (funcall pred (funcall key (elt seq k)) kd)
     133                    (return)))
     134            (loop (incf j)
     135              (unless (< j k) (return-from outer-loop))
     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        (quick-sort seq start j pred key)
     144        (quick-sort seq (1+ j) end pred key))))
    123145
    124 ;;; MERGE (from ECL)
    125 
     146;;; From ECL.
    126147(defun merge (result-type sequence1 sequence2 predicate
    127148                          &key key
Note: See TracChangeset for help on using the changeset viewer.