--- a/lisp/ChangeLog	Sun Oct 11 17:26:40 2009 +0200
+++ b/lisp/ChangeLog	Mon Oct 19 12:47:21 2009 +0100
@@ -1,3 +1,23 @@
+2009-10-19  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* bytecomp.el (byte-compile-default-warnings): 
+	Add two new warning types, discarded-consing (basically use of
+	mapcar instead of mapc where its result is discarded) and
+	quoted-lambda (use of a lambda expression quoted as data in a
+	function context).
+	(byte-compile-warnings): Document the new warnings. 
+	(byte-compile-fset, byte-compile-funarg): Implement the
+	quoted-lambda warning option. 
+	(byte-compile-mapcar): Renamed to byte-compile-maybe-mapc.
+	(byte-compile-maybe-mapc, byte-compile-maplist): 
+	Implement the discarded-consing warning option. 
+	Add more functions that should be compiled using
+	byte-compile-funarg, notably mapvector, mapc-internal,
+	map-char-table. 
+	* cl-macs.el (mapcar*): 
+	If we know at compile time that there are no CL options being
+	used, use the mapcar subr, not the byte-coded function. 
+
 2009-10-12  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* cl-macs.el (mapc):

--- a/lisp/bytecomp.el	Sun Oct 11 17:26:40 2009 +0200
+++ b/lisp/bytecomp.el	Mon Oct 19 12:47:21 2009 +0100
@@ -117,6 +117,12 @@
 ;;;				'obsolete  (obsolete variables and functions)
 ;;;				'pedantic  (references to Emacs-compatible
 ;;;					    symbols)
+;;;                             'discarded-consing (use of mapcar instead of
+;;;                                                 mapc, and similar)
+;;;                             'quoted-lambda (quoting a lambda expression
+;;;                                             as data, not as a function,
+;;;                                             and using it in a function
+;;;                                             context )
 ;;; byte-compile-emacs19-compatibility	Whether the compiler should
 ;;;				generate .elc files which can be loaded into
 ;;;				generic emacs 19.
@@ -361,7 +367,8 @@
 
 ;; byte-compile-warning-types in FSF.
 (defvar byte-compile-default-warnings
-  '(redefine callargs subr-callargs free-vars unresolved unused-vars obsolete)
+  '(redefine callargs subr-callargs free-vars unresolved unused-vars obsolete
+    discarded-consing quoted-lambda)
   "*The warnings used when byte-compile-warnings is t.")
 
 (defvar byte-compile-warnings t
@@ -377,6 +384,12 @@
 		versa, or redefined to take a different number of arguments.
   obsolete	use of an obsolete function or variable.
   pedantic	warn of use of compatible symbols.
+  discarded-consing 
+                calls to (some) functions that allocate memory, where that
+                memory is immediately discarded; canonically, the use of 
+                mapcar instead of mapc
+  quoted-lambda passing a lambda expression not quoted as a function, as a
+                function argument
 
 The default set is specified by `byte-compile-default-warnings' and
 normally encompasses all possible warnings.
@@ -1073,7 +1086,8 @@
     (verbose byte-compile-verbose (t nil) val)
     (new-bytecodes byte-compile-new-bytecodes (t nil) val)
     (warnings byte-compile-warnings
-	      ((callargs subr-callargs redefine free-vars unused-vars unresolved))
+	      ((callargs subr-callargs redefine free-vars unused-vars
+			 unresolved discarded-consing quoted-lambda))
 	      val)))
 
 ;; XEmacs addition
@@ -3502,7 +3516,8 @@
       (if (stringp (car body)) (setq body (cdr body)))
       (if (eq 'interactive (car-safe (car body))) (setq body (cdr body)))
       (if (and (consp (car body))
-	       (not (eq 'byte-code (car (car body)))))
+	       (not (eq 'byte-code (car (car body))))
+	       (memq 'quoted-lambda byte-compile-warnings))
 	  (byte-compile-warn
     "A quoted lambda form is the second argument of fset.  This is probably
      not what you want, as that lambda cannot be compiled.  Consider using
@@ -3515,7 +3530,12 @@
   (byte-compile-normal-call
    (let ((fn (nth 1 form)))
      (if (and (eq (car-safe fn) 'quote)
-	      (eq (car-safe (nth 1 fn)) 'lambda))
+	      (eq (car-safe (nth 1 fn)) 'lambda)
+	      (or 
+	       (null (memq 'quoted-lambda byte-compile-warnings))
+	       (byte-compile-warn
+		"Passing a quoted lambda to #'%s, forcing function quoting"
+		(car form))))
 	 (cons (car form)
 	       (cons (cons 'function (cdr fn))
 		     (cdr (cdr form))))
@@ -3523,16 +3543,21 @@
 
 ;; XEmacs change; don't cons up the list if it's going to be immediately
 ;; discarded.
-(defun byte-compile-mapcar (form)
-  (and for-effect (setq form (cons 'mapc-internal (cdr form)))
-       (byte-compile-warn
-	"Discarding the result of #'mapcar; maybe you meant #'mapc?"))
+(defun byte-compile-maybe-mapc (form)
+  (and for-effect
+       (or (null (memq 'discarded-consing byte-compile-warnings))
+	   (byte-compile-warn
+	    "Discarding the result of #'%s; maybe you meant #'mapc?"
+	    (car form)))
+       (setq form (cons 'mapc-internal (cdr form))))
   (byte-compile-funarg form))
 
 (defun byte-compile-maplist (form)
-  (and for-effect (setq form (cons 'mapl (cdr form)))
-       (byte-compile-warn
-	"Discarding the result of #'maplist; maybe you meant #'mapl?"))
+  (and for-effect
+       (or (null (memq 'discarded-consing byte-compile-warnings))
+	   (byte-compile-warn
+	    "Discarding the result of #'maplist; maybe you meant #'mapl?"))
+       (setq form (cons 'mapl (cdr form))))
   (byte-compile-funarg form))
 
 ;; (function foo) must compile like 'foo, not like (symbol-function 'foo).
@@ -3712,7 +3737,10 @@
 (byte-defop-compiler-1 while)
 (byte-defop-compiler-1 funcall)
 (byte-defop-compiler-1 apply byte-compile-funarg)
-(byte-defop-compiler-1 mapcar byte-compile-mapcar)
+(byte-defop-compiler-1 mapcar byte-compile-maybe-mapc)
+(byte-defop-compiler-1 mapvector byte-compile-maybe-mapc)
+(byte-defop-compiler-1 mapc byte-compile-funarg)
+(byte-defop-compiler-1 mapc-internal byte-compile-funarg)
 (byte-defop-compiler-1 mapatoms byte-compile-funarg)
 (byte-defop-compiler-1 mapconcat byte-compile-funarg)
 (byte-defop-compiler-1 map byte-compile-funarg)
@@ -3720,6 +3748,16 @@
 (byte-defop-compiler-1 mapl byte-compile-funarg)
 (byte-defop-compiler-1 mapcan byte-compile-funarg)
 (byte-defop-compiler-1 mapcon byte-compile-funarg)
+(byte-defop-compiler-1 map-char-table byte-compile-funarg)
+(byte-defop-compiler-1 map-database byte-compile-funarg)
+(byte-defop-compiler-1 map-extent-children byte-compile-funarg)
+(byte-defop-compiler-1 map-extents byte-compile-funarg)
+(byte-defop-compiler-1 map-plist byte-compile-funarg)
+(byte-defop-compiler-1 map-range-table byte-compile-funarg)
+(byte-defop-compiler-1 map-syntax-table byte-compile-funarg)
+(byte-defop-compiler-1 mapcar-extents byte-compile-funarg)
+(byte-defop-compiler-1 mapcar* byte-compile-funarg)
+(byte-defop-compiler-1 maphash byte-compile-funarg)
 (byte-defop-compiler-1 let)
 (byte-defop-compiler-1 let*)
 

--- a/lisp/cl-macs.el	Sun Oct 11 17:26:40 2009 +0200
+++ b/lisp/cl-macs.el	Mon Oct 19 12:47:21 2009 +0100
@@ -3266,6 +3266,11 @@
       form
     (cons 'mapc-internal (cdr form))))
 
+(define-compiler-macro mapcar* (&whole form cl-func cl-x &rest cl-rest)
+  (if cl-rest
+      form
+    (cons 'mapcar (cdr form))))
+
 (mapc
  #'(lambda (y)
      (put (car y) 'side-effect-free t)