[cl-utilities-cvs] CVS update: cl-utilities/extremum.lisp

[Peter Scott]

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))
+      , at 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