From 0d52c58f1e8941c4c08182710abcb327489b8c99 Mon Sep 17 00:00:00 2001 From: Matthias Andreas Benkard Date: Sun, 27 Jul 2008 18:19:33 +0200 Subject: Use DEFUN in order to redefine functions used to implement DEFUN after it has been defined itself. --- destructuring-bind.lisp | 46 ++++++++++++++++++---------------------------- 1 file changed, 18 insertions(+), 28 deletions(-) (limited to 'destructuring-bind.lisp') diff --git a/destructuring-bind.lisp b/destructuring-bind.lisp index 021076d..b819a16 100644 --- a/destructuring-bind.lisp +++ b/destructuring-bind.lisp @@ -1,3 +1,13 @@ +;; D-B may not expand to (but _may_ itself use!) plain list function +;; calls because these are defined in list-functions.lisp by way of +;; DEFUN, which is in turn based on D-B. Because of this, we define our +;; own functions here. +(%defun* %car (list) + (sys::car list)) + +(%defun* %cdr (list) + (sys::cdr list)) + (setq lambda-list-keywords '(&allow-other-keys &aux &body &environment &key &optional &rest &whole)) @@ -32,19 +42,19 @@ (head (cadr lambda-list))) `(let* ((,sym ,expression) ,@(cond ((atom head) - `((,head (car ,sym)))) + `((,head (%car ,sym)))) ((null (cdr head)) - `((,(car head) (car ,sym)))) + `((,(car head) (%car ,sym)))) ((null (cddr head)) `((,(car head) (if (null ,sym) ,(cadr head) - (car ,sym))))) + (%car ,sym))))) (t `((,(car head) (if (null ,sym) ,(cadr head) - (car ,sym))) + (%car ,sym))) (,(caddr head) (not (null ,sym))))))) - (d-b (&optional ,@(cddr lambda-list)) ,environment ,whole-sym (cdr ,sym) + (d-b (&optional ,@(cddr lambda-list)) ,environment ,whole-sym (%cdr ,sym) ,@body))))) ((&rest &body) (if (%member (cadr lambda-list) lambda-list-keywords) @@ -100,8 +110,8 @@ (otherwise (let ((sym (gensym))) `(let ((,sym ,expression)) - (d-b ,(car lambda-list) ,environment ,whole-sym (car ,sym) - (d-b ,(cdr lambda-list) ,environment ,whole-sym (cdr ,sym) + (d-b ,(car lambda-list) ,environment ,whole-sym (%car ,sym) + (d-b ,(cdr lambda-list) ,environment ,whole-sym (%cdr ,sym) ,@body))))))) ((null lambda-list) `(progn ,@body)) @@ -112,26 +122,6 @@ `(d-b ,tree nil nil ,expression ,@body)) -(%defmacro* defun (name lambda-list . body) - (let ((lambda-sym (gensym))) - `(%defun ,name ,lambda-sym - (d-b ,lambda-list nil nil ,lambda-sym - ,@body)))) - -(%defmacro* defmacro (name lambda-list . body) - (let ((arg-sym (gensym)) - (lambda-sym (gensym)) - (whole-sym (gensym)) - (env-sym (gensym))) - `(%defmacro ,name ,arg-sym - (let ((,whole-sym (first ,arg-sym)) - (,lambda-sym (cdr (first ,arg-sym))) - (,env-sym (second ,arg-sym))) - (d-b ,lambda-list ,env-sym ,whole-sym ,lambda-sym - ,@body))))) - - (export '(destructuring-bind lambda-list-keywords &allow-other-keys &aux &body &environment &key &optional &rest - &whole - defmacro defun)) + &whole)) -- cgit v1.2.3