Mercurial > hg > xemacs-beta
diff lisp/bytecomp.el @ 5566:4654c01af32b
Improve the implementation, documentation of #'labels, #'flet.
lisp/ChangeLog addition:
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.
man/ChangeLog addition:
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.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Wed, 07 Sep 2011 16:26:45 +0100 |
| parents | 855b667dea13 |
| children | b039c0f018b8 |
line wrap: on
line diff
--- 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)))))