1 new commit in XEmacs: https://bitbucket.org/xemacs/xemacs/changeset/ae2fdb1fd9e0/ changeset: ae2fdb1fd9e0 user: kehoea date: 2012-05-01 13:43:22 summary: Improve for-effect handling in a few places, lisp/ lisp/ChangeLog addition: 2012-05-01 Aidan Kehoe <kehoea(a)parhasard.net&gt; * byte-optimize.el (byte-optimize-form-code-walker): * byte-optimize.el (byte-optimize-or): Improve handling of for-effect here; we don't need to worry about discarding multiple values when for-effect is non-nil, this applies to both #'prog1 and #'or. * bytecomp.el (progn): * bytecomp.el (byte-compile-file-form-progn): New. Put back this function, since it's for-effect there's no need to worry about passing back multiple values. * cl-macs.el (cl-pop2): * cl-macs.el (cl-do-pop): * cl-macs.el (remf): * cl.el (pop): Expand to (prog1 (car-safe PLACE) (setq PLACE (cdr PLACE))) in all these macros, since that optimizes better (especially for-effect handling) when byte-compile-delete-errors is nil. affected #: 5 files diff -r 7fa8667cdaa732afd502dd72f088e5f3d9e00478 -r ae2fdb1fd9e0d4b5152eabf54d239866f60d55e6 lisp/ChangeLog --- a/lisp/ChangeLog +++ b/lisp/ChangeLog ＠＠ -1,3 +1,22 ＠＠ +2012-05-01 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * byte-optimize.el (byte-optimize-form-code-walker): + * byte-optimize.el (byte-optimize-or): + Improve handling of for-effect here; we don't need to worry about + discarding multiple values when for-effect is non-nil, this + applies to both #'prog1 and #'or. + * bytecomp.el (progn): + * bytecomp.el (byte-compile-file-form-progn): New. + Put back this function, since it's for-effect there's no need to + worry about passing back multiple values. + * cl-macs.el (cl-pop2): + * cl-macs.el (cl-do-pop): + * cl-macs.el (remf): + * cl.el (pop): + Expand to (prog1 (car-safe PLACE) (setq PLACE (cdr PLACE))) in all + these macros, since that optimizes better (especially for-effect + handling) when byte-compile-delete-errors is nil. + 2012-04-23 Michael Sperber <mike(a)xemacs.org&gt; * bytecomp.el (batch-byte-recompile-directory): Accept an optional diff -r 7fa8667cdaa732afd502dd72f088e5f3d9e00478 -r ae2fdb1fd9e0d4b5152eabf54d239866f60d55e6 lisp/byte-optimize.el --- a/lisp/byte-optimize.el +++ b/lisp/byte-optimize.el ＠＠ -431,7 +431,7 ＠＠ (byte-optimize-form (nth 1 form) for-effect))) ((eq fn 'prog1) (if (cdr (cdr form)) - (cons 'prog1 + (cons (if for-effect 'progn 'prog1) (cons (byte-optimize-form (nth 1 form) for-effect) (byte-optimize-body (cdr (cdr form)) t))) (byte-optimize-form `(or ,(nth 1 form) nil) for-effect))) ＠＠ -537,6 +537,12 ＠＠ (setq tmp (byte-optimize-side-effect-free-p form)) (or byte-compile-delete-errors (eq tmp 'error-free) + ;; XEmacs; GNU handles the expansion of (pop foo) specially + ;; here. We changed the macro to expand to (prog1 (car-safe + ;; PLACE) (setq PLACE (cdr PLACE))) , which has the same + ;; effect. (This only matters when + ;; byte-compile-delete-errors is nil, which is usually true + ;; for GNU and usually false for XEmacs.) (progn (byte-compile-warn "%s called for effect" (prin1-to-string form)) ＠＠ -947,20 +953,17 ＠＠ (defun byte-optimize-or (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. + (if (memq nil form) + (setq form (remove* nil form + ;; A trailing nil indicates to discard multiple + ;; values, and we need to respect that. No need if + ;; this is for-effect, though, multiple values + ;; will be discarded anyway. +:end (if (not for-effect) (1- (length 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. + (let ((rest form)) (while (cdr (setq rest (cdr rest))) (if (byte-compile-trueconstp (car rest)) (setq form (copy-sequence form) diff -r 7fa8667cdaa732afd502dd72f088e5f3d9e00478 -r ae2fdb1fd9e0d4b5152eabf54d239866f60d55e6 lisp/bytecomp.el --- a/lisp/bytecomp.el +++ b/lisp/bytecomp.el ＠＠ -2411,29 +2411,13 ＠＠ (eval form) (byte-compile-keep-pending form 'byte-compile-normal-call)) -;; 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)))) +(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) + (mapc 'byte-compile-file-form (cdr form)) + ;; Return nil so the forms are not output twice. + nil) ;; This handler is not necessary, but it makes the output from dont-compile ;; and similar macros cleaner. diff -r 7fa8667cdaa732afd502dd72f088e5f3d9e00478 -r ae2fdb1fd9e0d4b5152eabf54d239866f60d55e6 lisp/cl-macs.el --- a/lisp/cl-macs.el +++ b/lisp/cl-macs.el ＠＠ -46,7 +46,7 ＠＠ ;;; Code: (defmacro cl-pop2 (place) - (list 'prog1 (list 'car (list 'cdr place)) + (list 'prog1 (list 'car-safe (list 'cdr-safe place)) (list 'setq place (list 'cdr (list 'cdr place))))) (put 'cl-pop2 'edebug-form-spec 'edebug-sexps) ＠＠ -2456,14 +2456,14 ＠＠ ;;;###autoload (defun cl-do-pop (place) (if (cl-simple-expr-p place) - (list 'prog1 (list 'car place) (list 'setf place (list 'cdr place))) + (list 'prog1 (list 'car-safe place) (list 'setf place (list 'cdr place))) (let* ((method (cl-setf-do-modify place t)) (temp (gensym "--pop--"))) (list 'let* (append (car method) (list (list temp (nth 2 method)))) (list 'prog1 - (list 'car temp) + (list 'car-safe temp) (cl-setf-do-store (nth 1 method) (list 'cdr temp))))))) ;;;###autoload diff -r 7fa8667cdaa732afd502dd72f088e5f3d9e00478 -r ae2fdb1fd9e0d4b5152eabf54d239866f60d55e6 lisp/cl.el --- a/lisp/cl.el +++ b/lisp/cl.el ＠＠ -152,7 +152,7 ＠＠ careful about evaluating each argument only once and in the right order. PLACE may be a symbol, or any generalized variable allowed by `setf'." (if (symbolp place) - `(car (prog1 ,place (setq ,place (cdr ,place)))) + `(car-safe (prog1 ,place (setq ,place (cdr ,place)))) (cl-do-pop place))) (defmacro push (newelt listname) Repository URL: https://bitbucket.org/xemacs/xemacs/ -- This is a commit notification from bitbucket.org. You are receiving this because you have the service enabled, addressing the recipient of this email. _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches