diff options
| -rw-r--r-- | destructuring-bind.lisp | 18 | ||||
| -rw-r--r-- | list-functions.lisp | 20 | ||||
| -rw-r--r-- | util.lisp | 15 |
3 files changed, 33 insertions, 20 deletions
diff --git a/destructuring-bind.lisp b/destructuring-bind.lisp index 161390d..7be7e41 100644 --- a/destructuring-bind.lisp +++ b/destructuring-bind.lisp @@ -17,7 +17,7 @@ ,@body))) (&aux (if (or (endp (cdr lambda-list)) - (member (cadr lambda-list) lambda-list-keywords)) + (%member (cadr lambda-list) lambda-list-keywords)) `(d-b ,(cdr lambda-list) ,environment ,whole-sym ,expression ,@body) `(let (,(cadr lambda-list)) @@ -25,29 +25,29 @@ ,@body)))) (&optional (if (or (endp (cdr lambda-list)) - (member (cadr lambda-list) lambda-list-keywords)) + (%member (cadr lambda-list) lambda-list-keywords)) `(d-b ,(cdr lambda-list) ,environment ,whole-sym ,expression ,@body) (let ((sym (gensym)) - (head (car lambda-list))) + (head (cadr lambda-list))) `(let* ((,sym ,expression) ,@(cond ((atom head) - `((,head (cadr ,sym)))) + `((,head (car ,sym)))) ((null (cdr head)) - `((,(car head) (cadr ,sym)))) + `((,(car head) (car ,sym)))) ((null (cddr head)) `((,(car head) (if (null ,sym) ,(cadr head) - (cadr ,sym))))) + (car ,sym))))) (t `((,(car head) (if (null ,sym) ,(cadr head) - (cadr ,sym))) + (car ,sym))) (,(caddr head) (not (null ,sym))))))) (d-b (&optional ,@(cddr lambda-list)) ,environment ,whole-sym (cdr ,sym) ,@body))))) ((&rest &body) - (if (member (cadr lambda-list) lambda-list-keywords) + (if (%member (cadr lambda-list) lambda-list-keywords) `(d-b ,(cdr lambda-list) ,environment ,whole-sym ,expression ,@body) (let ((sym (gensym))) @@ -64,7 +64,7 @@ ,@body)) (&key (if (or (endp (cdr lambda-list)) - (member (cadr lambda-list) lambda-list-keywords)) + (%member (cadr lambda-list) lambda-list-keywords)) `(d-b ,(cdr lambda-list) ,environment ,whole-sym ,expression ,@body) (let* ((sym (gensym)) diff --git a/list-functions.lisp b/list-functions.lisp index 464a9a4..5e700c4 100644 --- a/list-functions.lisp +++ b/list-functions.lisp @@ -146,8 +146,8 @@ ;;;;----------------------------------------------------------------- ;;;; TYPE PREDICATES ;;;;----------------------------------------------------------------- -(shadow '(consp listp null)) -(unexport '(sys::consp sys::listp sys::null) (find-package :sys)) +(shadow '(consp listp null atom)) +(unexport '(sys::consp sys::listp sys::null sys::atom) (find-package :sys)) (%defun consp args (sys::consp (first args))) @@ -158,9 +158,22 @@ (%defun null args (sys::null (first args))) +(%defun atom args + (sys::atom (first args))) + ;(%deftype cons args '(satisfies consp)) ;(%deftype list args '(satisfies listp)) ;(%deftype null args '(satisfies null)) +;(%deftype atom args '(satisfies atom)) + + +;;;;----------------------------------------------------------------- +;;;; OTHER PREDICATES +;;;;----------------------------------------------------------------- +(%defun endp args + (let ((thing (first args))) + ;;FIXME (check-type thing (first args) list) + (null thing))) ;;;;----------------------------------------------------------------- @@ -178,4 +191,5 @@ ;;;;----------------------------------------------------------------- (export '(cons car cdr list* first second third fourth fifth sixth - seventh eigthth ninth tenth consp listp null rplaca rplacd)) + seventh eigthth ninth tenth atom consp listp null rplaca + rplacd)) @@ -187,13 +187,12 @@ expansion-1 (macroexpand expansion-2)))) -(%defun* macroexpand-all (object . rest) - (let* ((env (if rest (car rest) nil))) - (if (consp object) - (let ((expansion (macroexpand object env))) - (cons (macroexpand-all (car expansion)) - (macroexpand-all (cdr expansion)))) - object))) - (%defmacro* unless (test . body) `(if (not ,test) (progn ,@body) nil)) + +(%defmacro* when (test . body) + `(if ,test (progn ,@body) nil)) + + +(export '(and or not let* list* case cond append reverse macroexpand + otherwise unless when)) |