+(defun canonicalize-args-type-args (required optional rest)
+ (when rest
+ (let ((last-distinct-optional (position rest optional
+ :from-end t
+ :test-not #'type=)))
+ (setf optional
+ (when last-distinct-optional
+ (subseq optional 0 (1+ last-distinct-optional))))))
+ (values required optional rest))
+
+(defun args-types (lambda-list-like-thing)
+ (multiple-value-bind
+ (required optional restp rest keyp keys allowp auxp aux)
+ (parse-lambda-list-like-thing lambda-list-like-thing)
+ (declare (ignore aux))
+ (when auxp
+ (error "&AUX in a FUNCTION or VALUES type: ~S." lambda-list-like-thing))
+ (let ((required (mapcar #'single-value-specifier-type required))
+ (optional (mapcar #'single-value-specifier-type optional))
+ (rest (when restp (single-value-specifier-type rest)))
+ (keywords
+ (collect ((key-info))
+ (dolist (key keys)
+ (unless (proper-list-of-length-p key 2)
+ (error "Keyword type description is not a two-list: ~S." key))
+ (let ((kwd (first key)))
+ (when (find kwd (key-info) :key #'key-info-name)
+ (error "~@<repeated keyword ~S in lambda list: ~2I~_~S~:>"
+ kwd lambda-list-like-thing))
+ (key-info
+ (make-key-info
+ :name kwd
+ :type (single-value-specifier-type (second key))))))
+ (key-info))))
+ (multiple-value-bind (required optional rest)
+ (canonicalize-args-type-args required optional rest)
+ (values required optional rest keyp keywords allowp)))))
+