Create a Common Lisp macro for the following transformation. Before code:
(defun-compile-time check-lambda-list (lambda-list) (unless (null (rest (last lambda-list))) (error "Improper lambda-list: ~S" lambda-list)) (let ((rest (member '&rest lambda-list :test #'eq))) (if rest (let ((rest (rest rest))) (unless (not (member '&rest rest :test #'eq)) (error "&REST cannot appear more than once: ~S" lambda-list)) (unless (and (not (null rest)) (not (member (first rest) lambda-list-keywords :test #'eq)) (or (null (rest rest)) (member (first (rest rest)) lambda-list-keywords :test #'eq))) (error "&REST must be followed by exactly one variable: ~S" lambda-list))))) (let ((allow-other-keys (member '&allow-other-keys lambda-list :test #'eq))) (if allow-other-keys (unless (or (null (rest allow-other-keys)) (member (first (rest allow-other-keys)) lambda-list-keywords :test #'eq)) (error "&ALLOW-OTHER-KEYS must not be followed by a parameter: ~S" lambda-list)))) (let ((keywords (remove-if-not #'(lambda (argument) (member argument lambda-list-keywords :test #'eq)) lambda-list))) (unless (every #'(lambda (keyword) (member keyword *ordered-lambda-list-keywords* :test #'eq)) keywords) (error "Invalid lambda list keyword: ~S" lambda-list)) (unless (every #'(lambda (x y) (member y (member x *ordered-lambda-list-keywords* :test #'eq) :test #'eq)) keywords (rest keywords)) (error "Invalid order for lambda list keywords: ~S" lambda-list))) (check-lambda-list-internal lambda-list))

What needs to change: Macro call that should be transformed by defun-compile-time

Macro definition:
(defmacro defun-compile-time (function-name lambda-list &body body)
  `(eval-when (:compile-toplevel :load-toplevel :execute)
     (cl:defun ,function-name ,lambda-list ,@body)
     (eval-when (:compile-toplevel) (compile ',function-name))))

Macroexpansion:
(eval-when (:compile-toplevel :load-toplevel :execute) (common-lisp:defun check-lambda-list (lambda-list) (unless (null (rest (last lambda-list))) (error "Improper lambda-list: ~S" lambda-list)) (let ((rest (member (quote &rest) lambda-list :test (function eq)))) (if rest (let ((rest (rest rest))) (unless (not (member (quote &rest) rest :test (function eq))) (error "&REST cannot appear more than once: ~S" lambda-list)) (unless (and (not (null rest)) (not (member (first rest) lambda-list-keywords :test (function eq))) (or (null (rest rest)) (member (first (rest rest)) lambda-list-keywords :test (function eq)))) (error "&REST must be followed by exactly one variable: ~S" lambda-list))))) (let ((allow-other-keys (member (quote &allow-other-keys) lambda-list :test (function eq)))) (if allow-other-keys (unless (or (null (rest allow-other-keys)) (member (first (rest allow-other-keys)) lambda-list-keywords :test (function eq))) (error "&ALLOW-OTHER-KEYS must not be followed by a parameter: ~S" lambda-list)))) (let ((keywords (remove-if-not (function (lambda (argument) (member argument lambda-list-keywords :test (function eq)))) lambda-list))) (unless (every (function (lambda (keyword) (member keyword *ordered-lambda-list-keywords* :test (function eq)))) keywords) (error "Invalid lambda list keyword: ~S" lambda-list)) (unless (every (function (lambda (x y) (member y (member x *ordered-lambda-list-keywords* :test (function eq)) :test (function eq)))) keywords (rest keywords)) (error "Invalid order for lambda list keywords: ~S" lambda-list))) (check-lambda-list-internal lambda-list)) (eval-when (:compile-toplevel) (compile (quote check-lambda-list))))