What is a didatic example of the with-slots macro in CLOS? - macros

The Common Lisp HyperSpec covers the with-slots macro. However, the example is hard to grasp.
Is there an easier and more didactic example about it?

To better understand with-slots, one should look into defclass first.
No reader or writer functions are defined by default; their generation must be explicitly requested. However, slots can always be accessed using slot-value.
It means that, unless specific request, defclass don't create any accessor for the slots:
> (defclass point ()
(x y))
(let ((new-point (make-instance 'point)))
(setf (point-x new-point) 1))
Error: The function (COMMON-LISP:SETF COMMON-LISP-USER::POINT-X) is undefined.
In this case, one must use the slot-value function to access or modify the slot value.
(defclass point ()
(x y))
(let ((new-point (make-instance 'point)))
(setf (slot-value new-point 'x) 1))
Obviously, when there are several slots to update, the code become a little cumbersome:
(defmethod translate ((point-instance point) delta-x delta-y)
(setf (slot-value point-instance 'x)
(+ (slot-value point-instance 'x) delta-x))
(setf (slot-value point-instance 'y)
(+ (slot-value point-instance 'y) delta-y)))
For that reason, the with-slots macro can make the code easier to read:
(defmethod translate ((point-instance point) delta-x delta-y)
(with-slots (x y) point-instance
(setf x (+ x delta-x))
(setf y (+ y delta-y))))

Yes. This (great) tutorial of 2003 has a good one from the geometry domain.
Create a class to represent points in 3-dimensions:
(defclass point ()
(x y z))
Create a variable to instantiate the class and a function to set the values:
(defvar my-point
(make-instance 'point))
(defun set-point-values (point x y z)
(setf (slot-value point 'x) x
(slot-value point 'y) y
(slot-value point 'z) z))
In the REPL, do:
CL-USER 17 > (set-point-values my-point 3 4 12)
12
Now, think about a function to compute the distance between points. A brute force way would be:
(defun brute-force-distance-from-origin (point)
(let ((x (slot-value point 'x))
(y (slot-value point 'y))
(z (slot-value point 'z)))
(sqrt (+ (* x x)
(* y y)
(* z z)))))
Using the with-slots macro:
(defun distance-from-origin (point)
(with-slots (x y z) point (sqrt (+ (* x x)
(* y y)
(* z z)))))
Calling the function in the REPL works as expected:
CL-USER> (distance-from-origin my-point)
13.0

Related

Why this symbol expasion is being malformed in Common Lisp?

I am trying to do the exercises on this tutorial about CLOS using SBCL and Slime (Emacs).
I have this class, instance, and function to set values for the slots:
(defclass point ()
(x y z))
(defvar my-point
(make-instance 'point))
(defun with-slots-set-point-values (point a b c)
(with-slots (x y z) point (setf x a y b z c)))
Using the REPL, it works fine:
CL-USER> (with-slots-set-point-values my-point 111 222 333)
333
CL-USER> (describe my-point)
#<POINT {1003747793}>
[standard-object]
Slots with :INSTANCE allocation:
X = 111
Y = 222
Z = 333
; No value
Now, the exercises indicates that using the symbol-macrolet I need to implement my version of with-slots.
I have a partial implementation of my with-slots (I still need to insert add the operation):
(defun partial-my-with-slots (slot-list object)
(mapcar #'(lambda (alpha beta) (list alpha beta))
slot-list
(mapcar #'(lambda (var) (slot-value object var)) slot-list)))
It works when calling it:
CL-USER> (partial-my-with-slots '(x y z) my-point)
((X 111) (Y 222) (Z 333))
Since this use of symbol-macrolet works:
CL-USER> (symbol-macrolet ((x 111) (y 222) (z 333))
(+ x y z))
666
I tried doing:
CL-USER> (symbol-macrolet (partial-my-with-slots '(x y z) my-point)
(+ x y z))
But, for some reason that I do not know, Slime throws the error:
malformed symbol/expansion pair: PARTIAL-MY-WITH-SLOTS
[Condition of type SB-INT:SIMPLE-PROGRAM-ERROR]
Why does this happen? How can I fix this?
You can't write with-slots as a function which is called at run time. Instead it needs to be a function which takes source code as an argument and returns other source code. In particular if given this argument
(my-with-slots (x ...) <something> <form> ...)
It should return this result:
(let ((<invisible-variable> <something))
(symbol-macrolet ((x (slot-value <invisible-variable>)) ...)
<form> ...))
You need <invisible-variable> so you evaluate <object-form> only once.
Well, here is a function which does most of that:
(defun mws-expander (form)
(destructuring-bind (mws (&rest slot-names) object-form &rest forms) form
(declare (ignore mws))
`(let ((<invisible-variable> ,object-form))
(symbol-macrolet ,(mapcar (lambda (slot-name)
`(,slot-name (slot-value <invisible-variable>
',slot-name)))
slot-names)
,#forms))))
And you can check this:
> (mws-expander '(my-with-slots (x y) a (list x y)))
(let ((<invisible-variable> a))
(symbol-macrolet ((x (slot-value <invisible-variable> 'x))
(y (slot-value <invisible-variable> 'y)))
(list x y)))
So that's almost right, except the invisible variable really needs to be invisible:
(defun mws-expander (form)
(destructuring-bind (mws (&rest slot-names) object-form &rest forms) form
(declare (ignore mws))
(let ((<invisible-variable> (gensym)))
`(let ((,<invisible-variable> ,object-form))
(symbol-macrolet ,(mapcar (lambda (slot-name)
`(,slot-name (slot-value ,<invisible-variable>
',slot-name)))
slot-names)
,#forms)))))
And now:
> (mws-expander '(my-with-slots (x y) a (list x y)))
(let ((#:g1509 a))
(symbol-macrolet ((x (slot-value #:g1509 'x))
(y (slot-value #:g1509 'y)))
(list x y)))
Well, a function which takes source code as an argument and returns other source code is a macro. So, finally, we need to install this function as a macroexpander, arranging to ignore the second argument that macro functions get:
(setf (macro-function 'mws)
(lambda (form environment)
(declare (ignore environment))
(mws-expander form)))
And now:
> (macroexpand '(mws (x y) a (list x y)))
(let ((#:g1434 a))
(symbol-macrolet ((x (slot-value #:g1434 'x)) (y (slot-value #:g1434 'y)))
(list x y)))
This would be more conventionally written using defmacro, of course:
(defmacro mws ((&rest slot-names) object-form &rest forms)
(let ((<invisible-variable> (gensym)))
`(let ((,<invisible-variable> ,object-form))
(symbol-macrolet ,(mapcar (lambda (slot-name)
`(,slot-name (slot-value ,<invisible-variable> ',slot-name)))
slot-names)
,#forms))))
However the two definitions are equivalent (modulo needing some eval-whenery to make the first work properly with the compiler).
You need to return expressions that will call slot-value when substituted into the macro expansion, rather than calling the function immediately. Backquote is useful for this.
(defun partial-my-with-slots (slot-list object)
(mapcar #'(lambda (alpha beta) (list alpha beta))
slot-list
(mapcar #'(lambda (var) `(slot-value ,object ',var)) slot-list)))
> (partial-my-with-slots '(x y z) 'my-point)
((x (slot-value my-point 'x)) (y (slot-value my-point 'y)) (z (slot-value my-point 'z)))
You use this in your with-slots macro like this:
(defmacro my-with-slots ((&rest slot-names) instance-form &body body)
`(symbol-macrolet ,(partial-my-with-slots slot-names instance-form)
,#body))
> (macroexpand '(my-with-slots (x y z) point (setf x a y b z c)))
(SYMBOL-MACROLET ((X (SLOT-VALUE POINT 'X))
(Y (SLOT-VALUE POINT 'Y))
(Z (SLOT-VALUE POINT 'Z)))
(SETF X A
Y B
Z C))

Closure inside a Common Lisp Macro

In the following code how can i have the x and y variables to reflect the expressions given at macro call time?
(defmacro defrule (init-form &rest replication-patterns)
(let (rule-table)
`(destructuring-bind (p x y) ',init-form
#'(lambda (w h) (list x y)))))
When expanding a call like:
(defrule (70 (* 1/2 w) (+ h 3)))
it returns:
(DESTRUCTURING-BIND (P X Y) '(70 (* 1/2 W) (+ H 3))
#'(LAMBDA (W H) (LIST X Y)))
where the original expressions with W and H references are lost. I tried back-quoting the lambda function creation:
(defmacro defrule (init-form &rest replication-patterns)
(let (rule-table)
`(destructuring-bind (p x y) ',init-form
`#'(lambda (w h) (list ,x ,y)))))
But a same call:
(defrule (70 (* 1/2 w) (+ h 3)))
expands to:
(DESTRUCTURING-BIND
(P X Y)
'(70 (* 1/2 W) (+ H 3))
`#'(LAMBDA (W H) (LIST ,X ,Y)))
which returns a CONS:
#'(LAMBDA (W H) (LIST (* 1/2 W) (+ H 3)))
which can not be used by funcall and passed around like a function object easily. How can i return a function object with expressions i pass in as arguments for the x y part of the init-form with possible W H references being visible by the closure function?
You're getting a cons because you have the backquotes nested.
You don't need backquote around destructuring-bind, because you're destructuring at macro expansion time, and you can do the destructuring directly in the macro lambda list.
(defmacro defrule ((p x y) &rest replication-patterns)
(let (rule-table)
`#'(lambda (w h) (list ,x ,y))))
Looking at your code:
(defmacro defrule (init-form &rest replication-patterns)
(let (rule-table)
`(destructuring-bind (p x y) ',init-form
#'(lambda (w h) (list x y)))))
You want a macro, which expands into code, which then at runtime takes code and returns a closure?
That's probably not a good idea.
Keep in mind: it's the macro, which should manipulate code at macro-expansion time. At runtime, the code should be fixed. See Barmar's explanation how to improve your code.

lisp macro to build a list of an expression and it's evaluation

I'm trying to write a macro in Common Lisp that takes any number of expressions and builds a list containing each expression followed by its evaluation in a single line. For example, if I name my macro as
(defmacro list-builder (&rest exp)
...)
and I run
(let ((X 1) (Y 2)) (list-builder (+ X Y) (- Y X) X))
I want it to return:
'((+ X Y) 3 (- Y X) 1 X 1)
The best I've been able to do so far is get a list of the expressions using the code
(defmacro list-builder (&rest exp)
`',#`(',exp ,exp))
INPUT: (let ((X 1) (Y 2)) (list-builder (+ X Y) (+ Y X) X))
'((+ X Y) (+ Y X) X)
Strictly speaking, the macro itself cannot do that; what the macro must do is generate code in which the argument expressions are embedded in such a way that they are evaluated, and also in such a way that they are quoted.
Given (list-builder (+ x y) (+ y x) x) we would like to generate this code: (list '(+ x y) (+ x y) '(+ y x) (+ y x) 'x x).
We can split the macro into an top-level wrapper defined with defmacro and an expander function that does the bulk of the work of producing the list arguments; The macro's body just sticks the list symbol on it and returns it.
Macro helper functions have to be wrapped with a little eval-when dance in Common Lisp to make sure they are available in all conceivable situations that the macro might be processed:
(eval-when (:compile-toplevel :load-toplevel :execute)
(defun list-builder-expander (exprs)
(cond
((null exprs) nil)
((atom exprs) (error "list-builder: dotted syntax unsupported":))
(t (list* `',(car exprs) (car exprs)
(list-builder-expander (cdr exprs)))))))
(defmacro list-builder (&rest exprs)
(cons 'list (list-builder-expander exprs)))
A "slick" implementation, all in one defmacro, inside a single backquote expression, might go like this:
(defmacro list-builder (&rest exprs)
`(list ,#(mapcan (lambda (expr) (list `',expr expr)) exprs)))
The "dotted syntax unsupported" check we implemented before now becomes an error out of mapcan.
The lambda turns each expression E into the list ((quote E) E). mapcan catenates these lists together to form the arguments for list, which are then spliced into the (list ...) form with ,#.
The form `',expr follows from applying the quote shorthand to `(quote ,expr).
Of course, a lisp macro can do that. Since lisp macros provide full control over evaluation of their arguments.
You have to use macro helper functions only in cases in which you want to use recursion. Since macros have problems to call themselves recursively.
But by looping over the &rest rest argument, you can generate variadic macros (macros with arbitrary number of arguments) and still control the evaluation of each of its arguments.
After some trial and error cycles (macro construction is an incremental procedure, since macros are complex structures), I obtained the
"simpler" solution:
(defmacro list-builder (&rest rest)
`(list ,#(loop for x in `,rest
nconcing (list `',x x))))
Test by:
(let ((X 1)
(Y 2))
(list-builder (+ X Y) (- Y X) X))
;; ((+ X Y) 3 (- Y X) 1 X 1)
Sometimes, in loop constructs, instead of collect/collecting, use nconc/nconcing in combination with (list ...) to have more control over how the elements are consed together.
The
(list `',x x)
ensures, that the second x gets evaluated, while the first
`',x
places the content of x into the expression, while its quoting prevents the evluation of the expression placed for x.
The outer list in combination with the splicing of the loop construct into it,
finally captures (prevents) the intrinsic very final evaluation of the macro body.
(defmacro list-builder (&rest args)
`(let ((lst ',args)
(acc nil))
(dolist (v lst)
(push v acc)
(push (eval v) acc))
(nreverse acc)))
We could create the list builder macro to take rest parameters as you did (I simply renamed them as args for pseudo code). I'd create a quoted list (lst) of the expressions within the list, and an empty list (acc) to store the expressions and whatever they evaluate to later. Then we can use dolist to iterate through our list and push each expression to the list, followed by whatever it evaluates to by running eval on the expression. Then we can finally use nreverse to get the correct order for the list.
We can then call it:
(let ((x 1)
(y 2))
(declare (special x))
(declare (special y))
(list-builder (+ x y) (- y x) x))
The result will be:
((+ X Y) 3 (- Y X) 1 X 1)
CL-USER>

EVAL: undefined function NIL in Lisp

I'm trying to write a function named calculate that gets a list as an input, and calculates its value (works as a lambda calculus reducer).
Here's my code:
(defun substitue(x y z)
(cond ((atom z) (cond ((eq z y) x)
(T z)))
(T (cons (substitue x y (car z))
(substitue x y (cdr z))))))
(defun substitute-and-eval(x y z)
(eval (substitue x y z)))
(defun calculate(l)
(cond ((eq l nil) nil)
((atom l) (eval l))
(T (substitute-and-eval (calculate (cdr l))
(calculate (car l))
l))))
but when I call the following line in Lisp, I get the error:
(calculate '((lambda (x) (+ x 2))
(lambda (y) (y))
((lambda (z) (+ z 4)) 3)))
Error :
EVAL: undefined function NIL
So I traced the code and didn't find anywhere where I'm recursively calling eval on nil, so I couldn't find the problem. I also am not sure if my calculate function does what it should correctly. Since I'm a newbie in Lisp, I would appreciate any help.
If we call calculate on ((lambda (z) (+ z 4)) 3), it then calls calculate on the cdr of above, which is (3).
Then there is a call to (substitute-and-eval nil 3 '(3)). Which then tries to evaluate (nil)...
With a stepper the wrong call is easy to find, see STEP.

Conditional variable binding in Common Lisp

I want to execute a function with 2 local variables, but the values of these of these variables should depend on some condition. For example, let's say I have 2 variables x and y, and I want to swap them inside let if y > x. The swap should be temporary, I don't want to mutate state with rotatef. My code would look something like:
(setq x 2)
(setq y 1)
(let (if (> x y) ((x y) (y x)) ((x x) (y y)))
(cons x y)) ; should return (1 . 2)
But the expression inside let is not valid Lisp. How do I conditionally assign values to local variables? The work around is to put the body in flet and call it with different arguments, but it look clumsy:
(flet ((body (x y) (cons x y)))
(if (< x y)
(body x y)
(body y x)))
Multiple-value-bind and values
There are lots of alternatives, some of which have already been pointed out in other answers. I think that the question in the title ("Conditional variable binding in Common Lisp") is a nice case for multiple-value-bind and values. I've used different variable names in the following just to make it clear where x and y are, and where the original values are coming from. The names can be the same, though; this just shadows them inside.
(let ((a 3)
(b 2))
(multiple-value-bind (x y)
(if (< a b)
(values a b)
(values b a))
(cons x y)))
;=> (2 . 3)
Then, using a bit of macrology, we can make this a bit cleaner, much like coredump did:
(defmacro if-let (test bindings &body body)
"* Syntax:
let ({var | (var [then-form [else-form]])}*) declaration* form* => result*
* Description:
Similar to LET, but each binding instead of an init-form can have a
then-form and and else-form. Both are optional, and default to NIL.
The test is evaluated, then variables are bound to the results of the
then-forms or the else-forms, as by LET."
(let ((bindings (mapcar #'(lambda (binding)
(destructuring-bind (variable &optional then else)
(if (listp binding) binding (list binding))
(list variable then else)))
bindings)))
`(multiple-value-bind ,(mapcar 'first bindings)
(if ,test
(values ,#(mapcar 'second bindings))
(values ,#(mapcar 'third bindings)))
,#body)))
(pprint (macroexpand-1 '(if-let (< x y) ((x x y)
(y y x))
(cons x y))))
; (MULTIPLE-VALUE-BIND (X Y)
; (IF (< X Y)
; (VALUES X Y)
; (VALUES Y X))
; (CONS X Y))
(let ((a 3) (b 2))
(if-let (< a b)
((x a b)
(y b a))
(cons x y)))
;=> (2 . 3)
Comparison with progv
In terms of use, this has some similarities with sindikat's answer, but multiple-value-bind establishes bindings just like let does: lexical by default, but a global or local special declaration will make the bindings dynamic. On the other hand, progv establishes dynamic bindings. This means that if the bindings are entirely introduced by progv, you won't see much difference (except in trying to return closures), but that you can't shadow bindings. We can see this without having to do any conditional work at all. Here are two sample snippets. In the first, we see that the inner reference to x actually refers to the lexical binding, not the dynamic one established by progv. To refer to the one established by progv, you actually need to declare the inner reference to be special. progv doesn't accept declarations, but we can use locally.
(let ((x 1))
(progv '(x) '(2)
x))
;=> 1
(let ((x 1))
(progv '(x) '(2)
(locally (declare (special x))
x)))
;=> 2
multiple-value-bind actually does the binding the way we'd expect:
(let ((x 1))
(multiple-value-bind (x) (values 2)
x))
;=> 2
It's probably better to use a binding construct like multiple-value-bind that establishes lexical bindings by default, just like let does.
If you don't want to use progv, as mentioned by sindikat, you always can wtite something like that:
(defmacro let-if (if-condition then-bindings else-bindings &body body)
`(if ,if-condition
(let ,then-bindings
,#body)
(let ,else-bindings
,#body)))
So expression like
(let-if (> x y) ((x y) (y x)) ((x x) (y y))
(cons x y))
Will expand into:
(IF (> X Y)
(LET ((X Y) (Y X))
(CONS X Y))
(LET ((X X) (Y Y))
(CONS X Y)))
rotatef
How about:
CL-USER> (defvar x 2)
X
CL-USER> (defvar y 1)
Y
CL-USER> (let ((x x) ; these variables shadow previously defined
(y y)) ; X and Y in body of LET
(when (> x y)
(rotatef x y))
(cons x y))
(1 . 2)
CL-USER> x ; here the original variables are intact
2 ; ^
CL-USER> y ; ^
1 ; ^
However, I think that in every such practical case there are lispier ways to solve problem without macros. Answer by msandiford is probably the best from functional point of view.
psetf
Although rotatef is really efficient method (it probably would be compiled to about three machine instructions swapping pointers in memory), it is not general.
Rainer Joswing posted just a great solution as a comment shortly after posting of the question. To my shame, I checked macro psetf only few minutes ago, and this should be very efficient and general solution.
Macro psetf first evaluates its even arguments, then assigns evaluated values to variables at odd positions just like setf does.
So we can write:
(let ((x x)
(y y))
(when (> x y)
(psetf x y y x))
...)
And that's it, one can conditionally rebind anything to anything. I think it's way better than using macros. Because:
I don't think it's such a common situation;
Some macros in the posted answers repeat their body code, which may be really big: thus you get bigger compiled file (it's fair price for using macro, but not in this case);
Every custom macro does make code harder to understand for other people.
One solution is to use progv instead of let, its first argument is a list of symbols to bind values to, second argument is a list of values, rest is body.
(progv '(x y) (if (< x y) (list x y) (list y x))
(cons x y)) ; outputs (1 . 2)
Another alternative might be:
(let ((x (min x y))
(y (max x y)))
(cons x y))
My suggestion would be one of destructuring-bind or multiple-value-bind.
If you anticipate needing to do this a lot, I would suggest using a macro to generate the bindings. I've provided a possible macro (untested).
(defmacro cond-let (test-expr var-bindings &body body)
"Execute BODY with the VAR-BINDINGS in place, with the bound values depending on
the trueness of TEST-EXPR.
VAR-BINDINGS is a list of (<var> <true-value> <false-value>) with missing values
being replaced by NIL."
(let ((var-list (mapcar #'car var-bindings))
(then-values (mapcar #'(lambda (l)
(when (cdr l)
(nth 1 l)))
var-bindings))
(else-values (mapcar #'(lambda (l)
(when (cddr l))
(nth 2 l)))
var-bindings))
`(destructuring-bind ,var-list
(if ,test-expr
(list ,#then-values)
(list ,#else-values)))))