--- a/lisp/ChangeLog	Thu Jan 07 14:50:24 2010 -0700
+++ b/lisp/ChangeLog	Thu Jan 07 21:50:59 2010 +0000
@@ -1,3 +1,9 @@
+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.
+
 2010-01-07  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* unicode.el (load-unicode-tables):

--- a/lisp/cl-macs.el	Thu Jan 07 14:50:24 2010 -0700
+++ b/lisp/cl-macs.el	Thu Jan 07 21:50:59 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)