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