- cl-utilities-cvs@common-lisp.net - mailman3.common-lisp.net

[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

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

10 May '05

Update of /project/cl-utilities/cvsroot/cl-utilities In directory common-lisp.net:/tmp/cvs-serv5591 Modified Files: test.lisp Log Message: Added EVAL-WHEN to make things work better, de-stupidified the COMPOSE unit tests and added a new one. Date: Tue May 10 21:46:40 2005 Author: pscott Index: cl-utilities/test.lisp diff -u cl-utilities/test.lisp:1.3 cl-utilities/test.lisp:1.4 --- cl-utilities/test.lisp:1.3 Mon May 9 23:53:33 2005 +++ cl-utilities/test.lisp Tue May 10 21:46:38 2005 @@ -1,6 +1,7 @@ ;; This file requires the FiveAM unit testing framework. -(asdf:oos 'asdf:load-op :fiveam) -(asdf:oos 'asdf:load-op :cl-utilities) +(eval-when (:compile-toplevel :load-toplevel :execute) + (asdf:oos 'asdf:load-op :fiveam) + (asdf:oos 'asdf:load-op :cl-utilities)) ;; To run all the tests: ;; (5am:run! 'cl-utilities-tests::cl-utilities-suite) @@ -120,5 +121,11 @@ (test compose (labels ((2* (x) (* 2 x))) (is (= (funcall (compose #'1+ #'1+) 1) 3)) - (is (= (funcall (compose '1+ '2*) 5) 11)) - (is (= (funcall (compose #'1+ '2* '1+) 6) 15)))) \ No newline at end of file + (is (= (funcall (compose '1+ #'2*) 5) 11)) + (is (= (funcall (compose #'1+ #'2* '1+) 6) 15)) + ;; This should signal an undefined function error, since we're + ;; using '2* rather than #'2*, which means that COMPOSE will use + ;; the dynamic binding at the time it is called rather than the + ;; lexical binding here. + (signals undefined-function + (= (funcall (compose #'1+ '2* '1+) 6) 15)))) \ No newline at end of file

1 0

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

10 May '05

Update of /project/cl-utilities/cvsroot/cl-utilities In directory common-lisp.net:/tmp/cvs-serv5183 Modified Files: compose.lisp Log Message: Fixed subtle bug in COMPOSE compiler macro. It was optimizing too much, causing lexical definitions to be used when, strictly speaking, funcall-time dynamic values should have been used. Date: Tue May 10 21:45:38 2005 Author: pscott Index: cl-utilities/compose.lisp diff -u cl-utilities/compose.lisp:1.1.1.1 cl-utilities/compose.lisp:1.2 --- cl-utilities/compose.lisp:1.1.1.1 Mon May 9 23:26:29 2005 +++ cl-utilities/compose.lisp Tue May 10 21:45:34 2005 @@ -34,19 +34,12 @@ ;; out and some things written as direct function calls. ;; Example: (compose '1+ #'2* '1+) => (LAMBDA (X) (1+ (2* (1+ X)))) (define-compiler-macro compose (&rest functions) - (labels ((quoted-symbolp (x) - (and (listp x) - (eql (first x) 'quote) - (symbolp (second x)))) - (sharp-quotedp (x) + (labels ((sharp-quoted-p (x) (and (listp x) (eql (first x) 'function) - (symbolp (second x)))) - (directly-callable-p (x) - (or (quoted-symbolp x) - (sharp-quotedp x)))) + (symbolp (second x))))) `(lambda (x) ,(reduce #'(lambda (fun arg) - (if (directly-callable-p fun) + (if (sharp-quoted-p fun) (list (second fun) arg) (list 'funcall fun arg))) functions

1 0

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

09 May '05

Update of /project/cl-utilities/cvsroot/cl-utilities In directory common-lisp.net:/tmp/cvs-serv22260 Modified Files: test.lisp Log Message: Added two more tests for EXPT-MOD. Date: Mon May 9 23:53:33 2005 Author: pscott Index: cl-utilities/test.lisp diff -u cl-utilities/test.lisp:1.2 cl-utilities/test.lisp:1.3 --- cl-utilities/test.lisp:1.2 Mon May 9 23:45:00 2005 +++ cl-utilities/test.lisp Mon May 9 23:53:33 2005 @@ -72,7 +72,9 @@ ;; Random testing would probably work better here. (test expt-mod (is (= (expt-mod 2 34 54) (mod (expt 2 34) 54))) - (is (= (expt-mod 20 3 54) (mod (expt 20 3) 54)))) + (is (= (expt-mod 20 3 54) (mod (expt 20 3) 54))) + (is (= (expt-mod 2.5 3.8 34.9) (mod (expt 2.5 3.8) 34.9))) + (is (= (expt-mod 2/5 3/8 34/9) (mod (expt 2/5 3/8) 34/9)))) (test collecting (is (tree-equal (collecting (dotimes (x 10) (collect x)))

1 0

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

09 May '05

Update of /project/cl-utilities/cvsroot/cl-utilities In directory common-lisp.net:/tmp/cvs-serv22187 Modified Files: expt-mod.lisp Log Message: Added support for non-integer arguments on Lisps other than SBCL. Date: Mon May 9 23:51:31 2005 Author: pscott Index: cl-utilities/expt-mod.lisp diff -u cl-utilities/expt-mod.lisp:1.1.1.1 cl-utilities/expt-mod.lisp:1.2 --- cl-utilities/expt-mod.lisp:1.1.1.1 Mon May 9 23:26:29 2005 +++ cl-utilities/expt-mod.lisp Mon May 9 23:51:31 2005 @@ -9,12 +9,14 @@ ;; compiler to optimize it. This may be the case on other Lisp ;; implementations as well. #+sbcl (mod (expt n exponent) modulus) - #-sbcl (loop with result = 1 - for i of-type fixnum from 0 below (integer-length exponent) - for sqr = n then (mod (* sqr sqr) modulus) - when (logbitp i exponent) do - (setf result (mod (* result sqr) modulus)) - finally (return result))) + #-sbcl (if (some (complement #'integerp) (list n exponent modulus)) + (mod (expt n exponent) modulus) + (loop with result = 1 + for i of-type fixnum from 0 below (integer-length exponent) + for sqr = n then (mod (* sqr sqr) modulus) + when (logbitp i exponent) do + (setf result (mod (* result sqr) modulus)) + finally (return result)))) ;; If SBCL is going to expand compiler macros, we should directly ;; inline the simple expansion; this lets SBCL do all sorts of fancy

1 0

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

09 May '05

Update of /project/cl-utilities/cvsroot/cl-utilities In directory common-lisp.net:/tmp/cvs-serv21142 Modified Files: test.lisp Log Message: Removed bad test Date: Mon May 9 23:45:00 2005 Author: pscott Index: cl-utilities/test.lisp diff -u cl-utilities/test.lisp:1.1.1.1 cl-utilities/test.lisp:1.2 --- cl-utilities/test.lisp:1.1.1.1 Mon May 9 23:26:29 2005 +++ cl-utilities/test.lisp Mon May 9 23:45:00 2005 @@ -72,8 +72,7 @@ ;; Random testing would probably work better here. (test expt-mod (is (= (expt-mod 2 34 54) (mod (expt 2 34) 54))) - (is (= (expt-mod 20 3 54) (mod (expt 20 3) 54))) - (is (= (expt-mod 2.3 -4 5.4) (mod (expt 2.3 -4) 5.4)))) + (is (= (expt-mod 20 3 54) (mod (expt 20 3) 54)))) (test collecting (is (tree-equal (collecting (dotimes (x 10) (collect x)))

1 0

[cl-utilities-cvs] CVS update: cl-utilities/project/index.html
by pscott＠common-lisp.net 09 May '05

09 May '05

Update of /project/cl-utilities/cvsroot/cl-utilities/project In directory common-lisp.net:/tmp/cvs-serv20881 Modified Files: index.html Log Message: Added CVS tarball link and fixed HTML problems. Date: Mon May 9 23:37:11 2005 Author: pscott Index: cl-utilities/project/index.html diff -u cl-utilities/project/index.html:1.1.1.1 cl-utilities/project/index.html:1.2 --- cl-utilities/project/index.html:1.1.1.1 Mon May 9 23:26:29 2005 +++ cl-utilities/project/index.html Mon May 9 23:37:11 2005 @@ -58,6 +58,11 @@ and the signature is <a href="http://www.common-lisp.net/project/cl-utilities/cl-utilities-latest.tar.gz.…">cl-utilities-latest.tar.gz.asc</a></p> + <p>You can also download the <a + href="http://common-lisp.net/cgi-bin/viewcvs.cgi/cl-utilities/cl-utilities.tar.gz…">nightly + CVS tarball</a>, but I don't expect you to see much difference + between that and the latest release.</p> + <h3>CVS</h3> <p>You can <a @@ -72,6 +77,6 @@ <div class="check"> <a href="http://validator.w3.org/check/referer"> Valid XHTML 1.0 Strict</a> - </div + </div> </body> </html>

1 0