[COMMIT] Improve for-effect handling in a few places, lisp/

APPROVE COMMIT NOTE: This patch has been committed. # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net&gt; # Date 1335872602 -3600 # Node ID ae2fdb1fd9e0d4b5152eabf54d239866f60d55e6 # Parent 7fa8667cdaa732afd502dd72f088e5f3d9e00478 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. diff -r 7fa8667cdaa7 -r ae2fdb1fd9e0 lisp/ChangeLog --- a/lisp/ChangeLog Mon Apr 23 10:06:39 2012 +0200 +++ b/lisp/ChangeLog Tue May 01 12:43:22 2012 +0100 ＠＠ -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 7fa8667cdaa7 -r ae2fdb1fd9e0 lisp/byte-optimize.el --- a/lisp/byte-optimize.el Mon Apr 23 10:06:39 2012 +0200 +++ b/lisp/byte-optimize.el Tue May 01 12:43:22 2012 +0100 ＠＠ -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 7fa8667cdaa7 -r ae2fdb1fd9e0 lisp/bytecomp.el --- a/lisp/bytecomp.el Mon Apr 23 10:06:39 2012 +0200 +++ b/lisp/bytecomp.el Tue May 01 12:43:22 2012 +0100 ＠＠ -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 7fa8667cdaa7 -r ae2fdb1fd9e0 lisp/cl-macs.el --- a/lisp/cl-macs.el Mon Apr 23 10:06:39 2012 +0200 +++ b/lisp/cl-macs.el Tue May 01 12:43:22 2012 +0100 ＠＠ -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 7fa8667cdaa7 -r ae2fdb1fd9e0 lisp/cl.el --- a/lisp/cl.el Mon Apr 23 10:06:39 2012 +0200 +++ b/lisp/cl.el Tue May 01 12:43:22 2012 +0100 ＠＠ -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) -- ‘Iodine deficiency was endemic in parts of the UK until, through what has been described as “an unplanned and accidental public health triumph”, iodine was added to cattle feed to improve milk production in the 1930s.’ (EN Pearce, Lancet, June 2011) _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches