What is the difference between these macros? - macros

I have some questions about how macros work in Scheme (specifically in Chicken Scheme), let's consider this example:
(define (when-a condition . body)
(eval `(if ,condition
(begin ,#body)
'())))
(define-syntax when-b
(er-macro-transformer
(lambda (exp rename compare)
(let ((condition (cadr exp))
(body (cddr exp)))
`(if ,condition (begin ,#body) '())))))
(define-syntax when-c
(ir-macro-transformer
(lambda (exp inject compare)
(let ((condition (cadr exp))
(body (cddr exp)))
`(if ,condition (begin ,#body) '())))))
(define-syntax when-d
(syntax-rules ()
((when condition body ...)
(if condition (begin body ...) '()))))
Can I consider when-a a macro? I feel that I can't consider it a macro in a strict way since I'm not using define-syntax but I'm not able to say any pratical reason to not prefer this implementation.
Are my macros hygienic?
Is there any difference between when-b and when-c? Since I'm not using rename nor inject I think there isn't.

Can I consider when-a a macro? I feel that I can't consider it a macro in a strict way since I'm not using define-syntax but I'm not able to say any pratical reason to not prefer this implementation.
This works like a macro, but it's not exactly the same as a true macro, for the following reasons:
The main difference between a true macro and your eval-based "macro" is that your approach will evaluate all its arguments before calling it. This is a very important difference. For example: (if #f (error "oops") '()) will evaluate to '() but (when-a #f (error "oops")) will raise an error.
It's not hygienic. Beforehand, one might have done something like (eval '(define if "not a procedure")), for example, and that would mean this eval would fail; the if in the body expression of the "expansion" doesn't refer to the if at the definition site.
It does not get expanded at compile time. This is another major reason to use a macro; the compiler will expand it, and at runtime no computation will be performed to perform the expansion. The macro itself will have completely evaporated. Only the expansion remains.
Are my macros hygienic?
Only when-c and when-d are, because of the guarantees made by ir-macro-transformer and syntax-rules. In when-b you'd have to rename if and begin to make them refer to the versions of if and begin at the macro definition site.
Example:
(let ((if #f))
(when-b #t (print "Yeah, ok")))
== expands to ==>
(let ((if1 #f))
(if1 #t (begin1 (print "Yeah, ok"))))
This will fail, because both versions of if (here annotated with an extra 1 suffix) refer to the same thing, so we'll end up calling #f in operator position.
In contrast,
(let ((if #f))
(when-c #t (print "Yeah, ok")))
== expands to ==>
(let ((if1 #f))
(if2 #t (begin1 (print "Yeah, ok"))))
Which will work as intended. If you want to rewrite when-b to be hygienic, do it like this:
(define-syntax when-b
(er-macro-transformer
(lambda (exp rename compare)
(let ((condition (cadr exp))
(body (cddr exp))
(%if (rename 'if))
(%begin (rename 'begin)))
`(,%if ,condition (,%begin ,#body) '())))))
Note the extra %-prefixed identifiers which refer to the original value of if and begin as they were at the place of definition of the macro.
Is there any difference between when-b and when-c? Since I'm not using rename nor inject I think there isn't.
There is. Implicit renaming macros are called that because they implicitly rename all the identifiers that come in from the usage site, and also every new identifier you introduce in the body. If you inject any identifiers, that undoes this implicit renaming, which makes them unhygienically available for capture by the calling code.
On the other hand, explicit renaming macros are called that because you must explicitly rename any identifiers to prevent them being captured by the calling code.

Related

Lisp Macro cannot find applicable function

Given the macro:
(defclass sample-class ()
((slot-1 :accessor slot-1
:initform "sample slot")))
(defvar *sample-instance*(make-instance 'sample-class))
(defmacro sample-macro (p)
`(if (typep ,p 'sample-class)
(progn
(print "evaluated")
(print ,(slot-1 p)))))
(sample-macro *sample-instance*)
I am confused as to why this is the error output
Execution of a form compiled with errors.
Form:
(SAMPLE-MACRO *SAMPLE-INSTANCE*)
Compile-time error:
(during macroexpansion of (SAMPLE-MACRO *SAMPLE-INSTANCE*))
There is no applicable method for the generic function
#<STANDARD-GENERIC-FUNCTION COMMON-LISP-USER::SLOT-1 (1)>
when called with arguments
(*SAMPLE-INSTANCE*).
See also:
The ANSI Standard, Section 7.6.6
[Condition of type SB-INT:COMPILED-PROGRAM-ERROR]
Shouldn't the macro expand and evaluate the s-form in the process? Why is the reader not finding the generic function slot-1?
I think you are confused about what macros do. Macros are transformations of source code. So consider what happens when the system tries to expand the macro form (sample-macro *sample-instance*). At macroexpansion time, p is the symbol *sample-instance*: a representation of a bit of source code.
So now, look at the backquoted form in the body of the macro: in it there is ,(slot-1 p): this will try and call slot-1 on whatever p is bound to, which is a symbol. This then fails and the macroexpansion fails as a result.
Well, you could 'fix' this in a way which seems obvious:
(defmacro sample-macro (p)
`(if (typep ,p 'sample-class)
(progn
(print "evaluated")
(print (slot-1 ,p)))))
And this seems to work. Using a macroexpansion tracer:
(sample-macro *sample-instance*)
-> (if (typep *sample-instance* 'sample-class)
(progn (print "evaluated") (print (slot-1 *sample-instance*))))
And if you use the macro it will 'work'. Except it won't work, at all: Consider this form: (sample-macro (make-instance 'sample-class)): well, let's look at that using the macro tracer:
(sample-macro (make-instance 'sample-class))
-> (if (typep (make-instance 'sample-class) 'sample-class)
(progn
(print "evaluated")
(print (slot-1 (make-instance 'sample-class)))))
Oh dear.
So we could work around this problem by rewriting the macro like this:
(defmacro sample-macro (p)
`(let ((it ,p))
(if (typep it 'sample-class)
(progn
(print "evaluated")
(print (slot-1 it)))
And now
(sample-macro (make-instance 'sample-class))
-> (let ((it (make-instance 'sample-class)))
(if (typep it 'sample-class)
(progn (print "evaluated") (print (slot-1 it)))))
Which is better. And in this case it's even safe, but in the great majority of cases we'd need to use a gensym for the thing I've called it:
(defmacro sample-macro (p)
(let ((itn (make-symbol "IT"))) ;not needed for this macro
`(let ((,itn ,p))
(if (typep ,itn 'sample-class)
(progn
(print "evaluated")
(print (slot-1 ,itn)))))))
And now:
(sample-macro (make-instance 'sample-class))
-> (let ((#:it (make-instance 'sample-class)))
(if (typep #:it 'sample-class)
(progn (print "evaluated") (print (slot-1 #:it)))))
So this (and in fact the previous version of it as well) is finally working.
But wait, but wait. What we've done is to turn this thing into something which:
binds the value of its argument to a variable;
and evaluates some code with that binding.
There's a name for something which does that, and that name is function.
(defun not-sample-macro-any-more (it)
(if (typep it 'sample-class)
(progn
(print "evaluated")
(print (slot-1 it)))))
This does everything that the working versions of sample-macro did but without all the needless complexity.
Well, it doesn't do one thing: it doesn't get expanded inline, and perhaps that means it might be a little slower.
Well, back in the days of coal-fired Lisp this was a real problem. Coal-fired Lisp systems had primitive compilers made of wood shavings and sawdust and ran on computers which were very slow indeed. So people would write things which should semantically be functions as macros so the wood-shaving compiler would inline the code. And sometimes this was even worth it.
But now we have advanced compilers (probably still mostly made of wood shavings and sawdust though) and we can say what we actually mean:
(declaim (inline not-sample-macro-any-more))
(defun not-sample-macro-any-more (it)
(if (typep it 'sample-class)
(progn
(print "evaluated")
(print (slot-1 it)))))
And now you can be reasonably assured that not-sample-macro-any-more will be compiled inline.
Even better in this case (but at the cost of almost certainly not having the inlining stuff):
(defgeneric not-even-slightly-sample-macro (it)
(:method (it)
(declare (ignore it))
nil))
(defmethod not-even-slightly-sample-macro ((it sample-class))
(print "evaluated")
(print (slot-1 it)))
So the summary here is:
Use macros for what they are for, which is transforming source code. If you don't want to do that, use functions. If you are sure the that the act of calling the functions is taking up lots of time, then consider declaring them inline to avoid that.
The other answers explained that macro execution is about transforming source code and values available at macro expansion time.
Let's also try to understand the error message. We need to take it literally:
Execution of a form compiled with errors.
Above says that it is about compilation.
Form:
(SAMPLE-MACRO *SAMPLE-INSTANCE*)
Above is the source form which is to be compiled.
Compile-time error:
(during macroexpansion of (SAMPLE-MACRO *SAMPLE-INSTANCE*))
Again: compilation and now specifically during macro expansion.
There is no applicable method for the generic function
#<STANDARD-GENERIC-FUNCTION COMMON-LISP-USER::SLOT-1 (1)>
when called with arguments
(*SAMPLE-INSTANCE*).
Now above is the interesting part: there is no applicable method for the generic function SLOT-1 and the argument *SAMPLE-INSTANCE*.
What is *SAMPLE-INSTANCE*? It's a symbol. In your code is a method, but it is for instances of class sample-class. But there is no method for symbols. So this will not work:
(setf p '*sample-instance*)
(slot-1 p)
That's basically what your code did. You expected to work with runtime values, but all you got at compile time was a source symbol...
The compiler error message showing a compile time error with a source-code element is an indication that there is mixup of runtime and macro-expansion time computation.
See also:
The ANSI Standard, Section 7.6.6
[Condition of type SB-INT:COMPILED-PROGRAM-ERROR]
To understand what the macro is doing, let's use macroexpand.
(macroexpand-1 '(sample-macro *sample-instance*))
=>
There is no applicable method for the generic function
#<STANDARD-GENERIC-FUNCTION COMMON-LISP-USER::SLOT-1 (1)>
when called with arguments
(*SAMPLE-INSTANCE*).
[Condition of type SB-PCL::NO-APPLICABLE-METHOD-ERROR]
Oops, same error message. I will simplify the macro and remove the evaluation around slot-1.
(defmacro sample-macro (p)
`(if (typep ,p 'sample-class)
(progn
(print "evaluated")
(print (slot-1 p)))))
(macroexpand-1 '(sample-macro *sample-instance*))
=>
(IF (TYPEP *SAMPLE-INSTANCE* 'SAMPLE-CLASS)
(PROGN (PRINT "evaluated") (PRINT (SLOT-1 P))))
The code looks good until the variable P. So will it work with, simply, ,p? No need to write ,(slot-1 p) since slot-1 is here correctly.
(defmacro sample-macro (p)
`(if (typep ,p 'sample-class)
(progn
(print "evaluated")
(print (slot-1 ,p)))))
(macroexpand-1 '(sample-macro *sample-instance*))
=>
(IF (TYPEP *SAMPLE-INSTANCE* 'SAMPLE-CLASS)
(PROGN (PRINT "evaluated") (PRINT (SLOT-1 *SAMPLE-INSTANCE*))))
The code looks correct.
(sample-macro *sample-instance*)
"evaluated"
"sample slot"
and it works.

registering a function in a list as it is being defined

I am trying to make a list of callback functions, which could look like this:
(("command1" . 'callback1)
("command2" . 'callback2)
etc)
I'd like it if I could could do something like:
(define-callback callback1 "command1" args
(whatever the function does))
Rather than
(defun callback1 (args)
(whatever the function does))
(add-to-list 'callback-info ("command1" . 'callback1))
Is there a convenient way of doing this, e.g., with macros?
This is a good example of a place where it's nice to use a two-layered approach, with an explicit function-based layer, and then a prettier macro layer on top of that.
Note the following assumes Common Lisp: it looks just possible from your question that you are asking about elisp, in which case something like this can be made to work but it's all much more painful.
First of all, we'll keep callbacks in an alist called *callbacks*:
(defvar *callbacks* '())
Here's a function which clears the alist of callbacks
(defun initialize-callbacks ()
(setf *callbacks* '())
(values)
Here is the function that installs a callback. It does this by searching the list to see if there is a callback with the given name, and if there is then replacing it, and otherwise installing a new one. Like all the functions in the functional layer lets us specify the test function which will let us know if two callback names are the same: by default this is #'eql which will work for symbols and numbers, but not for strings. Symbols are probably a better choice for the names of callbacks than strings, but we'll cope with that below.
(defun install-callback (name function &key (test #'eql))
(let ((found (assoc name *callbacks* :test test)))
(if found
(setf (cdr found) function)
(push (cons name function) *callbacks*)))
name)
Here is a function to find a callback, returning the function object, or nil if there is no callback with that name.
(defun find-callback (name &key (test #'eql))
(cdr (assoc name *callbacks* :test test)))
And a function to remove a named callback. This doesn't tell you if it did anything: perhaps it should.
(defun remove-callback (name &key (test #'eql))
(setf *callbacks* (delete name *callbacks* :key #'car :test test))
name)
Now comes the macro layer. The syntax of this is going to be (define-callback name arguments ...), so it looks a bit like a function definition.
There are three things to know about this macro.
It is a bit clever: because you can know at macro-expansion time what sort of thing the name of the callback is, you can decide then and there what test to use when installing the callback, and it does this. If the name is a symbol it also wraps a block named by the symbol around the body of the function definition, so it smells a bit more like a function defined by defun: in particular you can use return-from in the body. It does not do this if the name is not a symbol.
It is not quite clever enough: in particular it does not deal with docstrings in any useful way (it ought to pull them out of the block I think). I am not sure this matters.
The switch to decide the test uses expressions like '#'eql which reads as (quote (function eql)): that is to avoid wiring in functions into the expansion because functions are not externalisable objects in CL. However I am not sure I have got this right: I think what is there is safe but it may not be needed.
So, here it is
(defmacro define-callback (name arguments &body body)
`(install-callback ',name
,(if (symbolp name)
`(lambda ,arguments
(block ,name
,#body))
`(lambda ,arguments
,#body))
:test ,(typecase name
(string '#'string=)
(symbol '#'eql)
(number '#'=)
(t '#'equal))))
And finally here are two different callbacks being defined:
(define-callback "foo" (x)
(+ x 3))
(define-callback foo (x)
(return-from foo (+ x 1)))
These lists are called assoc lists in Lisp.
CL-USER 120 > (defvar *foo* '(("c1" . c1) ("c2" . c2)))
*FOO*
CL-USER 121 > (setf *foo* (acons "c0" `c1 *foo*))
(("c0" . C1) ("c1" . C1) ("c2" . C2))
CL-USER 122 > (assoc "c1" *foo* :test #'equal)
("c1" . C1)
You can write macros for that, but why? Macros are advanced Lisp and you might want to get the basics right, first.
Some issues with you example you might want to check out:
what are assoc lists?
what are useful key types in assoc lists?
why you don't need to quote symbols in data lists
variables are not quoted
data lists need to be quoted
You can just as easy create such lists for callbacks without macros. We can imagine a function create-callback, which would be used like this:
(create-callback 'callback1 "command1"
(lambda (arg)
(whatever the function does)))
Now, why would you use a macro instead of a plain function?
In the end, assisted by the responders above, I got it down to something like:
(defmacro mk-make-command (name &rest body)
(let ((func-sym (intern (format "mk-cmd-%s" name))))
(mk-register-command name func-sym)
`(defun ,func-sym (args &rest rest)
(progn
,#body))))

List gensym symbol not evaluating inside macro

I'm trying to write a macro that takes a list of variables and a body of code and makes sure variables revert to their original values after body of code is executed (exercise 10.6 in Paul Graham's ANSI Common Lisp).
However, I'm unclear on why my gensym evaluates as I expect it to in one place, but not another similar one (note: I know there's a better solution to the exercise. I just want to figure out why the difference in evaluation).
Here's the first definition where the lst gensym evaluates to a list inside of the lambda passed to the mapcar:
(defmacro exec-reset-vars-1 (vars body)
(let ((lst (gensym)))
`(let ((,lst ,(reduce #'(lambda (acc var) `(cons ,(symbol-value var) ,acc))
vars
:initial-value nil)))
,#body
,#(mapcar #'(lambda (var) `(setf ,var (car ,lst)))
vars))))
But while it works exactly as I expect it to, it's not a correct solution to the exercise because I'm always grabbing the first element of lst when trying to reset values. I really want to map over 2 lists. So now I write:
(defmacro exec-reset-vars-2 (vars body)
(let ((lst (gensym)))
`(let ((,lst ,(reduce #'(lambda (acc var) `(cons ,(symbol-value var) ,acc))
vars
:initial-value nil)))
,#body
,#(mapcar #'(lambda (var val) `(setf ,var ,val))
vars
lst))))
But now I get an error that says #:G3984 is not a list. If I replace it with (symbol-value lst) I get an error saying variable has no value. But why not? Why does it have a value inside of the setf in lambda, but not as an argument passed to mapcar?
At macroexpansion time you try to map over the value of lst, which is a symbol at that time. So that makes no sense.
Trying to get symbol value also makes no sense, since lst's bindings are lexical and symbol-value is not a way to access that. Other bindings are not available at that time.
Clearly lst has a value at macroexpansion time: a symbol. This is what you see inside the lambda.
You need to make clear what values are computed at macroexpansion time and which at runtime.
An advice about naming:
lst is a poor name in Lisp, use list
the name lst makes no sense, since its value is not a list, but a symbol. I'd call it list-variable-symbol. Looks long, doesn't it? But it is much clearer. You would now that it is a symbol, used as the name for a variable holding lists.
I'm pretty sure you are overthinking it. Imagine this:
(defparameter *global* 5)
(let ((local 10))
(with-reset-vars (local *global*)
(setf *global* 20)
(setf local 30)
...))
I imagine the expansion is as easy as:
(defparameter *global* 5)
(let ((local 10))
(let ((*global* *global*) (local local))
(setf *global* 20)
(setf local 30)
...)
(print local)) ; prints 10
(print *global*) ; prints 5
let does the reset on it's own so you see that the macro should be very simple just making shadow bindings with let, unless I have misunderstood the assignment.
Your overly complicated macros does pretty bad things. Like getting values of global symbols compile time, which would reset them to the time the function that used this instead of before the body.

Capturing Macros in Scheme

What's the simplest way to define a capturing macro using define-syntax or define-syntax-rule in Racket?
As a concrete example, here's the trivial aif in a CL-style macro system.
(defmacro aif (test if-true &optional if-false)
`(let ((it ,test))
(if it ,if-true ,if-false)))
The idea is that it will be bound to the result of test in the if-true and if-false clauses. The naive transliteration (minus optional alternative) is
(define-syntax-rule (aif test if-true if-false)
(let ((it test))
(if it if-true if-false)))
which evaluates without complaint, but errors if you try to use it in the clauses:
> (aif "Something" (displayln it) (displayln "Nope")))
reference to undefined identifier: it
The anaphora egg implements aif as
(define-syntax aif
(ir-macro-transformer
(lambda (form inject compare?)
(let ((it (inject 'it)))
(let ((test (cadr form))
(consequent (caddr form))
(alternative (cdddr form)))
(if (null? alternative)
`(let ((,it ,test))
(if ,it ,consequent))
`(let ((,it ,test))
(if ,it ,consequent ,(car alternative)))))))))
but Racket doesn't seem to have ir-macro-transformer defined or documented.
Racket macros are designed to avoid capture by default. When you use define-syntax-rule it will respect lexical scope.
When you want to "break hygiene" intentionally, traditionally in Scheme you have to use syntax-case and (carefully) use datum->syntax.
But in Racket the easiest and safest way to do "anaphoric" macros is with a syntax parameter and the simple define-syntax-rule.
For example:
(require racket/stxparam)
(define-syntax-parameter it
(lambda (stx)
(raise-syntax-error (syntax-e stx) "can only be used inside aif")))
(define-syntax-rule (aif condition true-expr false-expr)
(let ([tmp condition])
(if tmp
(syntax-parameterize ([it (make-rename-transformer #'tmp)])
true-expr)
false-expr)))
I wrote about syntax parameters here and also you should read Eli Barzilay's Dirty Looking Hygiene blog post and Keeping it Clean with Syntax Parameters paper (PDF).
See Greg Hendershott's macro tutorial. This section uses anaphoric if as example:
http://www.greghendershott.com/fear-of-macros/Syntax_parameters.html
Although the answer above is the accepted way to implement aif in the Racket community, it has severe flaws. Specifically, you can shadow it by defining a local variable named it.
(let ((it 'gets-in-the-way))
(aif 'what-i-intended
(display it)))
The above would display gets-in-the-way instead of what-i-intended, even though aif is defining its own variable named it. The outer let form renders aif's inner let definition invisible. This is what the Scheme community wants to happen. In fact, they want you to write code that behaves like this so badly, that they voted to have my original answer deleted when I wouldn't concede that their way was better.
There is no bug-free way to write capturing macros in Scheme. The closest you can come is to walk down the syntax tree that may contain variables you want to capture and explicitly strip the scoping information that they contain, replacing it with new scoping information that forces them to refer to your local versions of those variables. I wrote three "for-syntax" functions and a macro to help with this:
(begin-for-syntax
(define (contains? atom stx-list)
(syntax-case stx-list ()
(() #f)
((var . rest-vars)
(if (eq? (syntax->datum #'var)
(syntax->datum atom))
#t
(contains? atom #'rest-vars)))))
(define (strip stx vars hd)
(if (contains? hd vars)
(datum->syntax stx
(syntax->datum hd))
hd))
(define (capture stx vars body)
(syntax-case body ()
(() #'())
(((subform . tl) . rest)
#`(#,(capture stx vars #'(subform . tl)) . #,(capture stx vars #'rest)))
((hd . tl)
#`(#,(strip stx vars #'hd) . #,(capture stx vars #'tl)))
(tl (strip stx vars #'tl)))))
(define-syntax capture-vars
(λ (stx)
(syntax-case stx ()
((_ (vars ...) . body)
#`(begin . #,(capture #'(vars ...) #'(vars ...) #'body))))))
That gives you the capture-vars macro, which allows you to explicitly name the variables from the body you'd like to capture. aif can then be written like this:
(define-syntax aif
(syntax-rules ()
((_ something true false)
(capture-vars (it)
(let ((it something))
(if it true false))))
((_ something true)
(aif something true (void)))))
Note that the aif I have defined works like regular Scheme's if in that the else-clause is optional.
Unlike the answer above, it is truly captured. It's not merely a global variable:
(let ((it 'gets-in-the-way))
(aif 'what-i-intended
(display it)))
The inadequacy of just using a single call to datum->syntax
Some people think that all you have to do to create a capturing macro is use datum->syntax on one of the top forms passed to your macro, like this:
(define-syntax aif
(λ (stx)
(syntax-case stx ()
((_ expr true-expr false-expr)
(with-syntax
((it (datum->syntax #'expr 'it)))
#'(let ((it expr))
(if it true-expr false-expr))))
((_ expr true-expr)
#'(aif expr true-expr (void))))))
Just using datum->syntax is only a 90% solution to writing capturing macros. It will work in most cases, but break in some cases, specifically if you incorporate a capturing macro written this way in another macro. The above macro will only capture it if the expr comes from the same scope as the true-expr. If they come from different scopes (this can happen merely by wrapping the user's expr in a form generated by your macro), then the it in true-expr will not be captured and you'll be left asking yourself "WTF won't it capture?"
You may be tempted to quick-fix this by using (datum->syntax #'true-expr 'it) instead of (datum->syntax #'expr 'it). In fact this makes the problem worse, since now you won't be able to use aif to define acond:
(define-syntax acond
(syntax-rules (else)
((_) (void))
((_ (condition . body) (else . else-body))
(aif condition (begin . body) (begin . else-body)))
((_ (condition . body) . rest)
(aif condition (begin . body) (acond . rest)))))
If aif is defined using the capture-vars macro, the above will work as expected. But if it's defined by using datum->syntax on the true-expr, the the addition of begin to the bodies will result in it being visible in the scope of acond's macro definition instead of the code that invoked acond.
The impossibility of really writing a capturing macro in Racket
This example was brought to my attention, and demonstrates why you just can't write a real capturing macro in Scheme:
(define-syntax alias-it
(syntax-rules ()
((_ new-it . body)
(let ((it new-it)) . body))))
(aif (+ 1 2) (alias-it foo ...))
capture-vars cannot capture the it in alias-it's macroexpansion, because it won't be on the AST until after aif is finished expanding.
It is not possible at all to fix this problem, because the macro definition of alias-it is most probably not visible from the scope of aif's macro definition. So when you attempt to expand it within aif, perhaps by using expand, alias-it will be treated as a function. Testing shows that the lexical information attached to alias-it does not cause it to be recognized as a macro for a macro definition written out of scope from alias-it.
Some would argue that this shows why the syntax-parameter solution is the superior solution, but perhaps what it really shows is why writing your code in Common Lisp is the superior solution.

Common Lisp: Method to minimize code duplication when defining setf expanders

Triggered from this question about setf expanders: defining setf-expanders in Common Lisp
When writing setf expanders for user-defined getters, I commonly find that there is code duplication in the getter and setter, as far as how the property is retrieved. For example:
CL-USER>
(defun new-car (lst)
(car lst))
NEW-CAR
CL-USER>
(defun (setf new-car) (new-value lst)
(setf (car lst) new-value))
(SETF NEW-CAR)
CL-USER>
(defparameter *lst* (list 5 4 3))
*LST*
CL-USER>
*lst*
(5 4 3)
CL-USER>
(setf (new-car *lst*) 3)
3
CL-USER>
*lst*
(3 4 3)
CL-USER>
Note how the (car lst) form, the actual accessor that already has a setf expander defined, is in both defuns. This has always annoyed me somewhat. It would be nice to be able to say on the first defun, 'hey, I'm defining a defun that's a getter, but I also want it to have a typical setf expander'.
Is there any way with the common lisp standard to express this? Has anyone else worried about this issue, and defined a macro that does this?
To be clear, what I'd like here is a way to define a getter and typical setter, where the way that the getter compiles down to common lisp forms that already have setters ((car lst), e.g.) is written only once in the code.
I also understand there are times where you wouldn't want to do this, b/c the setter needs to perform some side effects before setting the value. Or it's an abstraction that actually sets multiple values, or whatever. This question is less relevant in that situation. What I'm talking about here is the case where the setter does the standard thing, and just sets the place of the getter.
What you want can be achieved with the use of macros.
(defmacro define-place (name lambda-list sexp)
(let ((value-var (gensym)))
`(progn
(defun ,name ,lambda-list
,sexp)
(defun (setf ,name) (,value-var ,#lambda-list)
(setf ,sexp ,value-var)))))
(define-place new-chr (list)
(car list))
More information on macros can be found in Peter Seibel's book, Practical Common Lisp. Chapter 10 of Paul Graham's book "ANSI Common Lisp" is another reference.
Note how the (car lst) form, the actual accessor that already has a setf expander defined, is in both defuns.
But that's only apparently true before macro expansion. In your setter, the (car lst) form is the target of an assignment. It will expand to something else, like the call to some internal function that resembles rplaca:
You can do a similar thing manually:
(defun new-car (lst)
(car lst))
(defun (setf new-car) (new-value lst)
(rplaca lst new-value)
new-value)
Voilà; you no longer have duplicate calls to car; the getter calls car, and the setter rplaca.
Note that we manually have to return new-value, because rplaca returns lst.
You will find that in many Lisps, the built-in setf expander for car uses an alternative function (perhaps named sys:rplaca, or variations thereupon) which returns the assigned value.
The way we generally minimize code duplication when defining new kinds of places in Common Lisp is to use define-setf-expander.
With this macro, we associate a new place symbol with two items:
a macro lambda list which defines the syntax for the place.
a body of code which calculates and returns five pieces of information, as five return values. These are collectively called the "setf expansion".
The place-mutating macros like setf use the macro lambda list to destructure the place syntax and invoke the body of code which calculates those five pieces. Those five pieces are then used to generate the place accessing/updating code.
Note, nevertheless, that the last two items of the setf expansion are the store form and the access form. We can't get away from this duality. If we were defining the setf expansion for a car-like place, our access form would invoke car and the store form would be based on rplaca, ensuring that the new value is returned, just like in the above two functions.
However there can exist places for which a significant internal calculation can be shared between the access and the store.
Suppose we were defining my-cadar instead of my-car:
(defun new-cadar (lst)
(cadar lst))
(defun (setf new-cadar) (new-value lst)
(rplaca (cdar lst) new-value)
new-value)
Note how if we do (incf (my-cadar place)), there is a wasteful duplicate traversal of the list structure because cadar is called to get the old value and then cdar is called again to calculate the cell where to store the new value.
By using the more difficult and lower level define-setf-expander interface, we can have it so that the cdar calculation is shared between the access form and the store form. So that is to say (incf (my-cadar x)) will calculate (cadr x) once and store that to a temporary variable #:c. Then the update will take place by accessing (car #:c), adding 1 to it, and storing it with (rplaca #:c ...).
This looks like:
(define-setf-expander my-cadar (cell)
(let ((cell-temp (gensym))
(new-val-temp (gensym)))
(values (list cell-temp) ;; these syms
(list `(cdar ,cell)) ;; get bound to these forms
(list new-val-temp) ;; these vars receive the values of access form
;; this form stores the new value(s) into the place:
`(progn (rplaca ,cell-temp ,new-val-temp) ,new-val-temp)
;; this form retrieves the current value(s):
`(car ,cell-temp))))
Test:
[1]> (macroexpand '(incf (my-cadar x)))
(LET* ((#:G3318 (CDAR X)) (#:G3319 (+ (CAR #:G3318) 1)))
(PROGN (RPLACA #:G3318 #:G3319) #:G3319)) ;
T
#:G3318 comes from cell-temp, and #:G3319 is the new-val-temp gensym.
However, note that the above defines only the setf expansion. With the above, we can only use my-cadar as a place. If we try to call it as a function, it is missing.
Working from Mark's approach, Rainer's post on macro-function, and Amalloy's post on transparent macrolet, I came up with this:
(defmacro with-setters (&body body)
`(macrolet ((defun-mod (name args &body body)
`(,#(funcall (macro-function 'defun)
`(defun ,name ,args ,#body) nil))))
(macrolet ((defun (name args &body body)
`(progn
(defun-mod ,name ,args ,#body)
(defun-mod (setf ,name) (new-val ,#args)
(setf ,#body new-val)))))
(progn
,#body))))
To use:
Clozure Common Lisp Version 1.8-r15286M (DarwinX8664) Port: 4005 Pid: 41757
; SWANK 2012-03-06
CL-USER>
(with-setters
(defun new-car (lst)
(car lst))
(defun new-first (lst)
(first lst)))
(SETF NEW-FIRST)
CL-USER>
(defparameter *t* (list 5 4 3))
*T*
CL-USER>
(new-car *t*)
5
CL-USER>
(new-first *t*)
5
CL-USER>
(setf (new-first *t*) 3)
3
CL-USER>
(new-first *t*)
3
CL-USER>
*t*
(3 4 3)
CL-USER>
(setf (new-car *t*) 9)
9
CL-USER>
*t*
(9 4 3)
There are some variable capture issues here that should probably be attended to, before using this macro in production code.