Mercurial > hg > xemacs-beta
comparison lisp/byte-optimize.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 | 8f1ee2d15784 |
children | 6772ce4d982b |
comparison
equal
deleted
inserted
replaced
4685:945247a8112f | 4686:cdabd56ce1b5 |
---|---|
434 ((eq fn 'prog1) | 434 ((eq fn 'prog1) |
435 (if (cdr (cdr form)) | 435 (if (cdr (cdr form)) |
436 (cons 'prog1 | 436 (cons 'prog1 |
437 (cons (byte-optimize-form (nth 1 form) for-effect) | 437 (cons (byte-optimize-form (nth 1 form) for-effect) |
438 (byte-optimize-body (cdr (cdr form)) t))) | 438 (byte-optimize-body (cdr (cdr form)) t))) |
439 (byte-optimize-form (nth 1 form) for-effect))) | 439 (byte-optimize-form `(or ,(nth 1 form) nil) for-effect))) |
440 ((eq fn 'prog2) | 440 ((eq fn 'prog2) |
441 (cons 'prog2 | 441 (cons 'prog2 |
442 (cons (byte-optimize-form (nth 1 form) t) | 442 (cons (byte-optimize-form (nth 1 form) t) |
443 (cons (byte-optimize-form (nth 2 form) for-effect) | 443 (cons (byte-optimize-form (nth 2 form) for-effect) |
444 (byte-optimize-body (cdr (cdr (cdr form))) t))))) | 444 (byte-optimize-body (cdr (cdr (cdr form))) t))))) |
948 ((null (cdr (cdr form))) | 948 ((null (cdr (cdr form))) |
949 (nth 1 form)) | 949 (nth 1 form)) |
950 ((byte-optimize-predicate form)))) | 950 ((byte-optimize-predicate form)))) |
951 | 951 |
952 (defun byte-optimize-or (form) | 952 (defun byte-optimize-or (form) |
953 ;; Throw away nil's, and simplify if less than 2 args. | 953 ;; Throw away unneeded nils, and simplify if less than 2 args. |
954 ;; If there is a literal non-nil constant in the args to `or', throw away all | 954 ;; XEmacs; change to be more careful about discarding multiple values. |
955 ;; following forms. | 955 (let* ((memqueued (memq nil form)) |
956 (if (memq nil form) | 956 (trailing-nil (and (cdr memqueued) |
957 (setq form (delq nil (copy-sequence form)))) | 957 (equal '(nil) (last form)))) |
958 (let ((rest form)) | 958 rest) |
959 ;; A trailing nil indicates to discard multiple values, and we need to | |
960 ;; respect that: | |
961 (when (and memqueued (cdr memqueued)) | |
962 (setq form (delq nil (copy-sequence form))) | |
963 (when trailing-nil | |
964 (setcdr (last form) '(nil)))) | |
965 (setq rest form) | |
966 ;; If there is a literal non-nil constant in the args to `or', throw | |
967 ;; away all following forms. We can do this because a literal non-nil | |
968 ;; constant cannot be multiple. | |
959 (while (cdr (setq rest (cdr rest))) | 969 (while (cdr (setq rest (cdr rest))) |
960 (if (byte-compile-trueconstp (car rest)) | 970 (if (byte-compile-trueconstp (car rest)) |
961 (setq form (copy-sequence form) | 971 (setq form (copy-sequence form) |
962 rest (setcdr (memq (car rest) form) nil)))) | 972 rest (setcdr (memq (car rest) form) nil)))) |
963 (if (cdr (cdr form)) | 973 (if (cdr (cdr form)) |
976 (cond | 986 (cond |
977 ((null clauses) nil) | 987 ((null clauses) nil) |
978 ((consp (car clauses)) | 988 ((consp (car clauses)) |
979 (nconc | 989 (nconc |
980 (case (length (car clauses)) | 990 (case (length (car clauses)) |
981 (1 `(or ,(nth 0 (car clauses)))) | 991 (1 (if (cdr clauses) |
992 `(or ,(nth 0 (car clauses))) | |
993 ;; XEmacs: don't pass any multiple values back: | |
994 `(or ,(nth 0 (car clauses)) nil))) | |
982 (2 `(if ,(nth 0 (car clauses)) ,(nth 1 (car clauses)))) | 995 (2 `(if ,(nth 0 (car clauses)) ,(nth 1 (car clauses)))) |
983 (t `(if ,(nth 0 (car clauses)) (progn ,@(cdr (car clauses)))))) | 996 (t `(if ,(nth 0 (car clauses)) (progn ,@(cdr (car clauses)))))) |
984 (when (cdr clauses) (list (byte-optimize-cond-1 (cdr clauses)))))) | 997 (when (cdr clauses) (list (byte-optimize-cond-1 (cdr clauses)))))) |
985 (t (error "malformed cond clause %s" (car clauses))))) | 998 (t (error "malformed cond clause %s" (car clauses))))) |
986 | 999 |