From 1dadff58e6d9b66662c6ef3ef692b6040c202160 Mon Sep 17 00:00:00 2001
From: Juan Jose Garcia Ripoll <jjgarcia@users.sourceforge.net>
Date: Wed, 14 Jul 2010 22:31:05 +0200
Subject: [PATCH] Sometimes in the list of forms, when simplifying, NIL and
 other atomic expressions get in. Ignore them in the type propagation phase.

---
 src/cmp/cmpprop.lsp | 33 ++++++++++++++++++---------------
 1 file changed, 18 insertions(+), 15 deletions(-)

diff --git a/src/cmp/cmpprop.lsp b/src/cmp/cmpprop.lsp
index a2c7c7137..d1b4db23b 100644
--- a/src/cmp/cmpprop.lsp
+++ b/src/cmp/cmpprop.lsp
@@ -25,24 +25,27 @@
       `(format *standard-output* ,string ,@args))))
 
 (defun p1propagate (form assumptions)
-  (let* ((*cmp-env* (c1form-env form))
-	 (name (c1form-name form))
-	 (propagator (gethash name *p1-dispatch-table*)))
-    (cond (propagator
-           (prop-message "~&;;; Entering type propagation for ~A" name)
-           (multiple-value-bind (new-type assumptions)
-               (apply propagator form assumptions (c1form-args form))
-	     (when assumptions
-	       (baboon :format-control "Non-empty assumptions found in P1PROPAGATE"))
-             (prop-message "~&;;; Propagating ~A gives type ~A" name
-			   new-type)
+  (unless form
+    (return-from p1propagate (values 'null assumptions)))
+  (when (c1form-p form)
+    (let* ((*cmp-env* (c1form-env form))
+           (name (c1form-name form))
+           (propagator (gethash name *p1-dispatch-table*)))
+      (when propagator
+        (prop-message "~&;;; Entering type propagation for ~A" name)
+        (multiple-value-bind (new-type assumptions)
+            (apply propagator form assumptions (c1form-args form))
+          (when assumptions
+            (baboon :format-control "Non-empty assumptions found in P1PROPAGATE"))
+          (prop-message "~&;;; Propagating ~A gives type ~A" name
+                        new-type)
+          (return-from p1propagate
 	     (values (setf (c1form-type form)
 			   (values-type-and (c1form-type form)
 					    new-type))
-		     assumptions)))
-          (t
-           (cmpnote "Refusing to propagate ~A" name)
-           (values (c1form-type form) assumptions)))))
+		     assumptions))))))
+  (cmpnote "Refusing to propagate ~A" form)
+  (values (c1form-type form) assumptions))
 
 (defun p1trivial (form assumptions &rest rest)
   (declare (ignore rest))