Avoid Fortran-style floating-point optimization

When optimizing arithmetic operations, avoid optimizations that
are valid for mathematical numbers but invalid for floating-point.
For example, do not optimize (+ 1 v 0.5) to (+ v 1.5), as they may
not be the same due to rounding errors.  In general,
floating-point numbers cannot be constant-folded, since that would
make .elc files platform-dependent.
* lisp/emacs-lisp/byte-opt.el (byte-optimize-associative-math):
Do not optimize floats.
(byte-optimize-nonassociative-math, byte-optimize-approx-equal)
(byte-optimize-delay-constants-math, byte-compile-butlast)
(byte-optimize-logmumble):
Remove; no longer used.
(byte-optimize-minus): Do not optimize (- 0 x) to (- x).
(byte-optimize-multiply): Do not optimize (* -1 x) to (- x).
(byte-optimize-divide): Do not optimize (/ x -1) to (- x).
(logand, logior, logxor): Optimize with byte-optimize-predicate
instead of with byte-optimize-logmumble.
* test/lisp/emacs-lisp/bytecomp-tests.el:
(byte-opt-testsuite-arith-data): Add a couple of test cases.

diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 55343e1e3af391eea6814a99f2e444051d9ba5da..a5e0e2196448139c803e3021fdd1d3d7c683e159 100644 (file)
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -656,15 +656,15 @@
         ((not (symbolp form)) nil)
         ((null form))))
 
-;; If the function is being called with constant numeric args,
+;; If the function is being called with constant integer args,
 ;; evaluate as much as possible at compile-time.  This optimizer
-;; assumes that the function is associative, like + or *.
+;; assumes that the function is associative, like min or max.
 (defun byte-optimize-associative-math (form)
   (let ((args nil)
        (constants nil)
        (rest (cdr form)))
     (while rest
-      (if (numberp (car rest))
+      (if (integerp (car rest))
          (setq constants (cons (car rest) constants))
          (setq args (cons (car rest) args)))
       (setq rest (cdr rest)))
@@ -678,82 +678,7 @@
            (apply (car form) constants))
        form)))
 
-;; If the function is being called with constant numeric args,
-;; evaluate as much as possible at compile-time.  This optimizer
-;; assumes that the function satisfies
-;;   (op x1 x2 ... xn) == (op ...(op (op x1 x2) x3) ...xn)
-;; like - and /.
-(defun byte-optimize-nonassociative-math (form)
-  (if (or (not (numberp (car (cdr form))))
-         (not (numberp (car (cdr (cdr form))))))
-      form
-    (let ((constant (car (cdr form)))
-         (rest (cdr (cdr form))))
-      (while (numberp (car rest))
-       (setq constant (funcall (car form) constant (car rest))
-             rest (cdr rest)))
-      (if rest
-         (cons (car form) (cons constant rest))
-         constant))))
-
-;;(defun byte-optimize-associative-two-args-math (form)
-;;  (setq form (byte-optimize-associative-math form))
-;;  (if (consp form)
-;;      (byte-optimize-two-args-left form)
-;;      form))
-
-;;(defun byte-optimize-nonassociative-two-args-math (form)
-;;  (setq form (byte-optimize-nonassociative-math form))
-;;  (if (consp form)
-;;      (byte-optimize-two-args-right form)
-;;      form))
-
-(defun byte-optimize-approx-equal (x y)
-  (<= (* (abs (- x y)) 100) (abs (+ x y))))
-
-;; Collect all the constants from FORM, after the STARTth arg,
-;; and apply FUN to them to make one argument at the end.
-;; For functions that can handle floats, that optimization
-;; can be incorrect because reordering can cause an overflow
-;; that would otherwise be avoided by encountering an arg that is a float.
-;; We avoid this problem by (1) not moving float constants and
-;; (2) not moving anything if it would cause an overflow.
-(defun byte-optimize-delay-constants-math (form start fun)
-  ;; Merge all FORM's constants from number START, call FUN on them
-  ;; and put the result at the end.
-  (let ((rest (nthcdr (1- start) form))
-       (orig form)
-       ;; t means we must check for overflow.
-       (overflow (memq fun '(+ *))))
-    (while (cdr (setq rest (cdr rest)))
-      (if (integerp (car rest))
-         (let (constants)
-           (setq form (copy-sequence form)
-                 rest (nthcdr (1- start) form))
-           (while (setq rest (cdr rest))
-             (cond ((integerp (car rest))
-                    (setq constants (cons (car rest) constants))
-                    (setcar rest nil))))
-           ;; If necessary, check now for overflow
-           ;; that might be caused by reordering.
-           (if (and overflow
-                    ;; We have overflow if the result of doing the arithmetic
-                    ;; on floats is not even close to the result
-                    ;; of doing it on integers.
-                    (not (byte-optimize-approx-equal
-                           (apply fun (mapcar 'float constants))
-                           (float (apply fun constants)))))
-               (setq form orig)
-             (setq form (nconc (delq nil form)
-                               (list (apply fun (nreverse constants)))))))))
-    form))
-
-(defsubst byte-compile-butlast (form)
-  (nreverse (cdr (reverse form))))
-
 (defun byte-optimize-plus (form)
-  ;; Don't call `byte-optimize-delay-constants-math' (bug#1334).
-  ;;(setq form (byte-optimize-delay-constants-math form 1 '+))
   (if (memq 0 form) (setq form (delq 0 (copy-sequence form))))
   ;; For (+ constants...), byte-optimize-predicate does the work.
   (when (memq nil (mapcar 'numberp (cdr form)))
@@ -767,26 +692,19 @@
            (setq integer (nth 1 form) other (nth 2 form))
          (setq integer (nth 2 form) other (nth 1 form)))
        (setq form
-             (list (if (eq integer 1) '1+ '1-) other))))
-     ;; Here, we could also do
-     ;;  (+ x y ... 1) --> (1+ (+ x y ...))
-     ;;  (+ x y ... -1) --> (1- (+ x y ...))
-     ;; The resulting bytecode is smaller, but is it faster? -- cyd
-     ))
+             (list (if (eq integer 1) '1+ '1-) other))))))
   (byte-optimize-predicate form))
 
 (defun byte-optimize-minus (form)
-  ;; Don't call `byte-optimize-delay-constants-math' (bug#1334).
-  ;;(setq form (byte-optimize-delay-constants-math form 2 '+))
   ;; Remove zeros.
   (when (and (nthcdr 3 form)
             (memq 0 (cddr form)))
     (setq form (nconc (list (car form) (cadr form))
                      (delq 0 (copy-sequence (cddr form)))))
-    ;; After the above, we must turn (- x) back into (- x 0)
+    ;; After the above, we must turn (- x) back into (- x 0).
     (or (cddr form)
        (setq form (nconc form (list 0)))))
-  ;; For (- constants..), byte-optimize-predicate does the work.
+  ;; For (- constants...), byte-optimize-predicate does the work.
   (when (memq nil (mapcar 'numberp (cdr form)))
     (cond
      ;; (- x 1) --> (1- x)
@@ -794,71 +712,25 @@
       (setq form (list '1- (nth 1 form))))
      ;; (- x -1) --> (1+ x)
      ((equal (nthcdr 2 form) '(-1))
-      (setq form (list '1+ (nth 1 form))))
-     ;; (- 0 x) --> (- x)
-     ((and (eq (nth 1 form) 0)
-          (= (length form) 3))
-      (setq form (list '- (nth 2 form))))
-     ;; Here, we could also do
-     ;;  (- x y ... 1) --> (1- (- x y ...))
-     ;;  (- x y ... -1) --> (1+ (- x y ...))
-     ;; The resulting bytecode is smaller, but is it faster? -- cyd
-     ))
+      (setq form (list '1+ (nth 1 form))))))
   (byte-optimize-predicate form))
 
 (defun byte-optimize-multiply (form)
-  (setq form (byte-optimize-delay-constants-math form 1 '*))
-  ;; For (* constants..), byte-optimize-predicate does the work.
-  (when (memq nil (mapcar 'numberp (cdr form)))
-    ;; After `byte-optimize-predicate', if there is a INTEGER constant
-    ;; in FORM, it is in the last element.
-    (let ((last (car (reverse (cdr form)))))
-      (cond
-       ;; Would handling (* ... 0) here cause floating point errors?
-       ;; See bug#1334.
-       ((eq 1 last) (setq form (byte-compile-butlast form)))
-       ((eq -1 last)
-       (setq form (list '- (if (nthcdr 3 form)
-                               (byte-compile-butlast form)
-                             (nth 1 form))))))))
+  (if (memq 1 form) (setq form (delq 1 (copy-sequence form))))
+  ;; For (* integers..), byte-optimize-predicate does the work.
   (byte-optimize-predicate form))
 
 (defun byte-optimize-divide (form)
-  (setq form (byte-optimize-delay-constants-math form 2 '*))
-  ;; After `byte-optimize-predicate', if there is a INTEGER constant
-  ;; in FORM, it is in the last element.
-  (let ((last (car (reverse (cdr (cdr form))))))
-    (cond
-     ;; Runtime error (leave it intact).
-     ((or (null last)
-         (eq last 0)
-         (memql 0.0 (cddr form))))
-     ;; No constants in expression
-     ((not (numberp last)))
-     ;; For (* constants..), byte-optimize-predicate does the work.
-     ((null (memq nil (mapcar 'numberp (cdr form)))))
-     ;; (/ x y.. 1) --> (/ x y..)
-     ((and (eq last 1) (nthcdr 3 form))
-      (setq form (byte-compile-butlast form)))
-     ;; (/ x -1), (/ x .. -1)  --> (- x), (- (/ x ..))
-     ((eq last -1)
-      (setq form (list '- (if (nthcdr 3 form)
-                             (byte-compile-butlast form)
-                           (nth 1 form)))))))
+  ;; Remove 1s.
+  (when (and (nthcdr 3 form)
+            (memq 1 (cddr form)))
+    (setq form (nconc (list (car form) (cadr form))
+                     (delq 1 (copy-sequence (cddr form)))))
+    ;; After the above, we must turn (/ x) back into (/ x 1).
+    (or (cddr form)
+       (setq form (nconc form (list 1)))))
   (byte-optimize-predicate form))
 
-(defun byte-optimize-logmumble (form)
-  (setq form (byte-optimize-delay-constants-math form 1 (car form)))
-  (byte-optimize-predicate
-   (cond ((memq 0 form)
-         (setq form (if (eq (car form) 'logand)
-                        (cons 'progn (cdr form))
-                      (delq 0 (copy-sequence form)))))
-        ((and (eq (car-safe form) 'logior)
-              (memq -1 form))
-         (cons 'progn (cdr form)))
-        (form))))
-
 
 (defun byte-optimize-binary-predicate (form)
   (cond
@@ -923,9 +795,9 @@
 (put 'string< 'byte-optimizer 'byte-optimize-predicate)
 (put 'string-lessp 'byte-optimizer 'byte-optimize-predicate)
 
-(put 'logand 'byte-optimizer 'byte-optimize-logmumble)
-(put 'logior 'byte-optimizer 'byte-optimize-logmumble)
-(put 'logxor 'byte-optimizer 'byte-optimize-logmumble)
+(put 'logand 'byte-optimizer 'byte-optimize-predicate)
+(put 'logior 'byte-optimizer 'byte-optimize-predicate)
+(put 'logxor 'byte-optimizer 'byte-optimize-predicate)
 (put 'lognot 'byte-optimizer 'byte-optimize-predicate)
 
 (put 'car 'byte-optimizer 'byte-optimize-predicate)

diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el
index 6ae7cdb9f9c3e4cf78203dced957fb0fb1962611..7330c676140e850ef07fae878f6549cd6777fcce 100644 (file)
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -38,8 +38,7 @@
     (let ((a 3) (b 2) (c 1.0))                     (/ a b c))
     (let ((a (+ 1 (expt 2 -64))) (b (expt 2 -65))) (+ a -1 b))
     (let ((a (+ 1 (expt 2 -64))) (b (expt 2 -65))) (- a 1 (- b)))
-    ;; This fails.  Should it be a bug?
-    ;; (let ((a (expt 2 -1074)) (b 0.125))                (* a 8 b))
+    (let ((a (expt 2 -1074)) (b 0.125))                   (* a 8 b))
     (let ((a 1.0))                                (* a 0))
     (let ((a 1.0))                                (* a 2.0 0))
     (let ((a 1.0))                                (/ 0 a))
@@ -244,6 +243,9 @@
     (let ((a 3) (b 2) (c 1.0)) (/ a b c 0))
     (let ((a 3) (b 2) (c 1.0)) (/ a b c 1))
     (let ((a 3) (b 2) (c 1.0)) (/ a b c -1))
+
+    (let ((a t)) (logand 0 a))
+
     ;; Test switch bytecode
     (let ((a 3)) (cond ((eq a 1) 'one) ((eq a 2) 'two) ((eq a 3) 'three) (t t)))
     (let ((a 'three)) (cond ((eq a 'one) 1) ((eq a 2) 'two) ((eq a 'three) 3)