Mercurial > hg > xemacs-beta
comparison 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 |
comparison
equal
deleted
inserted
replaced
5565:48a3d3281b48 | 5566:4654c01af32b |
---|---|
470 (dolist (elt save-macro-environment) | 470 (dolist (elt save-macro-environment) |
471 (if (symbolp elt) | 471 (if (symbolp elt) |
472 (fmakunbound elt) | 472 (fmakunbound elt) |
473 (fset (car elt) (cdr elt))))))) | 473 (fset (car elt) (cdr elt))))))) |
474 | 474 |
475 (defvar for-effect) ; ## Kludge! This should be an arg, not a special. | |
476 | |
475 (defconst byte-compile-initial-macro-environment | 477 (defconst byte-compile-initial-macro-environment |
476 `((byte-compiler-options | 478 `((byte-compiler-options |
477 . ,#'(lambda (&rest forms) | 479 . ,#'(lambda (&rest forms) |
478 (apply 'byte-compiler-options-handler forms))) | 480 (apply 'byte-compiler-options-handler forms))) |
479 (eval-when-compile | 481 (eval-when-compile |
503 `(progn (setq ,gensym ,form) ,byte-compile-output-preface) | 505 `(progn (setq ,gensym ,form) ,byte-compile-output-preface) |
504 t 'file)) | 506 t 'file)) |
505 `(symbol-value ',gensym)))) | 507 `(symbol-value ',gensym)))) |
506 (labels | 508 (labels |
507 . ,#'(lambda (bindings &rest body) | 509 . ,#'(lambda (bindings &rest body) |
508 (let* ((bindings | 510 (let* ((names (mapcar 'car bindings)) |
509 (mapcar (function* | 511 (lambdas (mapcar |
510 (lambda ((name . binding)) | 512 (function* |
511 (list* name 'lambda | 513 (lambda ((name . definition)) |
512 (cdr (cl-transform-lambda binding | 514 (cons 'lambda (cdr (cl-transform-lambda |
513 name))))) | 515 definition name))))) |
514 bindings)) | 516 bindings)) |
515 ;; These placeholders are to ensure that the | |
516 ;; lexically-scoped functions can be called from each | |
517 ;; other. | |
518 (placeholders | 517 (placeholders |
519 (mapcar #'(lambda (binding) | 518 (mapcar #'(lambda (lambda) |
520 (cons (car binding) | 519 (make-byte-code (second lambda) "\xc0\x87" |
521 (make-byte-code (third binding) | 520 [42] 1)) |
522 "\xc0\x87" [42] 1))) | 521 lambdas)) |
523 bindings)) | |
524 (byte-compile-macro-environment | 522 (byte-compile-macro-environment |
525 (nconc | 523 (pairlis names (mapcar |
526 (mapcar | 524 #'(lambda (placeholder) |
527 (function* | 525 `(lambda (&rest cl-labels-args) |
528 (lambda ((name . placeholder)) | 526 (list* 'funcall ,placeholder |
529 (cons name `(lambda (&rest cl-labels-args) | 527 cl-labels-args))) |
530 (list* 'funcall ,placeholder | 528 placeholders) |
531 cl-labels-args))))) | 529 byte-compile-macro-environment)) |
532 placeholders) | 530 (gensym (gensym))) |
533 byte-compile-macro-environment)) | 531 (put gensym 'byte-compile-label-alist |
534 placeholder-map) | 532 (pairlis placeholders |
535 (setq bindings | 533 (mapcar 'second (mapcar 'cl-macroexpand-all |
536 (mapcar (function* | 534 lambdas)))) |
537 (lambda ((name . lambda)) | 535 (put gensym 'byte-compile |
538 (cons name (byte-compile-lambda lambda)))) | 536 #'(lambda (form) |
539 bindings) | 537 (let* ((byte-compile-label-alist |
540 placeholder-map | 538 (get (car form) 'byte-compile-label-alist))) |
541 (mapcar (function* | 539 (dolist (acons byte-compile-label-alist) |
542 (lambda ((name . compiled-function)) | 540 (setf (cdr acons) |
543 (cons (cdr (assq name placeholders)) | 541 (byte-compile-lambda (cdr acons)))) |
544 compiled-function))) | 542 (byte-compile-body-do-effect |
545 bindings)) | 543 (sublis byte-compile-label-alist (cdr form) |
546 (loop | 544 :test #'eq)) |
547 for (placeholder . compiled-function) | 545 (dolist (acons byte-compile-label-alist) |
548 in placeholder-map | 546 (nsubst (cdr acons) (car acons) |
549 do (nsubst compiled-function placeholder bindings | 547 byte-compile-label-alist :test #'eq |
550 :test 'eq :descend-structures t)) | 548 :descend-structures t))))) |
551 (cl-macroexpand-all (cons 'progn body) | 549 (cl-macroexpand-all (cons gensym body) |
552 (sublis placeholder-map | 550 byte-compile-macro-environment)))) |
553 byte-compile-macro-environment | 551 (flet . |
554 :test 'eq)))))) | 552 ,#'(lambda (bindings &rest body) |
553 (let* ((names (mapcar 'car bindings)) | |
554 (lambdas (mapcar | |
555 (function* | |
556 (lambda ((function . definition)) | |
557 (cons 'lambda (cdr (cl-transform-lambda | |
558 definition function))))) | |
559 bindings)) | |
560 (gensym (gensym))) | |
561 (put gensym 'byte-compile-flet-environment | |
562 (pairlis names lambdas)) | |
563 (put gensym 'byte-compile | |
564 #'(lambda (form) | |
565 (let* ((byte-compile-flet-environment | |
566 (get (car form) 'byte-compile-flet-environment)) | |
567 (byte-compile-function-environment | |
568 (append byte-compile-flet-environment | |
569 byte-compile-function-environment)) | |
570 name) | |
571 (dolist (acons byte-compile-flet-environment) | |
572 (setq name (car acons)) | |
573 (if (and (memq 'redefine byte-compile-warnings) | |
574 (or (cdr | |
575 (assq name | |
576 byte-compile-macro-environment)) | |
577 (eq 'macro | |
578 (ignore-errors | |
579 (car (symbol-function name)))))) | |
580 ;; XEmacs change; this is a warning, not an | |
581 ;; error. The only use case for #'flet instead | |
582 ;; of #'labels is to shadow a dynamically | |
583 ;; bound function at runtime, and it's | |
584 ;; reasonable to do this even if that symbol | |
585 ;; has a macro binding at compile time. | |
586 (byte-compile-warn | |
587 "flet: redefining macro %s as a function" | |
588 name)) | |
589 (if (get name 'byte-opcode) | |
590 (byte-compile-warn | |
591 "flet: %s has a byte code, consider #'labels" | |
592 name)) | |
593 (if (get name 'byte-compile) | |
594 (byte-compile-warn | |
595 "flet: %s has a byte-compile method, | |
596 consider #'labels" name))) | |
597 (byte-compile-form (second form))))) | |
598 `(,gensym (letf* ,(mapcar* #'(lambda (name lambda) | |
599 `((symbol-function ',name) | |
600 ,lambda)) names lambdas) | |
601 ,@body)))))) | |
602 | |
555 "The default macro-environment passed to macroexpand by the compiler. | 603 "The default macro-environment passed to macroexpand by the compiler. |
556 Placing a macro here will cause a macro to have different semantics when | 604 Placing a macro here will cause a macro to have different semantics when |
557 expanded by the compiler as when expanded by the interpreter.") | 605 expanded by the compiler as when expanded by the interpreter.") |
558 | 606 |
559 (defvar byte-compile-function-environment nil | 607 (defvar byte-compile-function-environment nil |
2084 (insert (nth 2 info)) | 2132 (insert (nth 2 info)) |
2085 (when byte-compile-output-preface | 2133 (when byte-compile-output-preface |
2086 (princ ")" byte-compile-outbuffer)))))) | 2134 (princ ")" byte-compile-outbuffer)))))) |
2087 nil) | 2135 nil) |
2088 | 2136 |
2089 (defvar for-effect) ; ## Kludge! This should be an arg, not a special. | |
2090 | |
2091 (defun byte-compile-keep-pending (form &optional handler) | 2137 (defun byte-compile-keep-pending (form &optional handler) |
2092 (if (memq byte-optimize '(t source)) | 2138 (if (memq byte-optimize '(t source)) |
2093 (setq form (byte-optimize-form form t))) | 2139 (setq form (byte-optimize-form form t))) |
2094 (if handler | 2140 (if handler |
2095 (let ((for-effect t)) | 2141 (let ((for-effect t)) |
4020 (byte-compile-goto 'byte-goto looptag) | 4066 (byte-compile-goto 'byte-goto looptag) |
4021 (byte-compile-out-tag endtag) | 4067 (byte-compile-out-tag endtag) |
4022 (setq for-effect nil))) | 4068 (setq for-effect nil))) |
4023 | 4069 |
4024 (defun byte-compile-funcall (form) | 4070 (defun byte-compile-funcall (form) |
4071 (if (and (memq 'callargs byte-compile-warnings) | |
4072 (byte-compile-constp (second form))) | |
4073 (byte-compile-callargs-warn (cons (cl-const-expr-val (second form)) | |
4074 (nthcdr 2 form)))) | |
4025 (mapc 'byte-compile-form (cdr form)) | 4075 (mapc 'byte-compile-form (cdr form)) |
4026 (byte-compile-out 'byte-call (length (cdr (cdr form))))) | 4076 (byte-compile-out 'byte-call (length (cdr (cdr form))))) |
4027 | 4077 |
4028 | 4078 |
4029 (defun byte-compile-let (form) | 4079 (defun byte-compile-let (form) |