DEFMACRO bug

[Marco Gidde]

DEFMACRO does not work with &REST or &BODY arguments:


COMMON-LISP-USER> (defmacro test (arg1 &rest argn)
`(cons ,arg1 ,argn))
TEST
COMMON-LISP-USER> (macroexpand '(test 1 2 3 4 5))
(CONS 1 NIL)
T
COMMON-LISP-USER> (test 1 2 3 4 5)
(1)


If you replace &REST with &BODY it's just the same.

[Marco Gidde]

AS I noticed a few minutes later, it is an inherited fault caused by
DESTRUCTURING-BIND, therefore an old story :-)

[lars-zgYzP9v7iJcdnm+ (Lars Brinkhoff)]

Post by Marco Gidde
AS I noticed a few minutes later, it is an inherited fault caused by
DESTRUCTURING-BIND, therefore an old story :-)

Right. Someone should fix that. :)

[Marco Gidde]

Post by lars-zgYzP9v7iJcdnm+ (Lars Brinkhoff)

Post by Marco Gidde
AS I noticed a few minutes later, it is an inherited fault caused by
DESTRUCTURING-BIND, therefore an old story :-)

Right. Someone should fix that. :)

While far from being complete or bug free I found the following change
to destructure quite useful:

(defun destructure (lambda-list whole)
(if (null lambda-list)
nil
(let ((result nil)
(current nil)
(struct whole))
(setq current (pop lambda-list))
(when (eq current '&WHOLE)
(push `(SETQ ,(pop lambda-list) ,whole) result)
(setq current (pop lambda-list)))
(push `(WHEN (ATOM ,struct) (ERROR)) result)
(while (and current (not (lambda-list-keyword-p current)))
(cond
((symbolp current)
(push `(SETQ ,current (CAR ,struct)) result))
((consp current)
(let ((subtree (gensym)))
(push `(LET ((,subtree (CAR ,struct)))
,@(destructure current subtree))
result))))
(push `(SETQ ,struct (CDR ,struct)) result)
(setq current (pop lambda-list)))

Post by lars-zgYzP9v7iJcdnm+ (Lars Brinkhoff)
(when (eq current '&OPTIONAL)
(push `(SETQ ,(pop lambda-list) (CAR ,struct)) result)
(push `(SETQ ,struct (CDR ,struct)) result)
(setq current (pop lambda-list)))
(when (or (eq current '&REST) (eq current '&BODY))
(push `(SETQ ,(pop lambda-list) ,struct) result))

(nreverse result))))

At least it seems to break nothing :-)

[lars-zgYzP9v7iJcdnm+ (Lars Brinkhoff)]

Post by Marco Gidde

Post by lars-zgYzP9v7iJcdnm+ (Lars Brinkhoff)

Post by Marco Gidde
AS I noticed a few minutes later, it is an inherited fault caused by
DESTRUCTURING-BIND, therefore an old story :-)

Right. Someone should fix that. :)

While far from being complete or bug free I found the following change

Post by lars-zgYzP9v7iJcdnm+ (Lars Brinkhoff)
(when (eq current '&OPTIONAL)
(push `(SETQ ,(pop lambda-list) (CAR ,struct)) result)
(push `(SETQ ,struct (CDR ,struct)) result)
(setq current (pop lambda-list)))
(when (or (eq current '&REST) (eq current '&BODY))
(push `(SETQ ,(pop lambda-list) ,struct) result))

I will soon commit something similar that handles more cases.