2:15 p.m.
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1251715172 -3600
# Node ID 4d30614a3649565f34d17e3fd9035f0e93db94a8
# Parent 15c42a3f4065c6b9c89832983ae591d03d159cde
Fix various small issues with the multiple-value implementation.
lisp/ChangeLog addition:
2009-08-31 Aidan Kehoe <kehoea(a)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(a)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!
tests/ChangeLog addition:
2009-08-31 Aidan Kehoe <kehoea(a)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.)
diff -r 15c42a3f4065 -r 4d30614a3649 lisp/ChangeLog
--- a/lisp/ChangeLog Sat Aug 29 22:37:50 2009 +0800
+++ b/lisp/ChangeLog Mon Aug 31 11:39:32 2009 +0100
＠＠ -1,3 +1,29 ＠＠
+2009-08-31 Aidan Kehoe <kehoea(a)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.
+
2009-08-27 Aidan Kehoe <kehoea(a)parhasard.net>
* cl.el (bytecomp-load-hook): New.
diff -r 15c42a3f4065 -r 4d30614a3649 lisp/byte-optimize.el
--- a/lisp/byte-optimize.el Sat Aug 29 22:37:50 2009 +0800
+++ b/lisp/byte-optimize.el Mon Aug 31 11:39:32 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))))))
diff -r 15c42a3f4065 -r 4d30614a3649 lisp/bytecomp.el
--- a/lisp/bytecomp.el Sat Aug 29 22:37:50 2009 +0800
+++ b/lisp/bytecomp.el Mon Aug 31 11:39:32 2009 +0100
＠＠ -1816,7 +1816,7 ＠＠
(defun byte-compile-insert-header (filename byte-compile-inbuffer
byte-compile-outbuffer)
(set-buffer byte-compile-inbuffer)
- (let (checks-string comments)
+ (let (comments)
(set-buffer byte-compile-outbuffer)
(delete-region 1 (1+ byte-compile-checks-and-comments-space))
(goto-char 1)
＠＠ -1840,17 +1840,34 ＠＠
(insert (format ";;;###coding system: %s\n"
(coding-system-name buffer-file-coding-system))))
(insert (format
- "\n(or %s\n (error \"Loading this file requires: %s\"))\n"
- (setq checks-string
- (let ((print-readably t))
- (prin1-to-string (if (> (length
- byte-compile-checks-on-load)
- 1)
- (cons 'and
- (reverse
- byte-compile-checks-on-load))
- (car byte-compile-checks-on-load)))))
- checks-string))
+ "\n(or %s\n (error \"Loading this file requires %s\"))\n"
+ (let ((print-readably t))
+ (prin1-to-string (if (> (length
+ byte-compile-checks-on-load)
+ 1)
+ (cons 'and
+ (setq byte-compile-checks-on-load
+ (nreverse
+ byte-compile-checks-on-load)))
+ (car byte-compile-checks-on-load))))
+ (loop
+ for check in byte-compile-checks-on-load
+ with seen-first = nil
+ with res = ""
+ do
+ (if seen-first
+ (setq res (concat res ", "))
+ (setq seen-first t))
+ ;; Print featurep calls differently:
+ (if (and (eq (car check) 'featurep)
+ (eq (car (second check)) 'quote)
+ (symbolp (second (second check))))
+ (setq res (concat res
+ (symbol-name (second (second check)))))
+ (setq res (concat res
+ (let ((print-readably t))
+ (prin1-to-string check)))))
+ finally return res)))
(setq comments
(with-string-as-buffer-contents ""
(insert "\n;;; compiled by "
＠＠ -2176,13 +2193,29 ＠＠
(eval form)
(byte-compile-keep-pending form 'byte-compile-normal-call))
-(put 'progn 'byte-hunk-handler 'byte-compile-file-form-progn)
-(put 'prog1 'byte-hunk-handler 'byte-compile-file-form-progn)
-(put 'prog2 'byte-hunk-handler 'byte-compile-file-form-progn)
-(defun byte-compile-file-form-progn (form)
- (mapcar 'byte-compile-file-form (cdr form))
- ;; Return nil so the forms are not output twice.
- nil)
+;; XEmacs change: be careful about multiple values with these three forms.
+(put 'progn 'byte-hunk-handler
+ #'(lambda (form)
+ (mapc 'byte-compile-file-form (cdr form))
+ ;; Return nil so the forms are not output twice.
+ nil))
+
+(put 'prog1 'byte-hunk-handler
+ #'(lambda (form)
+ (when (first form)
+ (byte-compile-file-form `(or ,(first form) nil))
+ (mapc 'byte-compile-file-form (cdr form))
+ nil)))
+
+(put 'prog2 'byte-hunk-handler
+ #'(lambda (form)
+ (when (first form)
+ (byte-compile-file-form (first form))
+ (when (second form)
+ (setq form (cdr form))
+ (byte-compile-file-form `(or ,(first form) nil))
+ (mapc 'byte-compile-file-form (cdr form))
+ nil))))
;; This handler is not necessary, but it makes the output from dont-compile
;; and similar macros cleaner.
＠＠ -3677,7 +3710,7 ＠＠
(defun byte-compile-prog1 (form)
(setq form (cdr form))
;; #'prog1 never returns multiple values:
- (byte-compile-form-do-effect (list 'values (pop form)))
+ (byte-compile-form-do-effect `(or ,(pop form) nil))
(byte-compile-body form t))
(defun byte-compile-multiple-value-prog1 (form)
＠＠ -3686,9 +3719,11 ＠＠
(byte-compile-body form t))
(defun byte-compile-values (form)
- (if (and (= 2 (length form))
- (byte-compile-constp (second form)))
- (byte-compile-form-do-effect (second form))
+ (if (= 2 (length form))
+ (if (byte-compile-constp (second form))
+ (byte-compile-form-do-effect (second form))
+ ;; #'or compiles to bytecode, #'values doesn't:
+ (byte-compile-form-do-effect `(or ,(second form) nil)))
(byte-compile-normal-call form)))
(defun byte-compile-values-list (form)
＠＠ -3705,7 +3740,7 ＠＠
(setq form (cdr form))
(byte-compile-form (pop form) t)
;; #'prog2 never returns multiple values:
- (byte-compile-form-do-effect (list 'values (pop form)))
+ (byte-compile-form-do-effect `(or ,(pop form) nil))
(byte-compile-body form t))
(defmacro byte-compile-goto-if (cond discard tag)
diff -r 15c42a3f4065 -r 4d30614a3649 src/ChangeLog
--- a/src/ChangeLog Sat Aug 29 22:37:50 2009 +0800
+++ b/src/ChangeLog Mon Aug 31 11:39:32 2009 +0100
＠＠ -1,3 +1,11 ＠＠
+2009-08-31 Aidan Kehoe <kehoea(a)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!
+
2009-08-24 Jerry James <james(a)xemacs.org>
* lisp.h (INT_64_BIT): define as __int64 on WIN32.
diff -r 15c42a3f4065 -r 4d30614a3649 src/eval.c
--- a/src/eval.c Sat Aug 29 22:37:50 2009 +0800
+++ b/src/eval.c Mon Aug 31 11:39:32 2009 +0100
＠＠ -838,7 +838,7 ＠＠
(args))
{
/* This function can GC */
- REGISTER Lisp_Object val;
+ Lisp_Object val = Qnil;
LIST_LOOP_3 (arg, args, tail)
{
＠＠ -870,7 +870,7 ＠＠
(args))
{
/* This function can GC */
- REGISTER Lisp_Object val = Qt;
+ Lisp_Object val = Qt;
LIST_LOOP_3 (arg, args, tail)
{
diff -r 15c42a3f4065 -r 4d30614a3649 tests/ChangeLog
--- a/tests/ChangeLog Sat Aug 29 22:37:50 2009 +0800
+++ b/tests/ChangeLog Mon Aug 31 11:39:32 2009 +0100
＠＠ -1,3 +1,13 ＠＠
+2009-08-31 Aidan Kehoe <kehoea(a)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.)
+
2009-08-16 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/lisp-tests.el (foo):
diff -r 15c42a3f4065 -r 4d30614a3649 tests/automated/lisp-tests.el
--- a/tests/automated/lisp-tests.el Sat Aug 29 22:37:50 2009 +0800
+++ b/tests/automated/lisp-tests.el Mon Aug 31 11:39:32 2009 +0100
＠＠ -1475,11 +1475,8 ＠＠
first one-round-result))
(Assert (equal one-round-result (multiple-value-list
(round first 1)))
- (format "checking (round %S 1) gives %S, types %S, actual %S, types %S"
- first one-round-result (mapcar #'type-of one-round-result)
- (multiple-value-list (round first 1))
- (mapcar #'type-of (multiple-value-list (round first 1)))))
-
+ (format "checking (round %S 1) gives %S"
+ first one-round-result))
(Check-Error arith-error (round first 0))
(Check-Error arith-error (round first 0.0))
(Assert (equal two-round-result (multiple-value-list
＠＠ -1949,7 +1946,7 ＠＠
(multiple-value-function-returning-t ()
(values t pi e degrees-to-radians radians-to-degrees))
(multiple-value-function-returning-nil ()
- (values t pi e radians-to-degrees degrees-to-radians))
+ (values nil pi e radians-to-degrees degrees-to-radians))
(function-throwing-multiple-values ()
(let* ((listing '(0 3 4 nil "string" symbol))
(tail listing)
＠＠ -2051,7 +2048,7 ＠＠
(cond ((multiple-value-function-returning-t))))))
"Checking cond doesn't pass back multiple values in tests.")
(Assert
- (equal (list t pi e degrees-to-radians radians-to-degrees)
+ (equal (list nil pi e radians-to-degrees degrees-to-radians)
(multiple-value-list
(cond (t (multiple-value-function-returning-nil)))))
"Checking cond passes back multiple values in clauses.")
＠＠ -2069,10 +2066,28 ＠＠
(multiple-value-list
(catch 'VoN61Lo4Y (function-throwing-multiple-values)))))
(Assert
- (equal (list t pi e radians-to-degrees degrees-to-radians)
+ (equal (list t pi e degrees-to-radians radians-to-degrees)
(multiple-value-list
(loop
for eye in `(a b c d ,e f g ,nil ,pi)
do (when (null eye)
(return (multiple-value-function-returning-t))))))
- "Checking #'loop passes back multiple values correctly."))
+ "Checking #'loop passes back multiple values correctly.")
+ (Assert
+ (null (or))
+ "Checking #'or behaves correctly with zero arguments.")
+ (Assert
+ (eq t (and))
+ "Checking #'and behaves correctly with zero arguments.")
+ ;; This bug was here before the full multiple-value functionality
+ ;; was introduced (check it with (floor* pi) if you're
+ ;; curious). #'setf works, though, which is what most people are
+ ;; interested in. If you know the setf-method code better than I do,
+ ;; please post a patch; otherwise this is going to the back of the
+ ;; queue of things to do. I didn't break it :-) Aidan Kehoe, Mon Aug
+ ;; 31 10:45:50 GMTDT 2009.
+ (Known-Bug-Expect-Error
+ void-variable
+ (letf (((values three one-four-one-five-nine) (floor pi)))
+ (* three one-four-one-five-nine))))
+
--
¿Dónde estará ahora mi sobrino Yoghurtu Nghe, que tuvo que huir
precipitadamente de la aldea por culpa de la escasez de rinocerontes?
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches