- (setq decl (car body))
- (unless (and (consp decl)
- (eq (car decl) 'declare))
- (return nil))
- (dolist (form (cdr decl))
- (when (consp form)
- (let ((declaration-name (car form)))
- (if (member declaration-name *non-var-declarations*)
- (push `(declare ,form) outer-decls)
- (let ((arg-p
- (member declaration-name
- *var-declarations-with-arg*))
- (non-arg-p
- (member declaration-name
- *var-declarations-without-arg*))
- (dname (list (pop form)))
- (inners nil) (outers nil))
- (unless (or arg-p non-arg-p)
- ;; FIXME: This warning, and perhaps the
- ;; various *VAR-DECLARATIONS-FOO* and/or
- ;; *NON-VAR-DECLARATIONS* variables,
- ;; could probably go away now that we're not
- ;; trying to be portable between different
- ;; CLTL1 hosts the way PCL was. (Note that to
- ;; do this right, we need to be able to handle
- ;; user-defined (DECLAIM (DECLARATION FOO))
- ;; stuff.)
- (warn "The declaration ~S is not understood by ~S.~@
- Please put ~S on one of the lists ~S,~%~S, or~%~S.~@
- (Assuming it is a variable declaration without argument)."
- declaration-name 'split-declarations
- declaration-name
- '*non-var-declarations*
- '*var-declarations-with-arg*
- '*var-declarations-without-arg*)
- (push declaration-name *var-declarations-without-arg*))
- (when arg-p
- (setq dname (append dname (list (pop form)))))
- (case (car dname)
- (%class (push `(declare (,@dname ,@form)) inner-decls))
- (t
- (dolist (var form)
- (if (member var args)
- ;; Quietly remove IGNORE declarations
- ;; on args when a next-method is
- ;; involved, to prevent compiler
- ;; warnings about ignored args being
- ;; read.
- (unless (and maybe-reads-params-p
- (eq (car dname) 'ignore))
- (push var outers))
- (push var inners)))
- (when outers
- (push `(declare (,@dname ,@outers)) outer-decls))
- (when inners
- (push
- `(declare (,@dname ,@inners))
- inner-decls)))))))))
- (setq body (cdr body)))
+ (setq decl (car body))
+ (unless (and (consp decl)
+ (eq (car decl) 'declare))
+ (return nil))
+ (dolist (form (cdr decl))
+ (when (consp form)
+ (let ((declaration-name (car form)))
+ (if (member declaration-name *non-var-declarations*)
+ (push `(declare ,form) outer-decls)
+ (let ((arg-p
+ (member declaration-name
+ *var-declarations-with-arg*))
+ (non-arg-p
+ (member declaration-name
+ *var-declarations-without-arg*))
+ (dname (list (pop form)))
+ (inners nil) (outers nil))
+ (unless (or arg-p non-arg-p)
+ ;; FIXME: This warning, and perhaps the
+ ;; various *VAR-DECLARATIONS-FOO* and/or
+ ;; *NON-VAR-DECLARATIONS* variables,
+ ;; could probably go away now that we're not
+ ;; trying to be portable between different
+ ;; CLTL1 hosts the way PCL was. (Note that to
+ ;; do this right, we need to be able to handle
+ ;; user-defined (DECLAIM (DECLARATION FOO))
+ ;; stuff.)
+ (warn "The declaration ~S is not understood by ~S.~@
+ Please put ~S on one of the lists ~S,~%~S, or~%~S.~@
+ (Assuming it is a variable declaration without argument)."
+ declaration-name 'split-declarations
+ declaration-name
+ '*non-var-declarations*
+ '*var-declarations-with-arg*
+ '*var-declarations-without-arg*)
+ (push declaration-name *var-declarations-without-arg*))
+ (when arg-p
+ (setq dname (append dname (list (pop form)))))
+ (case (car dname)
+ (%class (push `(declare (,@dname ,@form)) inner-decls))
+ (t
+ (dolist (var form)
+ (if (member var args)
+ ;; Quietly remove IGNORE declarations
+ ;; on args when a next-method is
+ ;; involved, to prevent compiler
+ ;; warnings about ignored args being
+ ;; read.
+ (unless (and maybe-reads-params-p
+ (eq (car dname) 'ignore))
+ (push var outers))
+ (push var inners)))
+ (when outers
+ (push `(declare (,@dname ,@outers)) outer-decls))
+ (when inners
+ (push
+ `(declare (,@dname ,@inners))
+ inner-decls)))))))))
+ (setq body (cdr body)))