Mercurial > hg > xemacs-beta
diff lisp/cl-macs.el @ 4810:6ee5e50a8772
Add a compiler macro for #'map, where CL-TYPE is constant and understood.
2010-01-07 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (map):
Add a compiler macro for this function, for cases where CL-TYPE is
constant and understood.
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Thu, 07 Jan 2010 21:50:39 +0000 |
parents | 8484c6c76837 |
children | e6dec75ded0e |
line wrap: on
line diff
--- 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)