May 2005 - cl-utilities-cvs@common-lisp.net

[cl-utilities-cvs] CVS update: cl-utilities/package.sh
by pscott＠common-lisp.net 17 May '05

17 May '05

Update of /project/cl-utilities/cvsroot/cl-utilities In directory common-lisp.net:/tmp/cvs-serv25204 Modified Files: package.sh Log Message: Fixed symlink bug Date: Tue May 17 21:30:09 2005 Author: pscott Index: cl-utilities/package.sh diff -u cl-utilities/package.sh:1.1.1.1 cl-utilities/package.sh:1.2 --- cl-utilities/package.sh:1.1.1.1 Mon May 9 23:26:29 2005 +++ cl-utilities/package.sh Tue May 17 21:30:09 2005 @@ -1,15 +1,17 @@ #!/bin/sh -mkdir cl-utilities-1.0 -cp cl-utilities.asd package.sh collecting.lisp expt-mod.lisp package.lisp split-sequence.lisp compose.lisp extremum.lisp read-delimited.lisp test.lisp copy-array.lisp once-only.lisp rotate-byte.lisp with-unique-names.lisp README cl-utilities-1.0/ +mkdir cl-utilities-1.0.2 +cp cl-utilities.asd package.sh collecting.lisp expt-mod.lisp package.lisp split-sequence.lisp compose.lisp extremum.lisp read-delimited.lisp test.lisp copy-array.lisp once-only.lisp rotate-byte.lisp with-unique-names.lisp README cl-utilities-1.0.2/ -tar -czvf cl-utilities-1.0.tar.gz cl-utilities-1.0/ -ln -s /root/lisp/cl-utilities/cl-utilities-1.0.tar.gz /root/lisp/cl-utilities/cl-utilities-latest.tar.gz -/usr/bin/xterm -e gpg -b -a /root/lisp/cl-utilities/cl-utilities-1.0.tar.gz -ln -s /root/lisp/cl-utilities/cl-utilities-1.0.tar.gz.asc /root/lisp/cl-utilities/cl-utilities-latest.tar.gz.asc -rm -Rf cl-utilities-1.0/ +rm -f cl-utilities-latest.tar.gz cl-utilities-latest.tar.gz.asc -scp cl-utilities-1.0.tar.gz pscott@common-lisp.net:/project/cl-utilities/public_html/cl-utilities-1.0.tar.gz -scp cl-utilities-1.0.tar.gz.asc pscott@common-lisp.net:/project/cl-utilities/public_html/cl-utilities-1.0.tar.gz.asc +tar -czvf cl-utilities-1.0.2.tar.gz cl-utilities-1.0.2/ +ln -s /root/lisp/cl-utilities/cl-utilities-1.0.2.tar.gz /root/lisp/cl-utilities/cl-utilities-latest.tar.gz +/usr/bin/xterm -e gpg -b -a /root/lisp/cl-utilities/cl-utilities-1.0.2.tar.gz +ln -s /root/lisp/cl-utilities/cl-utilities-1.0.2.tar.gz.asc /root/lisp/cl-utilities/cl-utilities-latest.tar.gz.asc +rm -Rf cl-utilities-1.0.2/ + +scp cl-utilities-1.0.2.tar.gz pscott@common-lisp.net:/project/cl-utilities/public_html/cl-utilities-1.0.2.tar.gz +scp cl-utilities-1.0.2.tar.gz.asc pscott@common-lisp.net:/project/cl-utilities/public_html/cl-utilities-1.0.2.tar.gz.asc scp cl-utilities-latest.tar.gz pscott@common-lisp.net:/project/cl-utilities/public_html/cl-utilities-latest.tar.gz scp cl-utilities-latest.tar.gz.asc pscott@common-lisp.net:/project/cl-utilities/public_html/cl-utilities-latest.tar.gz.asc

1 0

[cl-utilities-cvs] CVS update: cl-utilities/extremum.lisp
by pscott＠common-lisp.net 17 May '05

17 May '05

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

1 0

[cl-utilities-cvs] CVS update: cl-utilities/extremum.lisp
by pscott＠common-lisp.net 16 May '05

16 May '05

Update of /project/cl-utilities/cvsroot/cl-utilities In directory common-lisp.net:/tmp/cvs-serv13214 Modified Files: extremum.lisp Log Message: Probably fixed problem with START and END and error checking. Date: Tue May 17 00:06:47 2005 Author: pscott Index: cl-utilities/extremum.lisp diff -u cl-utilities/extremum.lisp:1.3 cl-utilities/extremum.lisp:1.4 --- cl-utilities/extremum.lisp:1.3 Fri May 13 21:45:09 2005 +++ cl-utilities/extremum.lisp Tue May 17 00:06:47 2005 @@ -41,7 +41,8 @@ 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 (zero-length-p sequence) + (if (or (zero-length-p sequence) + (>= start (or end (length sequence)))) (restart-case (error 'no-extremum) (continue () :report "Return NIL instead" @@ -54,7 +55,8 @@ &key (key #'identity) (start 0) end) (if (eql key #'identity) (once-only (sequence predicate start end) - `(if (zero-length-p ,sequence) + `(if (or (zero-length-p ,sequence) + (>= ,start (or ,end (length ,sequence)))) (restart-case (error 'no-extremum) (continue () :report "Return NIL instead" @@ -89,7 +91,8 @@ 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 (zero-length-p sequence) + (if (or (zero-length-p sequence) + (>= start (or end (length sequence)))) (restart-case (error 'no-extremum) (continue () :report "Return NIL instead"

1 0

[cl-utilities-cvs] CVS update: cl-utilities/with-unique-names.lisp
by pscott＠common-lisp.net 16 May '05

16 May '05

Update of /project/cl-utilities/cvsroot/cl-utilities In directory common-lisp.net:/tmp/cvs-serv1864 Modified Files: with-unique-names.lisp Log Message: Improved documentation and type checking. Cleaned up code a little. Date: Mon May 16 21:12:00 2005 Author: pscott Index: cl-utilities/with-unique-names.lisp diff -u cl-utilities/with-unique-names.lisp:1.2 cl-utilities/with-unique-names.lisp:1.3 --- cl-utilities/with-unique-names.lisp:1.2 Fri May 13 23:18:23 2005 +++ cl-utilities/with-unique-names.lisp Mon May 16 21:12:00 2005 @@ -10,7 +10,11 @@ (if (consp binding) binding (list binding binding)) - `(,var (gensym ,(format nil "~A" prefix))))) + (if (symbolp var) + `(,var (gensym ,(format nil "~A" prefix))) + (error 'type-error + :datum var + :expected-type 'symbol)))) bindings) ,@body)) @@ -28,7 +32,11 @@ (defmacro with-gensyms ((&rest bindings) &body body) "Synonym for WITH-UNIQUE-NAMES, but BINDINGS should only consist of -atoms; lists are not supported." +atoms; lists are not supported. If you try to give list bindings, a +LIST-BINDING-NOT-SUPPORTED warning will be signalled, but it will work +the same way as WITH-UNIQUE-NAMES. Don't do it, though." + ;; Signal a warning for each list binding, if there are any (dolist (binding (remove-if-not #'listp bindings)) (warn 'list-binding-not-supported :binding binding)) + ;; Otherwise, this is a synonym for WITH-UNIQUE-NAMES `(with-unique-names ,bindings ,@body))

1 0

[cl-utilities-cvs] CVS update: cl-utilities/with-unique-names.lisp
by pscott＠common-lisp.net 13 May '05

13 May '05

Update of /project/cl-utilities/cvsroot/cl-utilities In directory common-lisp.net:/tmp/cvs-serv7403 Modified Files: with-unique-names.lisp Log Message: Replaced (string prefix) with (format nil "~A" prefix), which is more general. I can't see why anybody would want to take advantage of this, but I can't see any reason *not* to let them either. Date: Fri May 13 23:18:23 2005 Author: pscott Index: cl-utilities/with-unique-names.lisp diff -u cl-utilities/with-unique-names.lisp:1.1.1.1 cl-utilities/with-unique-names.lisp:1.2 --- cl-utilities/with-unique-names.lisp:1.1.1.1 Mon May 9 23:26:29 2005 +++ cl-utilities/with-unique-names.lisp Fri May 13 23:18:23 2005 @@ -10,7 +10,7 @@ (if (consp binding) binding (list binding binding)) - `(,var (gensym ,(string prefix))))) + `(,var (gensym ,(format nil "~A" prefix))))) bindings) ,@body))

1 0

[cl-utilities-cvs] CVS update: cl-utilities/test.lisp
by pscott＠common-lisp.net 13 May '05

13 May '05

Update of /project/cl-utilities/cvsroot/cl-utilities In directory common-lisp.net:/tmp/cvs-serv2061 Modified Files: test.lisp Log Message: Added more tests for EXREMUM. Date: Fri May 13 21:45:58 2005 Author: pscott Index: cl-utilities/test.lisp diff -u cl-utilities/test.lisp:1.4 cl-utilities/test.lisp:1.5 --- cl-utilities/test.lisp:1.4 Tue May 10 21:46:38 2005 +++ cl-utilities/test.lisp Fri May 13 21:45:57 2005 @@ -41,7 +41,11 @@ (signals no-extremum (extremum '() #'<)) (is-false (handler-bind ((no-extremum #'continue)) (extremum '() #'<))) - (is (= (extremum '(2/3 2 3 4) #'> :key (lambda (x) (/ 1 x))) 2/3))) + (is (= (extremum '(2/3 2 3 4) #'> :key (lambda (x) (/ 1 x))) 2/3)) + (is (= (locally (declare (optimize (speed 3) (safety 0))) + (extremum #(1 23 3 4 5 0) #'>)) + 23)) + (is (= (extremum-fastkey '(2/3 2 3 4) #'> :key (lambda (x) (/ 1 x))) 2/3))) (defun delimited-test (&key (delimiter #\|) (start 0) end (string "foogo|ogreogrjejgierjijri|bar|baz"))

1 0

[cl-utilities-cvs] CVS update: cl-utilities/extremum.lisp
by pscott＠common-lisp.net 13 May '05

13 May '05

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

1 0

[cl-utilities-cvs] CVS update: cl-utilities/compose.lisp
by pscott＠common-lisp.net 13 May '05

13 May '05

Update of /project/cl-utilities/cvsroot/cl-utilities In directory common-lisp.net:/tmp/cvs-serv32649 Modified Files: compose.lisp Log Message: Fixed some problems with the benchmarking code and some comments. Date: Fri May 13 21:17:39 2005 Author: pscott Index: cl-utilities/compose.lisp diff -u cl-utilities/compose.lisp:1.2 cl-utilities/compose.lisp:1.3 --- cl-utilities/compose.lisp:1.2 Tue May 10 21:45:34 2005 +++ cl-utilities/compose.lisp Fri May 13 21:17:38 2005 @@ -23,16 +23,16 @@ ,@body)))) ;; Make sure the compiler macro gets run (declare (optimize (speed 3) (safety 0) (space 0) (debug 1))) - (time (repeat (3000000) (funcall (compose #'1+ #'2* '1+) 6))) - (time (repeat (3000000) (funcall (lambda (x) (1+ (2* (1+ x)))) 6))) - (time (repeat (3000000) + (time (repeat (30000000) (funcall (compose #'1+ #'2* #'1+) 6))) + (time (repeat (30000000) (funcall (lambda (x) (1+ (2* (1+ x)))) 6))) + (time (repeat (30000000) (funcall (lambda (x) - (funcall #'1+ (funcall #'2* (funcall '1+ x)))) + (funcall #'1+ (funcall #'2* (funcall #'1+ x)))) 6))))) ;; Converts calls to COMPOSE to lambda forms with everything written ;; out and some things written as direct function calls. -;; Example: (compose '1+ #'2* '1+) => (LAMBDA (X) (1+ (2* (1+ X)))) +;; Example: (compose #'1+ #'2* #'1+) => (LAMBDA (X) (1+ (2* (1+ X)))) (define-compiler-macro compose (&rest functions) (labels ((sharp-quoted-p (x) (and (listp x) @@ -40,7 +40,7 @@ (symbolp (second x))))) `(lambda (x) ,(reduce #'(lambda (fun arg) (if (sharp-quoted-p fun) - (list (second fun) arg) + (list (second fun) arg) (list 'funcall fun arg))) functions :initial-value 'x

1 0

[cl-utilities-cvs] CVS update: cl-utilities/package.lisp
by pscott＠common-lisp.net 12 May '05

12 May '05

Update of /project/cl-utilities/cvsroot/cl-utilities In directory common-lisp.net:/tmp/cvs-serv18728 Modified Files: package.lisp Log Message: Added EXTREMUM-FASTKEY symbol to exports list. Date: Thu May 12 23:17:50 2005 Author: pscott Index: cl-utilities/package.lisp diff -u cl-utilities/package.lisp:1.1.1.1 cl-utilities/package.lisp:1.2 --- cl-utilities/package.lisp:1.1.1.1 Mon May 9 23:26:29 2005 +++ cl-utilities/package.lisp Thu May 12 23:17:50 2005 @@ -9,6 +9,7 @@ #:extremum #:no-extremum + #:extremum-fastkey #:read-delimited #:read-delimited-bounds-error

1 0

[cl-utilities-cvs] CVS update: cl-utilities/extremum.lisp
by pscott＠common-lisp.net 12 May '05

12 May '05

Update of /project/cl-utilities/cvsroot/cl-utilities In directory common-lisp.net:/tmp/cvs-serv18708 Modified Files: extremum.lisp Log Message: Improved efficiency some. Added EXTREMUM-FASTKEY which uses a different, and sometimes faster, algorithm. Date: Thu May 12 23:17:23 2005 Author: pscott Index: cl-utilities/extremum.lisp diff -u cl-utilities/extremum.lisp:1.1.1.1 cl-utilities/extremum.lisp:1.2 --- cl-utilities/extremum.lisp:1.1.1.1 Mon May 9 23:26:29 2005 +++ cl-utilities/extremum.lisp Thu May 12 23:17:23 2005 @@ -13,6 +13,15 @@ a b))) +(defun zero-length-p (sequence) + "Is the length of SEQUENCE equal to zero?" + (declare (optimize (speed 3) (safety 0) (space 0) (debug 1))) + (or (null sequence) + (when (vectorp sequence) + (zerop (length sequence))))) + +(declaim (inline zero-length-p)) + ;; 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. @@ -23,7 +32,7 @@ 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 (= 0 (length sequence)) + (if (zero-length-p sequence) (restart-case (error 'no-extremum) (continue () :report "Return NIL instead" @@ -37,9 +46,44 @@ "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 (= 0 (length sequence)) + (if (zero-length-p sequence) + (restart-case (error 'no-extremum) + (continue () + :report "Return NIL instead" + 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 +;; is expensive. And on CLISP, of course, the regular version will be +;; much faster since built-in functions are ridiculously faster than +;; ones implemented in Lisp. Be warned, this isn't as carefully tested +;; as regular EXTREMUM and there's more that could go wrong. +(defun extremum-fastkey (sequence predicate + &key (key #'identity) (start 0) end) + "EXTREMUM implemented so that it calls KEY less. This is only faster +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 (zero-length-p sequence) (restart-case (error 'no-extremum) (continue () :report "Return NIL instead" nil)) - (reduce (comparator predicate key) sequence))) \ No newline at end of file + (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

1 0