I have about two macros (and climbing) in my codebase that look like this:
(defmacro def-stat-method (method-name stat)
`(progn
(defmethod ,method-name ((monster monster))
(getf (stats monster) ,stat))
(defmethod (setf ,method-name) (value (monster monster))
(setf (getf (stats monster) ,stat) value))))
and this:
(defmacro def-energy-method (method-name stat)
`(progn
(defmethod ,method-name ((monster monster))
(getf (energies monster) ,stat))
(defmethod (setf ,method-name) (value (monster monster))
(setf (getf (energies monster) ,stat) value))))
Each of the macros has the following calling syntax: (def-stat-method ranged-weapon :ranged-weapon)
I would like a macro (def-foo-method macro-name method) that expands into the appropriate macros so that (def-foo-method def-stat-method stats) expands into the first example above. I am a lisp newbie and don't really know how to do this. All help appreciated.
Just write a macro that expands into another defmacro, like this:
(defmacro def-foo-method (macro-name method)
`(defmacro ,macro-name (method-name stat)
(let ((method ',method))
`(progn
(defmethod ,method-name ((monster monster))
(getf (,method monster) ,stat))
(defmethod (setf ,method-name) (value (monster monster))
(setf (getf (,method monster) ,stat) value))))))
I think there might be a way to do this without the let, but nested backticks are confusing :)
To me that code looks slow. An object-oriented runtime dispatch plus a search on a property list? Why?
Sometimes property lists are added to CLOS objects to provide storage for not often used slots or to make them easily extensible (where all kinds of properties could be added without knowing them all before running the program). Generally it might be better to make the properties real slots of the object.
Related
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.
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.
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))))
I've got another question involving self-reference in Common Lisp. I found a thread on Stack Exchange which poses a problem of writing the shortest program that would print all printable ASCII characters NOT present in the program's source code. This got me thinking how to tackle the problem in Common Lisp. I hit against two problems - one probably trivial, the other more tricky:
First is the case of writing a CL script, e.g. starting with #!/usr/bin/env sbcl --script. I thought that through *posix-argv* I could access all command line arguments including the name of the called script. I also looked for the equivalent of Bash $0 but could find none. What worked for me in the end is this ugly Bash-ified SBCL script, which explicitly passes $0 to SBCL and proceeds from that:
#!/bin/bash
#|
sbcl --script $0 $0
exit
|#
(defun file-string (path)
(with-open-file (stream path)
(let ((data (make-string (file-length stream))))
(read-sequence data stream)
data)))
(let* ((printable (mapcar #'code-char (loop for i from #x20 to #x7e collect i)))
(absent (set-difference
printable
(coerce (file-string (cadr *posix-argv*)) 'list))))
(print (coerce absent 'string)))
My question regarding this point is: can you think of any way of doing it without relying so heavily on Bash supplying relevant arguments? Or, more briefly: is there a CL (SBCL in particular) equivalent of $0?
Now comes the part that I'm totally puzzled with. Before resorting to the script approach above I tried to accomplish this goal in a more REPL-oriented way. Based on the &whole specifier in defmacro and considerations in this thread I've tried to get the name of the macro from the &whole argument and somehow "read in" its source. And I have absolutely no idea how to do it. So in short: given the name of the macro, can I somehow obtain the defmacro form which defined it? And I'm talking about a generic solution, rather than parsing the REPL history.
EDIT: Regarding mbratch's question about use of macroexpand-1 here's how I do it:
(defmacro self-refer (&whole body)
(macroexpand-1 `',body))
With this call I'm able to obtain (SELF-REFER) by calling (SELF-REFER). Which isn't much of a solution...
I hope someone could point me in the right direction. Thanks!
Getting the source of a macro is not defined in Common Lisp.
This may work (Example from LispWorks):
CL-USER 10 > (defmacro foo (a b) `(* (+ ,a ,b) (+ ,a ,a)))
FOO
CL-USER 11 > (pprint (function-lambda-expression (macro-function 'foo)))
(LAMBDA
(DSPEC::%%MACROARG%% #:&ENVIRONMENT1106 &AUX (#:&WHOLE1107 DSPEC::%%MACROARG%%)
(#:\(A\ ...\)1108 (CDR #:&WHOLE1107))
(#:CHECK-LAMBDA-LIST-TOP-LEVEL1110
(DSPEC::CHECK-LAMBDA-LIST-TOP-LEVEL '(A B)
#:&WHOLE1107
#:\(A\ ...\)1108
2
2
'NIL
:MACRO))
(A (CAR (DSPEC::THE-CONS #:\(A\ ...\)1108)))
(#:\(B\)1109 (CDR (DSPEC::THE-CONS #:\(A\ ...\)1108)))
(B (CAR (DSPEC::THE-CONS #:\(B\)1109))))
(DECLARE (LAMBDA-LIST A B))
(BLOCK FOO `(* (+ ,A ,B) (+ ,A ,A))))
An even more esoteric way is to alter the existing DEFMACRO to record its source.
Many Lisp implementations have a non-standard feature called advising. LispWorks for example can advise macros:
CL-USER 31 > (defadvice (defmacro source-record-defmacro :after)
(&rest args)
(setf (get (second (first args)) :macro-source) (first args)))
T
Above adds code to the standard DEFMACRO macro, which records the source on the symbol property list of the macro name. defmacro is the name of the thing to advise. source-record-defmacro is the chosen name of this advice. :after then specifies that the code should run after the normal defmacro code.
CL-USER 32 > (defmacro foo (a b) `(* (+ ,a ,b) (+ ,a ,a)))
FOO
CL-USER 33 > (pprint (get 'foo :macro-source))
(DEFMACRO FOO (A B) `(* (+ ,A ,B) (+ ,A ,A)))
Again, this is completely non-standard - I'm not sure if a comparable mechanism exists for SBCL, though it has something called 'encapsulate'.
A very belated followup to Rainer Joswig's LispWorks solution. I've been using Allegro CL lately and discovered the fwrap facility. Conceptually it's very similar to the defadvice above and slighly more verbose. Here's a re-iteration of Rainer's example in ACL 10.0:
(def-fwrapper source-record-defmacro (&rest args)
(setf (get (second (first args)) :macro-source) (first args))
(call-next-fwrapper))
Having defined an fwrapper you need to "put it into action" explicitly:
(fwrap 'defmacro 'srd 'source-record-defmacro)
After this it's like in Rainer's example:
CL-USER> (defmacro foo (a b) `(* (+ ,a ,b) (+ ,a ,a)))
FOO
CL-USER> (pprint (get 'foo :macro-source))
(DEFMACRO FOO (A B) `(* (+ ,A ,B) (+ ,A ,A)))
; No value
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.