Mercurial > hg > xemacs-beta

diff lisp/byte-optimize.el @ 4686:cdabd56ce1b5

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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
line wrap: on
line diff
--- a/lisp/byte-optimize.el	Wed Sep 02 20:38:14 2009 -0600
+++ b/lisp/byte-optimize.el	Sun Sep 06 19:36:02 2009 +0100
@@ -436,7 +436,7 @@
 	       (cons 'prog1
 		     (cons (byte-optimize-form (nth 1 form) for-effect)
 			   (byte-optimize-body (cdr (cdr form)) t)))
-	     (byte-optimize-form (nth 1 form) for-effect)))
+	     (byte-optimize-form `(or ,(nth 1 form) nil) for-effect)))
 	  ((eq fn 'prog2)
 	   (cons 'prog2
 	     (cons (byte-optimize-form (nth 1 form) t)
@@ -950,12 +950,22 @@
 	((byte-optimize-predicate form))))
 
 (defun byte-optimize-or (form)
-  ;; Throw away nil's, and simplify if less than 2 args.
-  ;; If there is a literal non-nil constant in the args to `or', throw away all
-  ;; following forms.
-  (if (memq nil form)
-      (setq form (delq nil (copy-sequence form))))
-  (let ((rest form))
+  ;; Throw away unneeded nils, and simplify if less than 2 args.
+  ;; XEmacs; change to be more careful about discarding multiple values. 
+  (let* ((memqueued (memq nil form))
+         (trailing-nil (and (cdr memqueued)
+                            (equal '(nil) (last form))))
+         rest)
+    ;; A trailing nil indicates to discard multiple values, and we need to
+    ;; respect that:
+    (when (and memqueued (cdr memqueued))
+      (setq form (delq nil (copy-sequence form)))
+      (when trailing-nil
+        (setcdr (last form) '(nil))))
+    (setq rest form)
+    ;; If there is a literal non-nil constant in the args to `or', throw
+    ;; away all following forms. We can do this because a literal non-nil
+    ;; constant cannot be multiple.
     (while (cdr (setq rest (cdr rest)))
       (if (byte-compile-trueconstp (car rest))
 	  (setq form (copy-sequence form)
@@ -978,7 +988,10 @@
    ((consp (car clauses))
     (nconc
      (case (length (car clauses))
-       (1 `(or ,(nth 0 (car clauses))))
+       (1 (if (cdr clauses)
+              `(or ,(nth 0 (car clauses)))
+            ;; XEmacs: don't pass any multiple values back:
+            `(or ,(nth 0 (car clauses)) nil)))
        (2 `(if ,(nth 0 (car clauses)) ,(nth 1 (car clauses))))
        (t `(if ,(nth 0 (car clauses)) (progn ,@(cdr (car clauses))))))
      (when (cdr clauses) (list (byte-optimize-cond-1 (cdr clauses))))))