X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdefboot.lisp;h=43ad076d5cbe0f3923e28a510ea84e43e34f7d97;hb=3fe0010d2777b41e01ea9b4a0f894cfa40f7df1b;hp=8329bc7a78f9e8096296b6850347476e06cab6fb;hpb=771b864c8f32af7734bc0550aeaf1539fc4df194;p=sbcl.git

diff --git a/src/code/defboot.lisp b/src/code/defboot.lisp
index 8329bc7..43ad076 100644
--- a/src/code/defboot.lisp
+++ b/src/code/defboot.lisp
@@ -50,7 +50,13 @@
 (defmacro-mundanely multiple-value-setq (vars value-form)
   (unless (list-of-symbols-p vars)
     (error "Vars is not a list of symbols: ~S" vars))
-  `(values (setf (values ,@vars) ,value-form)))
+  ;; MULTIPLE-VALUE-SETQ is required to always return just the primary
+  ;; value of the value-from, even if there are no vars. (SETF VALUES)
+  ;; in turn is required to return as many values as there are
+  ;; value-places, hence this:
+  (if vars
+      `(values (setf (values ,@vars) ,value-form))
+      `(values ,value-form)))
 
 (defmacro-mundanely multiple-value-list (value-form)
   `(multiple-value-call #'list ,value-form))
@@ -160,7 +166,7 @@
 			  (block ,(fun-name-block-name name)
 			    ,@forms)))
 	   (lambda `(lambda ,@lambda-guts))
-	   #-sb-xc-host
+           #-sb-xc-host
 	   (named-lambda `(named-lambda ,name ,@lambda-guts))
 	   (inline-lambda
 	    (when (inline-fun-name-p name)
@@ -175,14 +181,14 @@
       `(progn
 	 ;; In cross-compilation of toplevel DEFUNs, we arrange for
 	 ;; the LAMBDA to be statically linked by GENESIS.
-	 ;;
-	 ;; It may seem strangely inconsistent not to use NAMED-LAMBDA
-	 ;; here instead of LAMBDA. The reason is historical:
-	 ;; COLD-FSET was written before NAMED-LAMBDA, and has special
-	 ;; logic of its own to notify the compiler about NAME.
-	 #+sb-xc-host
+         ;;
+         ;; It may seem strangely inconsistent not to use NAMED-LAMBDA
+         ;; here instead of LAMBDA. The reason is historical:
+         ;; COLD-FSET was written before NAMED-LAMBDA, and has special
+         ;; logic of its own to notify the compiler about NAME.
+ 	 #+sb-xc-host
 	 (cold-fset ,name ,lambda)
-
+         
 	 (eval-when (:compile-toplevel)
 	   (sb!c:%compiler-defun ',name ',inline-lambda t))
 	 (eval-when (:load-toplevel :execute)
@@ -314,6 +320,16 @@
                 (declare (type unsigned-byte ,var))
                 ,@body)))))
 
+(defun filter-dolist-declarations (decls)
+  (mapcar (lambda (decl)
+            `(declare ,@(remove-if
+                         (lambda (clause)
+                           (and (consp clause)
+                                (or (eq (car clause) 'type)
+                                    (eq (car clause) 'ignore))))
+                         (cdr decl))))
+          decls))
+    
 (defmacro-mundanely dolist ((var list &optional (result nil)) &body body)
   ;; We repeatedly bind the var instead of setting it so that we never
   ;; have to give the var an arbitrary value such as NIL (which might
@@ -338,6 +354,11 @@
                 (go ,start))))
          ,(if result
               `(let ((,var nil))
+                 ;; Filter out TYPE declarations (VAR gets bound to NIL,
+                 ;; and might have a conflicting type declaration) and
+                 ;; IGNORE (VAR might be ignored in the loop body, but
+                 ;; it's used in the result form).
+                 ,@(filter-dolist-declarations decls)
                  ,var
                  ,result)
                nil)))))