--- a/lisp/ChangeLog	Tue Sep 06 11:44:50 2011 +0100
+++ b/lisp/ChangeLog	Wed Sep 07 16:26:45 2011 +0100
@@ -1,3 +1,37 @@
+2011-09-07  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* bytecomp.el:
+	* bytecomp.el (for-effect): Move this earlier in the file, it's
+	referenced in byte-compile-initial-macro-environment.
+	* bytecomp.el (byte-compile-initial-macro-environment):
+	In the byte-compile-macro-environment definition for #'labels, put
+	off the compiling the lambda bodies until the point where the rest
+	of the form is being compiled, allowing the lambda bodies to
+	access appropriate values for byte-compile-bound-variables, and
+	reducing excessive warning about free variables.
+
+	Add a byte-compile-macro-environment definition for #'flet. This
+	modifies byte-compile-function-environment appropriately, and
+	warns about bindings of functions that have macro definitions in
+	the current environment, about functions that have byte codes, and
+	about functions that have byte-compile methods (which may not do
+	what the user wants at runtime).
+	* bytecomp.el (byte-compile-funcall):
+	If FUNCTION is constant, call #'byte-compile-callargs-warn if
+	that's appropriate, giving warnings about problems with calling
+	functions bound with #'labels.
+
+	* cl-macs.el:
+	* cl-macs.el (flet):
+	Mention the main difference from Common Lisp, that the bindings
+	are dynamic, not lexical. Counsel the use of #'labels, not #'flet,
+	for this and other reasons. Explain the limited single use case for
+	#'flet. Cross-reference to bytecomp.el in a comment.
+	* cl-macs.el (labels):
+	Go into detail on which functions may be called from
+	where. Explain how to access the function definition of a label
+	within FORM. Add a comment cross-referencing to bytecomp.el.
+
 2011-09-06  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* mule/mule-cmds.el (set-language-environment-coding-systems):

--- a/lisp/bytecomp.el	Tue Sep 06 11:44:50 2011 +0100
+++ b/lisp/bytecomp.el	Wed Sep 07 16:26:45 2011 +0100
@@ -472,6 +472,8 @@
 	    (fmakunbound elt)
 	  (fset (car elt) (cdr elt)))))))
 
+(defvar for-effect) ; ## Kludge!  This should be an arg, not a special.
+
 (defconst byte-compile-initial-macro-environment
   `((byte-compiler-options
       . ,#'(lambda (&rest forms)
@@ -505,53 +507,99 @@
               `(symbol-value ',gensym))))
     (labels
         . ,#'(lambda (bindings &rest body)
-               (let* ((bindings
-                       (mapcar (function*
-                                (lambda ((name . binding))
-                                  (list* name 'lambda
-                                         (cdr (cl-transform-lambda binding
-                                                                   name)))))
-                               bindings))
-                      ;; These placeholders are to ensure that the
-                      ;; lexically-scoped functions can be called from each
-                      ;; other.
+               (let* ((names (mapcar 'car bindings))
+                      (lambdas (mapcar
+                                (function*
+                                 (lambda ((name . definition))
+                                   (cons 'lambda (cdr (cl-transform-lambda
+                                                       definition name)))))
+                                bindings))
                       (placeholders
-                       (mapcar #'(lambda (binding)
-                                   (cons (car binding)
-                                         (make-byte-code (third binding)
-                                                         "\xc0\x87" [42] 1)))
-                               bindings))
+                       (mapcar #'(lambda (lambda)
+                                   (make-byte-code (second lambda) "\xc0\x87"
+                                                   [42] 1))
+                               lambdas))
                       (byte-compile-macro-environment
-                       (nconc
-                        (mapcar
-                         (function*
-                          (lambda ((name . placeholder))
-                            (cons name `(lambda (&rest cl-labels-args)
-                                          (list* 'funcall ,placeholder
-                                                 cl-labels-args)))))
-                         placeholders)
-                        byte-compile-macro-environment))
-                      placeholder-map)
-                 (setq bindings
-                       (mapcar (function*
-                                (lambda ((name . lambda))
-                                  (cons name (byte-compile-lambda lambda))))
-                               bindings)
-                       placeholder-map
-                       (mapcar (function*
-                                (lambda ((name . compiled-function))
-                                  (cons (cdr (assq name placeholders))
-                                        compiled-function)))
-                               bindings))
-                 (loop
-                   for (placeholder . compiled-function)
-                   in placeholder-map
-                   do (nsubst compiled-function placeholder bindings
-                              :test 'eq :descend-structures t))
-                 (cl-macroexpand-all (cons 'progn body)
-                                     (sublis placeholder-map
-                                             byte-compile-macro-environment
-                                             :test 'eq))))))
+                       (pairlis names (mapcar
+                                       #'(lambda (placeholder)
+                                           `(lambda (&rest cl-labels-args)
+                                              (list* 'funcall ,placeholder
+                                                     cl-labels-args)))
+                                       placeholders)
+                                byte-compile-macro-environment))
+                      (gensym (gensym)))
+                 (put gensym 'byte-compile-label-alist
+                      (pairlis placeholders
+                               (mapcar 'second (mapcar 'cl-macroexpand-all
+                                                       lambdas))))
+                 (put gensym 'byte-compile
+                      #'(lambda (form)
+                          (let* ((byte-compile-label-alist
+                                  (get (car form) 'byte-compile-label-alist)))
+                            (dolist (acons byte-compile-label-alist)
+                              (setf (cdr acons)
+                                    (byte-compile-lambda (cdr acons))))
+                            (byte-compile-body-do-effect
+                             (sublis byte-compile-label-alist (cdr form)
+                                     :test #'eq))
+                            (dolist (acons byte-compile-label-alist)
+                              (nsubst (cdr acons) (car acons)
+                                      byte-compile-label-alist :test #'eq
+                                      :descend-structures t)))))
+                 (cl-macroexpand-all (cons gensym body)
+                                     byte-compile-macro-environment))))
+    (flet .
+      ,#'(lambda (bindings &rest body)
+           (let* ((names (mapcar 'car bindings))
+                  (lambdas (mapcar
+                            (function*
+                             (lambda ((function . definition))
+                               (cons 'lambda (cdr (cl-transform-lambda
+                                                   definition function)))))
+                            bindings))
+                  (gensym (gensym)))
+             (put gensym 'byte-compile-flet-environment
+                  (pairlis names lambdas))
+             (put gensym 'byte-compile
+                  #'(lambda (form)
+                      (let* ((byte-compile-flet-environment
+                              (get (car form) 'byte-compile-flet-environment))
+                             (byte-compile-function-environment
+                              (append byte-compile-flet-environment
+                                      byte-compile-function-environment))
+                             name)
+                        (dolist (acons byte-compile-flet-environment)
+                          (setq name (car acons))
+                          (if (and (memq 'redefine byte-compile-warnings)
+                                   (or (cdr
+                                        (assq name
+                                              byte-compile-macro-environment))
+                                       (eq 'macro
+                                           (ignore-errors
+                                             (car (symbol-function name))))))
+                              ;; XEmacs change; this is a warning, not an
+                              ;; error. The only use case for #'flet instead
+                              ;; of #'labels is to shadow a dynamically
+                              ;; bound function at runtime, and it's
+                              ;; reasonable to do this even if that symbol
+                              ;; has a macro binding at compile time.
+                              (byte-compile-warn
+                               "flet: redefining macro %s as a function"
+                               name))
+                          (if (get name 'byte-opcode)
+                              (byte-compile-warn
+                               "flet: %s has a byte code, consider #'labels"
+                               name))
+                          (if (get name 'byte-compile) 
+                              (byte-compile-warn
+                               "flet: %s has a byte-compile method, 
+consider #'labels" name)))
+                        (byte-compile-form (second form)))))
+             `(,gensym (letf* ,(mapcar* #'(lambda (name lambda)
+                                            `((symbol-function ',name)
+                                              ,lambda)) names lambdas)
+                         ,@body))))))
+
   "The default macro-environment passed to macroexpand by the compiler.
 Placing a macro here will cause a macro to have different semantics when
 expanded by the compiler as when expanded by the interpreter.")
@@ -2086,8 +2134,6 @@
 	   (princ ")" byte-compile-outbuffer))))))
   nil)
 
-(defvar for-effect) ; ## Kludge!  This should be an arg, not a special.
-
 (defun byte-compile-keep-pending (form &optional handler)
   (if (memq byte-optimize '(t source))
       (setq form (byte-optimize-form form t)))
@@ -4022,6 +4068,10 @@
     (setq for-effect nil)))
 
 (defun byte-compile-funcall (form)
+  (if (and (memq 'callargs byte-compile-warnings)
+           (byte-compile-constp (second form)))
+      (byte-compile-callargs-warn (cons (cl-const-expr-val (second form))
+                                        (nthcdr 2 form))))
   (mapc 'byte-compile-form (cdr form))
   (byte-compile-out 'byte-call (length (cdr (cdr form)))))
 

--- a/lisp/cl-macs.el	Tue Sep 06 11:44:50 2011 +0100
+++ b/lisp/cl-macs.el	Wed Sep 07 16:26:45 2011 +0100
@@ -1714,41 +1714,59 @@
 	      (list* 'progn (list 'cl-progv-before symbols values) body)
 	      '(cl-progv-after))))
 
-;;; This should really have some way to shadow 'byte-compile properties, etc.
 ;;;###autoload
-(defmacro flet (bindings &rest body)
+(defmacro flet (functions &rest form)
   "Make temporary function definitions.
+
 This is an analogue of `let' that operates on the function cell of FUNC
 rather than its value cell.  The FORMs are evaluated with the specified
-function definitions in place, then the definitions are undone (the FUNCs
-go back to their previous definitions, or lack thereof).
-
-arguments: (((FUNC ARGLIST &body BODY) &rest FUNCTIONS) &body FORM)"
-  (list* 'letf*
-	 (mapcar
-	  #'(lambda (x)
-	      (if (or (and (fboundp (car x))
-			   (eq (car-safe (symbol-function (car x))) 'macro))
-		      (cdr (assq (car x) byte-compile-macro-environment)))
-		  (error "Use `labels', not `flet', to rebind macro names"))
-	      (let ((func (list 'function*
-				(list 'lambda (cadr x)
-				      (list* 'block (car x) (cddr x))))))
-		(if (and (cl-compiling-file)
-			 (boundp 'byte-compile-function-environment))
-		    (push (cons (car x) (eval func))
-			     byte-compile-function-environment))
-		(list (list 'symbol-function (list 'quote (car x))) func)))
-	  bindings)
-	 body))
+function definitions in place, then the definitions are undone (the FUNCs go
+back to their previous definitions, or lack thereof).  This is in
+contravention of Common Lisp, where `flet' makes a lexical, not a dynamic,
+function binding.
+
+Normally you should use `labels', not `flet'; `labels' does not have the
+problems caused by dynamic scope, is less expensive when byte-compiled, and
+allows lexical shadowing of functions with byte-codes and byte-compile
+methods, where `flet' will fail.  The byte-compiler will warn when this
+happens.
+
+If you need to shadow some existing function at run time, and that function
+has no associated byte code or compiler macro, then `flet' is appropriate.
+
+arguments: (((FUNCTION ARGLIST &body BODY) &rest FUNCTIONS) &body FORM)"
+  ;; XEmacs; leave warnings, errors and modifications of
+  ;; byte-compile-function-environment to the byte compiler. See
+  ;; byte-compile-initial-macro-environment in bytecomp.el.
+  (list*
+   'letf*
+   (mapcar
+    (function*
+     (lambda ((function . definition))
+       `((symbol-function ',function) 
+         ,(cons 'lambda (cdr (cl-transform-lambda definition function))))))
+    functions) form))
 
 ;;;###autoload
 (defmacro labels (bindings &rest body)
-  "Make temporary func bindings.
+  "Make temporary function bindings.
+
 This is like `flet', except the bindings are lexical instead of dynamic.
-Unlike `flet', this macro is fully compliant with the Common Lisp standard.
-
-arguments: (((FUNC ARGLIST &body BODY) &rest FUNCTIONS) &body FORM)"
+Unlike `flet', this macro is compliant with the Common Lisp standard with
+regard to the scope and extent of the function bindings.
+
+Each function may be called from within FORM, from within the BODY of the
+function itself (that is, recursively), and from any other function bodies
+in FUNCTIONS.
+
+Within FORM, to access the function definition of a bound function (for
+example, to pass it as a FUNCTION argument to `map'), quote its symbol name
+using `function'.
+
+arguments: (((FUNCTION ARGLIST &body BODY) &rest FUNCTIONS) &body FORM)"
+  ;; XEmacs; the byte-compiler has a much better implementation of `labels'
+  ;; in `byte-compile-initial-macro-environment' that is used in compiled
+  ;; code.
   (let ((vars nil) (sets nil)
         (byte-compile-macro-environment byte-compile-macro-environment))
     (while bindings
@@ -1764,8 +1782,6 @@
     (cl-macroexpand-all (list* 'lexical-let vars (cons (cons 'setq sets) body))
 			byte-compile-macro-environment)))
 
-;; The following ought to have a better definition for use with newer
-;; byte compilers.
 ;;;###autoload
 (defmacro* macrolet ((&rest macros) &body form)
   "Make temporary macro definitions.

--- a/man/ChangeLog	Tue Sep 06 11:44:50 2011 +0100
+++ b/man/ChangeLog	Wed Sep 07 16:26:45 2011 +0100
@@ -1,3 +1,11 @@
+2011-09-07  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* cl.texi (Function Bindings):
+	Move #'labels first, describe it in more detail, explaining that
+	it is to be preferred over #'flet, and explaining why.
+	Explain that dynamic bindings with #'flet will also not work when
+	functions are accessed through their bytecodes.
+
 2011-08-14  Mike Sperber  <mike@xemacs.org>
 
 	* xemacs-faq.texi:

--- a/man/cl.texi	Tue Sep 06 11:44:50 2011 +0100
+++ b/man/cl.texi	Wed Sep 07 16:26:45 2011 +0100
@@ -1799,55 +1799,73 @@
 @subsection Function Bindings
 
 @noindent
-These forms make @code{let}-like bindings to functions instead
-of variables.
+These forms make @code{let}-like bindings to functions instead of
+variables. Normally you should use @code{labels}, it is less expensive in
+compiled code and avoids the problems of dynamic scope.
+
+@defmac labels (bindings@dots{}) forms@dots{}
+This form establishes @code{lexical-let}-style bindings on the function cells
+of symbols rather than on their value cells.  Each @var{binding} must be a
+list of the form @samp{(@var{name} @var{arglist} @var{forms}@dots{})}, which
+defines a function exactly as if it were a @code{defun*} form.  The function
+@var{name} is available within @var{forms}, within the body of @var{name}, and
+within the body of any other functions in @var{bindings}.  This allows the
+establishment of recursive and mutually-referential functions.
+
+These functions are not available by name at run-time to code textually
+outside of the @code{labels} form, though they may be passed to other code by
+value. Since @code{labels} makes lexical rather than dynamic bindings,
+bindings of functions like @code{+} and @code{list} that have byte codes will
+succeed---that is, calls to such functions within @var{form} will reflect the
+bindings within the @code{labels} form, something not true of @code{flet},
+which see.
+
+Within @var{forms}, to access a bound function as a callable object, quote its
+name using @var{#'name}, as in the following example.
+
+@example
+(labels ((1+ (number)
+           "Return 1.0 added to NUMBER"
+           (+ number 1.0)))
+  (map 'vector #'1+ '(10 9 8 7 6 5 4 3 2 1)))
+  @result{} [11.0 10.0 9.0 8.0 7.0 6.0 5.0 4.0 3.0 2.0]
+@end example
+
+Functions defined by @code{labels} may use the full Common Lisp argument
+notation supported by @code{defun*}; also, the function body is enclosed in an
+implicit block as if by @code{defun*}.  @xref{Program Structure}.
+@end defmac
 
 @defmac flet (bindings@dots{}) forms@dots{}
-This form establishes @code{let}-style bindings on the function
-cells of symbols rather than on the value cells.  Each @var{binding}
-must be a list of the form @samp{(@var{name} @var{arglist}
-@var{forms}@dots{})}, which defines a function exactly as if
-it were a @code{defun*} form.  The function @var{name} is defined
-accordingly for the duration of the body of the @code{flet}; then
-the old function definition, or lack thereof, is restored.
-
-While @code{flet} in Common Lisp establishes a lexical binding of
-@var{name}, Emacs Lisp @code{flet} makes a dynamic binding.  The
-result is that @code{flet} affects indirect calls to a function as
-well as calls directly inside the @code{flet} form itself.
-
-You can use @code{flet} to disable or modify the behavior of a
-function in a temporary fashion.  This will even work on Emacs
-primitives, although note that some calls to primitive functions
-internal to Emacs are made without going through the symbol's
-function cell, and so will not be affected by @code{flet}.  For
-example,
+This form establishes @code{let}-style bindings on the function cells of
+symbols rather than on the value cells.  In contravention of Common Lisp,
+Emacs Lisp @code{flet} establishes dynamic bindings (available at runtime)
+rather than lexical (available at compile time, but outside of @var{forms},
+not at runtime). The result is that @code{flet} affects indirect calls to a
+function as well as calls directly inside the @code{flet} form itself.
+
+You can use @code{flet} to disable or modify the behavior of a function in a
+temporary fashion.  This will even work on XEmacs primitives, although note
+that some calls to primitive functions internal to XEmacs are made without
+going through the symbol's function cell, and so will not be affected by
+@code{flet}.  For example,
 
 @example
 (flet ((message (&rest args) (push args saved-msgs)))
   (do-something))
 @end example
 
-This code attempts to replace the built-in function @code{message}
-with a function that simply saves the messages in a list rather
-than displaying them.  The original definition of @code{message}
-will be restored after @code{do-something} exits.  This code will
-work fine on messages generated by other Lisp code, but messages
-generated directly inside Emacs will not be caught since they make
-direct C-language calls to the message routines rather than going
-through the Lisp @code{message} function.
-
-Functions defined by @code{flet} may use the full Common Lisp
-argument notation supported by @code{defun*}; also, the function
-body is enclosed in an implicit block as if by @code{defun*}.
-@xref{Program Structure}.
-@end defmac
-
-@defmac labels (bindings@dots{}) forms@dots{}
-The @code{labels} form is a synonym for @code{flet}.  (In Common
-Lisp, @code{labels} and @code{flet} differ in ways that depend on
-their lexical scoping; these distinctions vanish in dynamically
-scoped Emacs Lisp.)
+This code attempts to replace the built-in function @code{message} with a
+function that simply saves the messages in a list rather than displaying them.
+The original definition of @code{message} will be restored after
+@code{do-something} exits.  This code will work fine on messages generated by
+other Lisp code, but messages generated directly inside XEmacs will not be
+caught since they make direct C-language calls to the message routines rather
+than going through the Lisp @code{message} function.
+
+This is equally true for functions with associated byte codes, since they are
+also not accessed through the Lisp function slot.  The byte compiler will
+warn in both these cases.
 @end defmac
 
 @node Macro Bindings, , Function Bindings, Variable Bindings