X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=blobdiff_plain;f=lisp%2Fbyte-optimize.el;h=dad9de8f5e03f14766a8bf59d48afb3cb0f23b79;hp=b6c1daaf16e3a20165b7e5bebb2c8a01e869a9fd;hb=efdb31fd4c8db81d2414c32d491f1bf994263c74;hpb=82f6d62ee211b1d36e8f45fed3ee3edde82b6916

diff --git a/lisp/byte-optimize.el b/lisp/byte-optimize.el
index b6c1daa..dad9de8 100644
--- 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>