# HG changeset patch # User Aidan Kehoe # Date 1262901039 0 # Node ID 6ee5e50a87724a062935363115a1e5e79f5a5cb4 # Parent 53071486ff7a90702b43f6315aec3ee61d218ee0 Add a compiler macro for #'map, where CL-TYPE is constant and understood. 2010-01-07 Aidan Kehoe * cl-macs.el (map): Add a compiler macro for this function, for cases where CL-TYPE is constant and understood. diff -r 53071486ff7a -r 6ee5e50a8772 lisp/ChangeLog --- a/lisp/ChangeLog Thu Jan 07 12:44:25 2010 -0700 +++ b/lisp/ChangeLog Thu Jan 07 21:50:39 2010 +0000 @@ -1,3 +1,9 @@ +2010-01-07 Aidan Kehoe + + * cl-macs.el (map): + Add a compiler macro for this function, for cases where CL-TYPE is + constant and understood. + 2010-01-07 Aidan Kehoe * unicode.el (load-unicode-tables): diff -r 53071486ff7a -r 6ee5e50a8772 lisp/cl-macs.el --- a/lisp/cl-macs.el Thu Jan 07 12:44:25 2010 -0700 +++ b/lisp/cl-macs.el Thu Jan 07 21:50:39 2010 +0000 @@ -3461,6 +3461,29 @@ ;; byte-optimize.el). (t form))))) +(define-compiler-macro map (&whole form cl-type cl-func cl-seq + &rest cl-rest) + "If CL-TYPE is a constant expression that we know how to handle, transform +the call to `map' to a more efficient expression." + (cond + ;; The first two here rely on the compiler macros for mapc and mapcar*, + ;; to convert to mapc-internal and mapcar, where appropriate (that is, in + ;; the absence of cl-rest.) + ((null cl-type) + `(prog1 nil (mapc ,@(nthcdr 2 form)))) + ((equal '(quote list) cl-type) + (cons 'mapcar* (nthcdr 2 form))) + ((or (equal '(quote vector) cl-type) + (equal '(quote array) cl-type)) + (if cl-rest + `(vconcat (mapcar* ,@(nthcdr 2 form))) + (cons 'mapvector (nthcdr 2 form)))) + ((equal '(quote string) cl-type) + `(concat (mapcar* ,@(nthcdr 2 form)))) + ((equal '(quote bit-vector) cl-type) + `(bvconcat (mapcar* ,@(nthcdr 2 form)))) + (t form))) + (mapc #'(lambda (y) (put (car y) 'side-effect-free t)