diff lisp/byte-optimize.el @ 448:3078fd1074e8 r21-2-39

Import from CVS: tag r21-2-39
author cvs
date Mon, 13 Aug 2007 11:38:25 +0200
parents 1ccc32a20af4
children 3d3049ae1304
line wrap: on
line diff
--- a/lisp/byte-optimize.el	Mon Aug 13 11:37:23 2007 +0200
+++ b/lisp/byte-optimize.el	Mon Aug 13 11:38:25 2007 +0200
@@ -939,41 +939,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>