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