(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))
(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)))))