[Ecls-list] Patch: macro expansion when expanding a setf form

[Juan Jose Garcia-Ripoll]

On Sat, Aug 30, 2008 at 10:53 PM, Josh Elsasser <josh at elsasser.org> wrote:
> when attempting to macroexpand a form to find a setf expansion,
> MACROEXPAND is used instead of MACROEXPAND-1.  This means that the
> setf expansion will not be found for a macro which expands into a
> SETFable place which is also happens to be a macro.
>
> For example, given the following pseudo-definitions:
>
> (defmacro inner ...)
> (define-setf-expander inner ...)
> (defmacro outer (val)
>  `(inner ,val))
>
> The setf expansion defined for inner will not be found for a form like
> (setf (outer foo) bar)

Sorry, I am a bit dense today :-) The scheme you plot above seems to
work. Using the example from the Hyperspec, but changing DEFUN ->
DEFMACRO yields

(defmacro lastguy (x) `(car (last ,x)))
(define-setf-expander lastguy (x &environment env)
   "Set the last element in a list to the given value."
   (multiple-value-bind (dummies vals newval setter getter)
       (get-setf-expansion x env)
     (let ((store (gensym)))
       (values dummies
               vals
               `(,store)
               `(progn (rplaca (last ,getter) ,store) ,store)
               `(lastguy ,getter)))))
(setq a (list 'a 'b 'c 'd)
       b (list 'x)
       c (list 1 2 3 (list 4 5 6)))
(setf (lastguy a) 3)
(setf (lastguy b) 7)
(setf (lastguy (lastguy c)) 'lastguy-symbol)

and this actually produces
(http://www.lispworks.com/documentation/HyperSpec/Body/m_defi_3.htm)

> a
(A B C 3)
> b
(7)
> c
(1 2 3 (4 5 LASTGUY-SYMBOL))

Juanjo

>
> A patch to incrementally expand macros with MACROEXPAND-1 follows:
>
> --- src/lsp/setf.lsp
> +++ src/lsp/setf.lsp
> @@ -111,7 +111,7 @@ Does not check if the third gang is a single-element list."
>             (push item all-args))
>           (values (gensym) (nreverse names) (nreverse values) (nreverse all-args))))
>     (cond ((symbolp form)
> -          (if (and (setq f (macroexpand form env)) (not (equal f form)))
> +          (if (and (setq f (macroexpand-1 form env)) (not (equal f form)))
>               (get-setf-expansion f env)
>               (let ((store (gensym)))
>                 (values nil nil (list store) `(setq ,form ,store) form))))
> @@ -130,7 +130,7 @@ Does not check if the third gang is a single-element list."
>                            (setf-structure-access (car all) (car f) (cdr f) store))
>                           ((setq f (get-sysprop (car form) 'SETF-LAMBDA))
>                            (apply f store all))
> -                          ((and (setq f (macroexpand form env)) (not (equal f form)))
> +                          ((and (setq f (macroexpand-1 form env)) (not (equal f form)))
>                            (return-from get-setf-expansion
>                              (get-setf-expansion f env)))
>                           (t
>
> -------------------------------------------------------------------------
> This SF.Net email is sponsored by the Moblin Your Move Developer's challenge
> Build the coolest Linux based applications with Moblin SDK & win great prizes
> Grand prize is a trip for two to an Open Source event anywhere in the world
> http://moblin-contest.org/redirect.php?banner_id=100&url=/
> _______________________________________________
> Ecls-list mailing list
> Ecls-list at lists.sourceforge.net
> https://lists.sourceforge.net/lists/listinfo/ecls-list
>



-- 
Instituto de Física Fundamental
CSIC, Serrano, 113, Madrid 28040 (Spain)
http://juanjose.garciaripoll.googlepages.com