- (arglist (optional-dispatch-arglist od)))
- (dolist (arg arglist)
- (cond
- ((lambda-var-arg-info arg)
- (let* ((info (lambda-var-arg-info arg))
- (default (arg-info-default info))
- (def-type (when (constantp default)
- (ctype-of (eval default)))))
- (ecase (arg-info-kind info)
- (:keyword
- (let* ((key (arg-info-key info))
- (kinfo (find key keys :key #'key-info-name)))
- (cond
- (kinfo
- (res (type-union (key-info-type kinfo)
- (or def-type (specifier-type 'null)))))
- (t
- (note-lossage
- "Defining a ~S keyword not present in ~A."
- key where)
- (res *universal-type*)))))
- (:required (res (pop req)))
- (:optional
- (res (type-union (pop opt) (or def-type *universal-type*))))
- (:rest
- (when (fun-type-rest type)
- (res (specifier-type 'list))))
- (:more-context
- (when (fun-type-rest type)
- (res *universal-type*)))
- (:more-count
- (when (fun-type-rest type)
- (res (specifier-type 'fixnum)))))
- (vars arg)
- (when (arg-info-supplied-p info)
- (res *universal-type*)
- (vars (arg-info-supplied-p info)))))
- (t
- (res (pop req))
- (vars arg))))
-
- (dolist (key keys)
- (unless (find (key-info-name key) arglist
- :key (lambda (x)
- (let ((info (lambda-var-arg-info x)))
- (when info
- (arg-info-key info)))))
- (note-lossage
- "The definition lacks the ~S key present in ~A."
- (key-info-name key) where))))
+ (arglist (optional-dispatch-arglist od)))
+ (dolist (arg arglist)
+ (cond
+ ((lambda-var-arg-info arg)
+ (let* ((info (lambda-var-arg-info arg))
+ (default (arg-info-default info))
+ (def-type (when (sb!xc:constantp default)
+ (ctype-of (constant-form-value default)))))
+ (ecase (arg-info-kind info)
+ (:keyword
+ (let* ((key (arg-info-key info))
+ (kinfo (find key keys :key #'key-info-name)))
+ (cond
+ (kinfo
+ (res (type-union (key-info-type kinfo)
+ (or def-type (specifier-type 'null)))))
+ (t
+ (note-lossage
+ "Defining a ~S keyword not present in ~A."
+ key where)
+ (res *universal-type*)))))
+ (:required (res (pop req)))
+ (:optional
+ (res (type-union (pop opt) (or def-type *universal-type*))))
+ (:rest
+ (when (fun-type-rest type)
+ (res (specifier-type 'list))))
+ (:more-context
+ (when (fun-type-rest type)
+ (res *universal-type*)))
+ (:more-count
+ (when (fun-type-rest type)
+ (res (specifier-type 'fixnum)))))
+ (vars arg)
+ (when (arg-info-supplied-p info)
+ (res *universal-type*)
+ (vars (arg-info-supplied-p info)))))
+ (t
+ (res (pop req))
+ (vars arg))))
+
+ (dolist (key keys)
+ (unless (find (key-info-name key) arglist
+ :key (lambda (x)
+ (let ((info (lambda-var-arg-info x)))
+ (when info
+ (arg-info-key info)))))
+ (note-lossage
+ "The definition lacks the ~S key present in ~A."
+ (key-info-name key) where))))