Update of /project/cl-utilities/cvsroot/cl-utilities In directory common-lisp.net:/tmp/cvs-serv1422 Modified Files: extremum.lisp Log Message: Added a couple of compiler macros which optimize the case where KEY is #'identity. Date: Fri May 13 21:45:10 2005 Author: pscott Index: cl-utilities/extremum.lisp diff -u cl-utilities/extremum.lisp:1.2 cl-utilities/extremum.lisp:1.3 --- cl-utilities/extremum.lisp:1.2 Thu May 12 23:17:23 2005 +++ cl-utilities/extremum.lisp Fri May 13 21:45:09 2005 @@ -7,12 +7,21 @@ (defun comparator (test &optional (key #'identity)) "Comparison operator: auxilliary function used by EXTREMUM" + (declare (optimize (speed 3) (safety 0) (space 0) (debug 1))) (lambda (a b) (if (funcall test (funcall key a) (funcall key b)) a b))) +;; This optimizes the case where KEY is #'identity +(define-compiler-macro comparator (&whole whole test + &optional (key #'identity)) + (if (eql key #'identity) + `(lambda (a b) + (if (funcall ,test a b) a b)) + whole)) + (defun zero-length-p (sequence) "Is the length of SEQUENCE equal to zero?" (declare (optimize (speed 3) (safety 0) (space 0) (debug 1))) @@ -39,6 +48,21 @@ nil)) (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 (zero-length-p ,sequence) + (restart-case (error 'no-extremum) + (continue () + :report "Return NIL instead" + nil)) + (locally (declare (optimize (speed 3) (safety 0) (space 0) (debug 1))) + (reduce (comparator ,predicate) ,sequence + :start ,start :end ,end)))) + whole)) ;; And, for backup, here's a strictly spec-compliant version. #+nil