Mercurial > hg > xemacs-beta
comparison lisp/bytecomp.el @ 4686:cdabd56ce1b5
Fix various small issues with the multiple-value implementation.
lisp/ChangeLog addition:
2009-08-31 Aidan Kehoe <kehoea@parhasard.net>
* byte-optimize.el (byte-optimize-form-code-walker):
Be careful about discarding multiple values when optimising
#'prog1 calls.
(byte-optimize-or):
Preserve any trailing nil, as this is a supported way to
explicitly discard multiple values.
(byte-optimize-cond-1):
Discard multiple values with a singleton followed by no more
clauses.
* bytecomp.el (progn):
(prog1):
(prog2):
Be careful about discarding multiple values in the byte-hunk
handler of these three forms.
* bytecomp.el (byte-compile-prog1, byte-compile-prog2):
Don't call #'values explicitly, use `(or ,(pop form) nil) instead,
since that compiles to bytecode, not a funcall.
* bytecomp.el (byte-compile-values):
With one non-const argument, byte-compile to `(or ,(second form)
nil), not an explicit #'values call.
* bytecomp.el (byte-compile-insert-header):
Be nicer in the error message to emacs versions that don't
understand our bytecode.
src/ChangeLog addition:
2009-08-31 Aidan Kehoe <kehoea@parhasard.net>
* eval.c (For, Fand):
Don't declare val as REGISTER in these functions, for some reason
it breaks the non-DEBUG union build. These functions are only
called from interpreted code, the performance implication doesn't
matter. Thank you Robert Delius Royar!
* eval.c (Fmultiple_value_list_internal):
Error on too many arguments.
tests/ChangeLog addition:
2009-08-31 Aidan Kehoe <kehoea@parhasard.net>
* automated/lisp-tests.el (Assert-rounding):
Remove an overly-verbose failure message here.
Correct a couple of tests which were buggy in themselves. Add
three new tests, checking the behaviour of #'or and #'and when
passed zero arguments, and a Known-Bug-Expect-Failure call
involving letf and values. (The bug predates the C-level
multiple-value implementation.)
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Sun, 06 Sep 2009 19:36:02 +0100 |
parents | 0cc9d22c3732 |
children | dca5bb2adff1 |
comparison
equal
deleted
inserted
replaced
4685:945247a8112f | 4686:cdabd56ce1b5 |
---|---|
1814 docstrings code.") | 1814 docstrings code.") |
1815 | 1815 |
1816 (defun byte-compile-insert-header (filename byte-compile-inbuffer | 1816 (defun byte-compile-insert-header (filename byte-compile-inbuffer |
1817 byte-compile-outbuffer) | 1817 byte-compile-outbuffer) |
1818 (set-buffer byte-compile-inbuffer) | 1818 (set-buffer byte-compile-inbuffer) |
1819 (let (checks-string comments) | 1819 (let (comments) |
1820 (set-buffer byte-compile-outbuffer) | 1820 (set-buffer byte-compile-outbuffer) |
1821 (delete-region 1 (1+ byte-compile-checks-and-comments-space)) | 1821 (delete-region 1 (1+ byte-compile-checks-and-comments-space)) |
1822 (goto-char 1) | 1822 (goto-char 1) |
1823 ;; | 1823 ;; |
1824 ;; The magic number of .elc files is ";ELC", or 0x3B454C43. After that is | 1824 ;; The magic number of .elc files is ";ELC", or 0x3B454C43. After that is |
1838 (when (not (eq (find-coding-system 'raw-text-unix) | 1838 (when (not (eq (find-coding-system 'raw-text-unix) |
1839 (find-coding-system buffer-file-coding-system))) | 1839 (find-coding-system buffer-file-coding-system))) |
1840 (insert (format ";;;###coding system: %s\n" | 1840 (insert (format ";;;###coding system: %s\n" |
1841 (coding-system-name buffer-file-coding-system)))) | 1841 (coding-system-name buffer-file-coding-system)))) |
1842 (insert (format | 1842 (insert (format |
1843 "\n(or %s\n (error \"Loading this file requires: %s\"))\n" | 1843 "\n(or %s\n (error \"Loading this file requires %s\"))\n" |
1844 (setq checks-string | 1844 (let ((print-readably t)) |
1845 (let ((print-readably t)) | 1845 (prin1-to-string (if (> (length |
1846 (prin1-to-string (if (> (length | 1846 byte-compile-checks-on-load) |
1847 byte-compile-checks-on-load) | 1847 1) |
1848 1) | 1848 (cons 'and |
1849 (cons 'and | 1849 (setq byte-compile-checks-on-load |
1850 (reverse | 1850 (reverse |
1851 byte-compile-checks-on-load)) | 1851 byte-compile-checks-on-load))) |
1852 (car byte-compile-checks-on-load))))) | 1852 (car byte-compile-checks-on-load)))) |
1853 checks-string)) | 1853 (loop |
1854 for check in byte-compile-checks-on-load | |
1855 with seen-first = nil | |
1856 with res = "" | |
1857 do | |
1858 (if seen-first | |
1859 (setq res (concat res ", ")) | |
1860 (setq seen-first t)) | |
1861 ;; Print featurep calls differently: | |
1862 (if (and (eq (car check) 'featurep) | |
1863 (eq (car (second check)) 'quote) | |
1864 (symbolp (second (second check)))) | |
1865 (setq res (concat res | |
1866 (symbol-name (second (second check))))) | |
1867 (setq res (concat res | |
1868 (let ((print-readably t)) | |
1869 (prin1-to-string check))))) | |
1870 finally return res))) | |
1854 (setq comments | 1871 (setq comments |
1855 (with-string-as-buffer-contents "" | 1872 (with-string-as-buffer-contents "" |
1856 (insert "\n;;; compiled by " | 1873 (insert "\n;;; compiled by " |
1857 (or (and (boundp 'user-mail-address) user-mail-address) | 1874 (or (and (boundp 'user-mail-address) user-mail-address) |
1858 (concat (user-login-name) "@" (system-name))) | 1875 (concat (user-login-name) "@" (system-name))) |
2174 (put 'require 'byte-hunk-handler 'byte-compile-file-form-eval-boundary) | 2191 (put 'require 'byte-hunk-handler 'byte-compile-file-form-eval-boundary) |
2175 (defun byte-compile-file-form-eval-boundary (form) | 2192 (defun byte-compile-file-form-eval-boundary (form) |
2176 (eval form) | 2193 (eval form) |
2177 (byte-compile-keep-pending form 'byte-compile-normal-call)) | 2194 (byte-compile-keep-pending form 'byte-compile-normal-call)) |
2178 | 2195 |
2179 (put 'progn 'byte-hunk-handler 'byte-compile-file-form-progn) | 2196 ;; XEmacs change: be careful about multiple values with these three forms. |
2180 (put 'prog1 'byte-hunk-handler 'byte-compile-file-form-progn) | 2197 (put 'progn 'byte-hunk-handler |
2181 (put 'prog2 'byte-hunk-handler 'byte-compile-file-form-progn) | 2198 #'(lambda (form) |
2182 (defun byte-compile-file-form-progn (form) | 2199 (mapc 'byte-compile-file-form (cdr form)) |
2183 (mapcar 'byte-compile-file-form (cdr form)) | 2200 ;; Return nil so the forms are not output twice. |
2184 ;; Return nil so the forms are not output twice. | 2201 nil)) |
2185 nil) | 2202 |
2203 (put 'prog1 'byte-hunk-handler | |
2204 #'(lambda (form) | |
2205 (when (first form) | |
2206 (byte-compile-file-form `(or ,(first form) nil)) | |
2207 (mapc 'byte-compile-file-form (cdr form)) | |
2208 nil))) | |
2209 | |
2210 (put 'prog2 'byte-hunk-handler | |
2211 #'(lambda (form) | |
2212 (when (first form) | |
2213 (byte-compile-file-form (first form)) | |
2214 (when (second form) | |
2215 (setq form (cdr form)) | |
2216 (byte-compile-file-form `(or ,(first form) nil)) | |
2217 (mapc 'byte-compile-file-form (cdr form)) | |
2218 nil)))) | |
2186 | 2219 |
2187 ;; This handler is not necessary, but it makes the output from dont-compile | 2220 ;; This handler is not necessary, but it makes the output from dont-compile |
2188 ;; and similar macros cleaner. | 2221 ;; and similar macros cleaner. |
2189 (put 'eval 'byte-hunk-handler 'byte-compile-file-form-eval) | 2222 (put 'eval 'byte-hunk-handler 'byte-compile-file-form-eval) |
2190 (defun byte-compile-file-form-eval (form) | 2223 (defun byte-compile-file-form-eval (form) |
3675 (byte-compile-body-do-effect (cdr form))) | 3708 (byte-compile-body-do-effect (cdr form))) |
3676 | 3709 |
3677 (defun byte-compile-prog1 (form) | 3710 (defun byte-compile-prog1 (form) |
3678 (setq form (cdr form)) | 3711 (setq form (cdr form)) |
3679 ;; #'prog1 never returns multiple values: | 3712 ;; #'prog1 never returns multiple values: |
3680 (byte-compile-form-do-effect (list 'values (pop form))) | 3713 (byte-compile-form-do-effect `(or ,(pop form) nil)) |
3681 (byte-compile-body form t)) | 3714 (byte-compile-body form t)) |
3682 | 3715 |
3683 (defun byte-compile-multiple-value-prog1 (form) | 3716 (defun byte-compile-multiple-value-prog1 (form) |
3684 (setq form (cdr form)) | 3717 (setq form (cdr form)) |
3685 (byte-compile-form-do-effect (pop form)) | 3718 (byte-compile-form-do-effect (pop form)) |
3686 (byte-compile-body form t)) | 3719 (byte-compile-body form t)) |
3687 | 3720 |
3688 (defun byte-compile-values (form) | 3721 (defun byte-compile-values (form) |
3689 (if (and (= 2 (length form)) | 3722 (if (= 2 (length form)) |
3690 (byte-compile-constp (second form))) | 3723 (if (byte-compile-constp (second form)) |
3691 (byte-compile-form-do-effect (second form)) | 3724 (byte-compile-form-do-effect (second form)) |
3725 ;; #'or compiles to bytecode, #'values doesn't: | |
3726 (byte-compile-form-do-effect `(or ,(second form) nil))) | |
3692 (byte-compile-normal-call form))) | 3727 (byte-compile-normal-call form))) |
3693 | 3728 |
3694 (defun byte-compile-values-list (form) | 3729 (defun byte-compile-values-list (form) |
3695 (if (and (= 2 (length form)) | 3730 (if (and (= 2 (length form)) |
3696 (or (null (second form)) | 3731 (or (null (second form)) |
3703 | 3738 |
3704 (defun byte-compile-prog2 (form) | 3739 (defun byte-compile-prog2 (form) |
3705 (setq form (cdr form)) | 3740 (setq form (cdr form)) |
3706 (byte-compile-form (pop form) t) | 3741 (byte-compile-form (pop form) t) |
3707 ;; #'prog2 never returns multiple values: | 3742 ;; #'prog2 never returns multiple values: |
3708 (byte-compile-form-do-effect (list 'values (pop form))) | 3743 (byte-compile-form-do-effect `(or ,(pop form) nil)) |
3709 (byte-compile-body form t)) | 3744 (byte-compile-body form t)) |
3710 | 3745 |
3711 (defmacro byte-compile-goto-if (cond discard tag) | 3746 (defmacro byte-compile-goto-if (cond discard tag) |
3712 `(byte-compile-goto | 3747 `(byte-compile-goto |
3713 (if ,cond | 3748 (if ,cond |