diff options
| author | Matthias Andreas Benkard <matthias@benkard.de> | 2008-07-30 10:38:12 +0200 |
|---|---|---|
| committer | Matthias Andreas Benkard <matthias@benkard.de> | 2008-07-30 10:38:12 +0200 |
| commit | a5ab7e91e735d12cada1eb1df8d0f5c4bff0a2d1 (patch) | |
| tree | 594b9e120bb4e6dbba45b87ecd366559f4b4ca9d | |
| parent | 50a845d6101142b55d17701c2bce473703be058f (diff) | |
Fix handling of &KEY arguments.
| -rw-r--r-- | destructuring-bind.lisp | 23 |
1 files changed, 20 insertions, 3 deletions
diff --git a/destructuring-bind.lisp b/destructuring-bind.lisp index 8767630..bb44424 100644 --- a/destructuring-bind.lisp +++ b/destructuring-bind.lisp @@ -13,6 +13,19 @@ (%defun* %cdr (list) (sys::cdr list)) +(%defun* %cadr (list) + (sys::car (sys::cdr list))) + +(%defun* %cddr (list) + (sys::cdr (sys::cdr list))) + +(%defun* %getf (list indicator default) + (if (sys::null list) + default + (if (eq indicator (%car list)) + (%cadr list) + (%getf (%cddr list) indicator default)))) + (setq lambda-list-keywords '(&allow-other-keys &aux &body &environment &key &optional &rest &whole)) @@ -96,10 +109,14 @@ (caar head) (intern (symbol-name var) (find-package '#:keyword))))) `(let* ((,sym ,expression) - (,value-sym (getf ,sym ,keyword-name ',missing)) + (,value-sym (%getf ,sym ,keyword-name ',missing)) ,@(cond ((atom head) - `((,var ,value-sym))) - ((null (cdr head)) + `((,var (if (eq ,value-sym ',missing) + nil + ,value-sym)))) + ((null (if (eq ,value-sym ',missing) + nil + ,value-sym)) `((,var ,value-sym))) ((null (cddr head)) `((,var (if (eq ,value-sym ',missing) |