-(defun process-1-declaration (spec res vars fvars cont)
- (declare (list spec vars fvars) (type lexenv res) (type continuation cont))
- (case (first spec)
- (special (process-special-declaration spec res vars))
- (ftype
- (unless (cdr spec)
- (compiler-error "No type specified in FTYPE declaration: ~S" spec))
- (process-ftype-declaration (second spec) res (cddr spec) fvars))
- (function
- ;; Handle old style FUNCTION declaration, which is an abbreviation for
- ;; FTYPE. Args are name, arglist, result type.
- (cond ((and (proper-list-of-length-p spec 3 4)
- (listp (third spec)))
- (process-ftype-declaration `(function ,@(cddr spec)) res
- (list (second spec))
- fvars))
- (t
- (process-type-declaration spec res vars))))
- ((inline notinline maybe-inline)
- (process-inline-declaration spec res fvars))
- ((ignore ignorable)
- (process-ignore-declaration spec vars fvars)
- res)
- (optimize
- (make-lexenv
- :default res
- :policy (process-optimize-declaration spec (lexenv-policy res))))
- (optimize-interface
- (make-lexenv
- :default res
- :interface-policy (process-optimize-declaration
- spec
- (lexenv-interface-policy res))))
- (type
- (process-type-declaration (cdr spec) res vars))
- (values
- (if *suppress-values-declaration*
- res
- (let ((types (cdr spec)))
- (do-the-stuff (if (eql (length types) 1)
- (car types)
- `(values ,@types))
- cont res 'values))))
- (dynamic-extent
- (when (policy nil (> speed inhibit-warnings))
- (compiler-note
- "The DYNAMIC-EXTENT declaration is not implemented (ignored)."))
- res)
- (t
- (let ((what (first spec)))
- (cond ((member what *standard-type-names*)
- (process-type-declaration spec res vars))
- ((and (not (and (symbolp what)
- (string= (symbol-name what) "CLASS"))) ; pcl hack
- (or (info :type :kind what)
- (and (consp what) (info :type :translator (car what)))))
- (process-type-declaration spec res vars))
- ((info :declaration :recognized what)
- res)
- (t
- (compiler-warning "unrecognized declaration ~S" spec)
- res))))))
+(defun process-1-decl (raw-spec res vars fvars cont)
+ (declare (type list raw-spec vars fvars))
+ (declare (type lexenv res))
+ (declare (type continuation cont))
+ (let ((spec (canonized-decl-spec raw-spec)))
+ (case (first spec)
+ (special (process-special-decl spec res vars))
+ (ftype
+ (unless (cdr spec)
+ (compiler-error "No type specified in FTYPE declaration: ~S" spec))
+ (process-ftype-decl (second spec) res (cddr spec) fvars))
+ ((inline notinline maybe-inline)
+ (process-inline-decl spec res fvars))
+ ((ignore ignorable)
+ (process-ignore-decl spec vars fvars)
+ res)
+ (optimize
+ (make-lexenv
+ :default res
+ :policy (process-optimize-decl spec (lexenv-policy res))))
+ (type
+ (process-type-decl (cdr spec) res vars))
+ (values
+ (if *suppress-values-declaration*
+ res
+ (let ((types (cdr spec)))
+ (do-the-stuff (if (eql (length types) 1)
+ (car types)
+ `(values ,@types))
+ cont res 'values))))
+ (dynamic-extent
+ (when (policy *lexenv* (> speed inhibit-warnings))
+ (compiler-note
+ "compiler limitation:~
+ ~% There's no special support for DYNAMIC-EXTENT (so it's ignored)."))
+ res)
+ (t
+ (unless (info :declaration :recognized (first spec))
+ (compiler-warning "unrecognized declaration ~S" raw-spec))
+ res))))