+(defun fix-and-check-keyword-argument-list (list)
+ "Check the keyword argument LIST is valid; if so, fix it up and return it.
+
+ Check that the keyword arguments have distinct names. Fix the list up by
+ sorting it by keyword name."
+
+ (unless (every #'argumentp list)
+ (error "(INTERNAL) not an argument value"))
+
+ (let ((list (sort (copy-list list) #'string< :key #'argument-name)))
+ (do ((list (cdr list) (cdr list))
+ (this (car list) (car list))
+ (prev nil this))
+ ((endp list))
+ (when prev
+ (let ((this-name (argument-name this))
+ (prev-name (argument-name prev)))
+ (when (string= this-name prev-name)
+ (error "Duplicate keyword argument name `~A'." this-name)))))
+ list))
+
+(export 'merge-keyword-lists)
+(defun merge-keyword-lists (lists)
+ "Return the union of keyword argument lists.
+
+ The LISTS parameter consists of pairs (ARGS . WHAT), where ARGS is a list
+ of `argument' objects, and WHAT is either nil or a printable object
+ describing the origin of the corresponding argument list suitable for
+ quoting in an error message.
+
+ The resulting list contains exactly one argument for each distinct
+ argument name appearing in the input lists; this argument will contain the
+ default value corresponding to the name's earliest occurrence in the input
+ LISTS.
+
+ If the same name appears in multiple input lists with different types, an
+ error is signalled; this error will quote the origins of a representative
+ conflicting pair of arguments."
+
+ ;; The easy way through all of this is with a hash table mapping argument
+ ;; names to (ARGUMENT . WHAT) pairs.
+
+ (let ((argmap (make-hash-table :test #'equal)))
+
+ ;; Set up the table. When we find a duplicate, check that the types
+ ;; match.
+ (dolist (item lists)
+ (let ((args (car item))
+ (what (cdr item)))
+ (dolist (arg args)
+ (let* ((name (argument-name arg))
+ (other-item (gethash name argmap)))
+ (if (null other-item)
+ (setf (gethash name argmap) (cons arg what))
+ (let* ((type (argument-type arg))
+ (other (car other-item))
+ (other-type (argument-type other))
+ (other-what (cdr other-item)))
+ (unless (c-type-equal-p type other-type)
+ (error "Type mismatch for keyword argument `~A': ~
+ ~A~@[ (~A)~] doesn't match ~A~@[ (~A)~]."
+ name
+ type what
+ other-type other-what))))))))
+
+ ;; Now it's just a matter of picking the arguments out again.
+ (let ((result nil))
+ (maphash (lambda (name item)
+ (declare (ignore name))
+ (push (car item) result))
+ argmap)
+ (fix-and-check-keyword-argument-list result))))
+