Mercurial > hg > xemacs-beta
comparison lisp/bytecomp.el @ 5593:4218b56833b3
Give the label name when warning or erroring, bytecomp.el
2011-11-02 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-lambda):
Accept a new NAME argument here, have byte-compile-current-form
reflect that if it's specified.
* bytecomp.el (byte-compile-initial-macro-environment):
Specify the label name when byte-compiling it, so warning and
errors are more helpful.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Wed, 02 Nov 2011 17:50:39 +0000 |
| parents | 3e621ba12d36 |
| children | 2c20bc575989 |
comparison
equal
deleted
inserted
replaced
| 5588:2dbefd79b3d3 | 5593:4218b56833b3 |
|---|---|
| 561 (compiled-function-constants | 561 (compiled-function-constants |
| 562 placeholder) 0) | 562 placeholder) 0) |
| 563 'byte-optimizer) | 563 'byte-optimizer) |
| 564 'byte-compile-inline-expand) | 564 'byte-compile-inline-expand) |
| 565 `(((function ,placeholder) | 565 `(((function ,placeholder) |
| 566 ,(byte-compile-lambda lambda) | 566 ,(byte-compile-lambda lambda name) |
| 567 (function ,lambda))))) | 567 (function ,lambda))))) |
| 568 names placeholders lambdas)) | 568 names placeholders lambdas)) |
| 569 (compiled | 569 (compiled |
| 570 (mapcar #'byte-compile-lambda | 570 (mapcar* #'byte-compile-lambda |
| 571 (if (not inline) | 571 (if (not inline) |
| 572 lambdas | 572 lambdas |
| 573 ;; See further down for the | 573 ;; See further down for the |
| 574 ;; rationale of the sublis calls. | 574 ;; rationale of the sublis calls. |
| 575 (sublis (pairlis | 575 (sublis (pairlis |
| 576 (mapcar #'cadar inline) | 576 (mapcar #'cadar inline) |
| 577 (mapcar #'third inline)) | 577 (mapcar #'third inline)) |
| 578 (sublis | 578 (sublis |
| 579 (pairlis | 579 (pairlis |
| 580 (mapcar #'car inline) | 580 (mapcar #'car inline) |
| 581 (mapcar #'second inline)) | 581 (mapcar #'second inline)) |
| 582 lambdas :test #'equal) | 582 lambdas :test #'equal) |
| 583 :test #'eq)))) | 583 :test #'eq)) |
| 584 names)) | |
| 584 elt) | 585 elt) |
| 585 (mapc #'(lambda (placeholder function) | 586 (mapc #'(lambda (placeholder function) |
| 586 (nsubst function placeholder compiled | 587 (nsubst function placeholder compiled |
| 587 :test #'eq | 588 :test #'eq |
| 588 :descend-structures t)) | 589 :descend-structures t)) |
| 2734 (list 'quote fun)))))) | 2735 (list 'quote fun)))))) |
| 2735 | 2736 |
| 2736 ;; Byte-compile a lambda-expression and return a valid function. | 2737 ;; Byte-compile a lambda-expression and return a valid function. |
| 2737 ;; The value is usually a compiled function but may be the original | 2738 ;; The value is usually a compiled function but may be the original |
| 2738 ;; lambda-expression. | 2739 ;; lambda-expression. |
| 2739 (defun byte-compile-lambda (fun) | 2740 (defun byte-compile-lambda (fun &optional name) |
| 2740 (or (eq 'lambda (car-safe fun)) | 2741 (or (eq 'lambda (car-safe fun)) |
| 2741 (error "not a lambda -- %s" (prin1-to-string fun))) | 2742 (error "not a lambda -- %s" (prin1-to-string fun))) |
| 2742 (let* ((arglist (nth 1 fun)) | 2743 (let* ((byte-compile-current-form (or name byte-compile-current-form)) |
| 2744 (arglist (nth 1 fun)) | |
| 2743 (byte-compile-bound-variables | 2745 (byte-compile-bound-variables |
| 2744 (let ((new-bindings | 2746 (let ((new-bindings |
| 2745 (mapcar #'(lambda (x) (cons x byte-compile-arglist-bit)) | 2747 (mapcar #'(lambda (x) (cons x byte-compile-arglist-bit)) |
| 2746 (and (memq 'free-vars byte-compile-warnings) | 2748 (and (memq 'free-vars byte-compile-warnings) |
| 2747 (delq '&rest (delq '&optional | 2749 (delq '&rest (delq '&optional |