Plaster

(defun denormalize (var) (destructuring-bind (name def &optional p) var (when (and (listp name) (keywordp (car name)) (string= (car name) (cadr name))) (setf name (cadr name))) (cond (p `(,name ,def ,p)) (def `(,name ,def)) ((listp name) `(,name)) (t name)))) (defun assemble-lambda-list (req opt rest key aokp aux keyp) `(,@req ,@(when opt `(&optional ,@(mapcar #'denormalize opt))) ,@(when rest `(&rest ,rest)) ,@(when keyp `(&key ,@(mapcar #'denormalize key))) ,@(when aokp `(&allow-other-keys)) ,@(when aux `(&aux ,@(mapcar #'denormalize aux))))) (defun ensure-indicator (var) (destructuring-bind (name def p) var `(,name ,def ,(or p (gensym))))) (defun collect-opt (opt) (when opt (destructuring-bind (name def p) (car opt) (declare (ignore def)) `(when ,p (list* ,name ,(collect-opt (cdr opt))))))) (defun arglist (lambda-list) (multiple-value-bind (req opt rest key aokp aux keyp) (alexandria:parse-ordinary-lambda-list lambda-list) (when keyp (setf rest (or rest (gensym)))) (setf opt (mapcar #'ensure-indicator opt)) (values `(nconc (list ,@req) ,(collect-opt opt) ,@(when rest `(,rest))) (assemble-lambda-list req opt rest key aokp aux keyp))))