0.9.1.36:
[sbcl.git] / src / code / defboot.lisp
index 8329bc7..c505819 100644 (file)
                          (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)
       `(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)
                 (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
                 (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)))))