# HG changeset patch
# User Aidan Kehoe <kehoea@parhasard.net>
# Date 1262901059 0
# Node ID 3c96cf473e07d8fb8eb39c237a1ebd47430f6325
# Parent  0d3ccd5a2509c703480cf12cff6dc752111fce10# Parent  6ee5e50a87724a062935363115a1e5e79f5a5cb4
Automated merge with file:///home/aidan/xemacs-21.5-checked-out

diff -r 0d3ccd5a2509 -r 3c96cf473e07 lisp/ChangeLog
--- 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):
diff -r 0d3ccd5a2509 -r 3c96cf473e07 lisp/cl-macs.el
--- 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)