XEmacs 21.2.47 (Zephir).

[chise/xemacs-chise.git.1] / lisp / byte-optimize.el

diff --git a/lisp/byte-optimize.el b/lisp/byte-optimize.el
index b6c1daa..dad9de8 100644 (file)
--- a/lisp/byte-optimize.el
+++ b/lisp/byte-optimize.el
@@ -473,12 +473,12 @@
                 (if (and (cdr form) (null backwards))
                     (byte-compile-log
                      "  all subforms of %s called for effect; deleted" form))
-                (and backwards
-                      ;; Now optimize the rest of the forms. We need the return
-                      ;; values. We already did the car.
-                      (setcdr backwards
-                              (mapcar 'byte-optimize-form (cdr backwards)))
-                     (cons fn (nreverse backwards))))
+                (when backwards
+                  ;; Now optimize the rest of the forms. We need the return
+                  ;; values. We already did the car.
+                  (setcdr backwards
+                          (mapcar 'byte-optimize-form (cdr backwards))))
+                (cons fn (nreverse backwards)))
             (cons fn (mapcar 'byte-optimize-form (cdr form)))))
 
          ((eq fn 'interactive)
@@ -729,9 +729,15 @@
       (decf (nth 1 form) last)
       (butlast form))
 
-     ;; (- 0 x ...)  -->  (- (- x) ...)
-     ((and (eq 0 (nth 1 form)) (>= (length form) 3))
-      `(- (- ,(nth 2 form)) ,@(nthcdr 3 form)))
+     ;; (- 0 ...) -->
+     ((eq 0 (nth 1 form))
+      (case (length form)
+       ;; (- 0) --> 0
+       (2 0)
+       ;; (- 0 x)  -->  (- x)
+       (3 `(- ,(nth 2 form)))
+       ;; (- 0 x y ...)  -->  (- (- x) y ...)
+       (t `(- (- ,(nth 2 form)) ,@(nthcdr 3 form)))))
 
      (t (byte-optimize-predicate form)))))
 
@@ -939,41 +945,23 @@
        (byte-optimize-predicate form)
       (nth 1 form))))
 
+;;; For the byte optimizer, `cond' is just overly sweet syntactic sugar.
+;;; So we rewrite (cond ...) in terms of `if' and `or',
+;;; which are easier to optimize.
 (defun byte-optimize-cond (form)
-  ;; if any clauses have a literal nil as their test, throw them away.
-  ;; if any clause has a literal non-nil constant as its test, throw
-  ;; away all following clauses.
-  (let (rest)
-    ;; This must be first, to reduce (cond (t ...) (nil)) to (progn t ...)
-    (while (setq rest (assq nil (cdr form)))
-      (setq form (delq rest (copy-sequence form))))
-    (if (memq nil (cdr form))
-       (setq form (delq nil (copy-sequence form))))
-    (setq rest form)
-    (while (setq rest (cdr rest))
-      (cond ((byte-compile-trueconstp (car-safe (car rest)))
-            (cond ((eq rest (cdr form))
-                   (setq form
-                         (if (cdr (car rest))
-                             (if (cdr (cdr (car rest)))
-                                 (cons 'progn (cdr (car rest)))
-                               (nth 1 (car rest)))
-                           (car (car rest)))))
-                  ((cdr rest)
-                   (setq form (copy-sequence form))
-                   (setcdr (memq (car rest) form) nil)))
-            (setq rest nil)))))
-  ;;
-  ;; Turn (cond (( <x> )) ... ) into (or <x> (cond ... ))
-  (if (eq 'cond (car-safe form))
-      (let ((clauses (cdr form)))
-       (if (and (consp (car clauses))
-                (null (cdr (car clauses))))
-           (list 'or (car (car clauses))
-                 (byte-optimize-cond
-                  (cons (car form) (cdr (cdr form)))))
-         form))
-    form))
+  (byte-optimize-cond-1 (cdr form)))
+
+(defun byte-optimize-cond-1 (clauses)
+  (cond
+   ((null clauses) nil)
+   ((consp (car clauses))
+    (nconc
+     (case (length (car clauses))
+       (1 `(or ,(nth 0 (car clauses))))
+       (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))))))
+   (t (error "malformed cond clause %s" (car clauses)))))
 
 (defun byte-optimize-if (form)
   ;; (if <true-constant> <then> <else...>) ==> <then>