Update of /project/cl-utilities/cvsroot/cl-utilities In directory common-lisp.net:/tmp/cvs-serv24989

Modified Files: extremum.lisp Log Message: Fixed various problems and factored out some very ugly repeated checking code into a macro. The code is now much cleaner and less error-prone.

Date: Tue May 17 21:17:34 2005 Author: pscott

Index: cl-utilities/extremum.lisp diff -u cl-utilities/extremum.lisp:1.4 cl-utilities/extremum.lisp:1.5 --- cl-utilities/extremum.lisp:1.4 Tue May 17 00:06:47 2005 +++ cl-utilities/extremum.lisp Tue May 17 21:17:34 2005 @@ -31,6 +31,19 @@

(declaim (inline zero-length-p))

+;; Checks the length of the subsequence of SEQUENCE specified by START +;; and END, and if it's 0 then a NO-EXTREMUM error is signalled. This +;; should only be used in EXTREMUM functions. +(defmacro with-check-length ((sequence start end) &body body) + (once-only (sequence start end) + `(if (or (zero-length-p ,sequence) + (>= ,start (or ,end (length ,sequence)))) + (restart-case (error 'no-extremum) + (continue () + :report "Return NIL instead" + nil)) + ,@body))) + ;; This is an extended version which takes START and END keyword ;; arguments. Any spec-compliant use of EXTREMUM will also work with ;; this extended version. @@ -41,26 +54,16 @@ http://www.cliki.net/EXTREMUM for the full specification. Additionally, START and END specify the beginning and ending indices of the part of the sequence we should look at." - (if (or (zero-length-p sequence) - (>= start (or end (length sequence)))) - (restart-case (error 'no-extremum) - (continue () - :report "Return NIL instead" - nil)) - (reduce (comparator predicate key) sequence - :start start :end end))) + (with-check-length (sequence start end) + (reduce (comparator predicate key) sequence + :start start :end end)))

;; This optimizes the case where KEY is #'identity (define-compiler-macro extremum (&whole whole sequence predicate &key (key #'identity) (start 0) end) (if (eql key #'identity) (once-only (sequence predicate start end) - `(if (or (zero-length-p ,sequence) - (>= ,start (or ,end (length ,sequence)))) - (restart-case (error 'no-extremum) - (continue () - :report "Return NIL instead" - nil)) + `(with-check-length (,sequence ,start ,end) (locally (declare (optimize (speed 3) (safety 0) (space 0) (debug 1))) (reduce (comparator ,predicate) ,sequence :start ,start :end ,end)))) @@ -72,12 +75,8 @@ "Returns the element of SEQUENCE that would appear first if the sequence were ordered according to SORT using PREDICATE and KEY. See http://www.cliki.net/EXTREMUM for the full specification." - (if (zero-length-p sequence) - (restart-case (error 'no-extremum) - (continue () - :report "Return NIL instead" - nil)) - (reduce (comparator predicate key) sequence))) + (with-check-length (sequence 0 nil) + (reduce (comparator predicate key) sequence)))

;; This is an "optimized" version which calls KEY less. REDUCE is ;; already so optimized that this will actually be slower unless KEY @@ -91,26 +90,21 @@ if the KEY function is so slow that calling it less often would be a significant improvement; ordinarily it's slower." (declare (optimize (speed 3) (safety 0) (space 0) (debug 1))) - (if (or (zero-length-p sequence) - (>= start (or end (length sequence)))) - (restart-case (error 'no-extremum) - (continue () - :report "Return NIL instead" - nil)) - (let* ((smallest (elt sequence 0)) - (smallest-key (funcall key smallest)) - (current-index 0) - (real-end (or end #.(1- most-positive-fixnum)))) - (declare (type (integer 0 #.most-positive-fixnum) - current-index real-end start)) - (map nil #'(lambda (x) - (when (<= start current-index real-end) - (let ((x-key (funcall key x))) - (when (funcall predicate - x-key - smallest-key) - (setf smallest x) - (setf smallest-key x-key)))) - (incf current-index)) - sequence) - smallest))) \ No newline at end of file + (with-check-length (sequence start end) + (let* ((smallest (elt sequence 0)) + (smallest-key (funcall key smallest)) + (current-index 0) + (real-end (or end #.(1- most-positive-fixnum)))) + (declare (type (integer 0 #.most-positive-fixnum) + current-index real-end start)) + (map nil #'(lambda (x) + (when (<= start current-index real-end) + (let ((x-key (funcall key x))) + (when (funcall predicate + x-key + smallest-key) + (setf smallest x) + (setf smallest-key x-key)))) + (incf current-index)) + sequence) + smallest))) \ No newline at end of file