Unquote splice without unquote splice? - common-lisp

Is it possible to write the following without using backquote?
(defmacro while (test &rest body)
`(do ()
((not ,test))
,#body))
Thought I'd try this as an experiment to understand benefit of backquote.
I got as far as this:
(let* ((test '(> 10))
(x 0)
(body '((princ x) (incf x))))
(list 'do nil (list (list 'not test))))
Which successfully generates:
(DO NIL ((NOT (> 10))))
To finish this I need a way to spread the n elements of the list body into the generated form.
I know that's the entire purpose of the unquote splice ,# but is this actually impossible without it? Curious... It's similar to what apply does but I don't want to call a function at this point obviously.

In your case the body contains the remaining forms to be evaluated, and can be added with LIST*:
(let* ((test '(> 10))
(x 0)
(body '((princ x) (incf x))))
(list* 'do
nil
(list (list 'not test))
body))
Another example, where the spliced list is not at the end:
`(,x ,#y ,z)
The above can be written without backquotes as:
(list* x (append y (list z)))

Related

How to implement recursion when defining a setf function?

From the book "ANSI Common Lisp", p. 100 ch 6.1 :
Suppose that a marble is a structure with a single field called color.
The function UNIFORM-COLOR takes a list of marbles and returns
their color, if they all have the same color, or nil if they have
different colors.
UNIFORM-COLOR is usable on a setf place in order to make the color
of each element of list of marbles be a specific color.
(defstruct marble color)
(defun uniform-color (lst &optional (color (and lst (marble-color (car lst)))))
(every #'(lambda (m) (equal (marble-color m) color)) lst))
(defun (setf uniform-color) (color lst)
(mapc #'(lambda (m) (setf (marble-color m) color)) lst))
How could you implement the defun (setf uniform) in a tail-recursive way instead of using the mapc applicative operator ?
This question is specific to the case of (defun (setf ...)), it is not a question about how recursion or tail-recursion work in general.
i guess you can just call setf recursively:
(defun (setf all-vals) (v ls)
(when ls
(setf (car ls) v)
(setf (all-vals (cdr ls)) v)))
CL-USER> (let ((ls (list 1 2 3 4)))
(setf (all-vals ls) :new-val)
ls)
;;=> (:NEW-VAL :NEW-VAL :NEW-VAL :NEW-VAL)
this is how sbcl expands this:
(defun (setf all-vals) (v ls)
(if ls
(progn
(sb-kernel:%rplaca ls v)
(let* ((#:g328 (cdr ls)) (#:new1 v))
(funcall #'(setf all-vals) #:new1 #:g328)))))
For the specific case of marbles:
(defun (setf uniform-color) (color lst)
(when lst
(setf (marble-color (car lst)) color)
(setf (uniform-color (cdr lst)) color)))
General case
The answer is the same for setf functions and regular functions.
Let's say you have another function f that you want to call to print all the values in a list:
(defun f (list)
(mapc 'print list))
You can rewrite it recursively, you have to consider the two distinct case of recursion for a list, either it is nil or a cons cell:
(defun f (list)
(etypecase list
(null ...)
(cons ...)))
Typically in the null case (this is a type), you won't do anything.
In the general cons case (this is also a type), you have to process the first item and recurse:
(defun f (list)
(etypecase list
(null nil)
(cons
(print (first list))
(f (rest list)))))
The call to f is in tail position: its return value is the return value of the enclosing f, no other processing is done to the return value.
You can do the same with your function.
Note
It looks like the setf function defined in the book does not return the value being set (the color), which is bad practice as far as I know:
all that is guaranteed is that the expansion is an update form that works for that particular implementation, that the left-to-right evaluation of subforms is preserved, and that the ultimate result of evaluating setf is the value or values being stored.
5.1.1 Overview of Places and Generalized Reference
Also, in your specific case you are subject to 5.1.2.9 Other Compound Forms as Places, which also says:
A function named (setf f) must return its first argument as its only value in order to preserve the semantics of setf.
In other words (setf uniform-color) should return color.
But apart from that, the same section guarantees that a call to (setf (uniform-color ...) ...) expands into a call to the function named (setf uniform-color), so it can be a recursive function too. This could have been a problem if this was implemented as macro that expands into the body of your function, but fortunately this is not the case.
Implementation
Setting all the colors in a list named marbles to "yellow" is done as follows:
(setf (uniform-color marbles) "yellow")
You can define (setf uniform-color) recursively by first setting the color of the first marble and then setting the color of the rest of the marbles.
A possible tail-recursive implementation that respects the semantics of setf is:
(defun (setf uniform-color) (color list)
(if list
(destructuring-bind (head . tail) list
(setf (marble-color head) color)
(setf (uniform-color tail) color))
color))

Lisp exit defun function with nil as value

I'm trying to do a recursive version of the function position called positionRec. The objective is define the position of an element in a list, and if the element is not in the list return "nil". For exemple:
(positionRec 'a '(b c d a e)) => 4
(positionRec 'a '(b c d e)) => nil
I have written:
(defun positionRec (c l)
(cond
((atom l) (return nil))
((equal c (first l)) 1)
(t (+ 1 (positionRec c (rest l)))) ) )
I don't succeed to return nil. I have an error "*** - return-from: no block named nil is currently visible"
Anyone can teach me how to do it?
Lisp is an expression language: it has only expressions an no statemends. This means that the value of a call to a function is simply the value of the last form involved in that call This is different than many languages which have both statements and expressions and where you have to explicitly litter your code with explicit returns to say what the value of a function call is.
A cond form in turn is an expression. The value of an expression like
(cond
(<test1> <test1-form1> ... <test1-formn>)
(<test2> <test1-form1> ... <test1-formn>)
...
(<testn> <testn-form1> ... <testn-formnn>))
is the <testm-formn> of the first <testm> which is true, or nil if none of them are (and as a special case, if there are no forms after a test which is true the value is the value of that test).
So in your code you just need to make sure that the last form in the test which succeeds is the value you want:
(defun positionRec (c l)
(cond
((atom l) nil)
((equal c (first l)) 1)
(t (+ 1 (positionRec c (rest l))))))
So, what use is return? Well, sometimes you really do want to say 'OK, in the middle of some complicated loop or something, and I'm done now':
(defun complicated-search (...)
(dolist (...)
(dolist (...)
(dotimes (...)
(when <found-the-interesting-thing>
(return-from complicated-search ...))))))
return itself is simply equivalent to (return-from nil ...) and various constructs wrap blocks named nil around their bodies. Two such, in fact, are dotimes and dolist, so if you want to escape from a big loop early you can do that:
(defun complicated-search (...)
(dolist (...)
(when ...
(return 3)))) ;same as (return-from nil 3)
But in general because Lisp is an expression language you need to use return / return-from much less often than you do in some other languages.
In your case, the modified function is going to fail: if you get to the ((atom l) nil) case, then it will return nil to its parent which will ... try to add 1 to that. A better approach is to keep count of where you are:
(defun position-of (c l)
(position-of-loop c l 1))
(defun position-of-loop (c l p)
(cond
((atom l) nil)
((equal c (first l)) p)
(t (position-of-loop c (rest l) (1+ p)))))
Note that this (as your original) uses 1-based indexing: zero-based would be more compatible with the rest of CL.
It would probably be idiomatic to make position-of-loop a local function:
(defun position-of (c l)
(labels ((position-of-loop (lt p)
(cond
((atom lt) nil)
((equal c (first lt)) p)
(t (position-of-loop (rest lt) (1+ p))))))
(position-of-loop l 1)))
And you could then use an iteration macro if you wanted to make it a bit more concise:
(defun position-of (c l)
(iterate position-of-loop ((lt l) (p 1))
(cond
((atom lt) nil)
((equal c (first lt)) p)
(t (position-of-loop (rest lt) (1+ p))))))
The main problem is that you're trying to deal with incommensurable values. On the one hand, you want to deak with numbers, on the other, you want to deal with the empty list. You cannot add a number to a list, but you will inherently try doing so (you have an unconditional (1+ ...) call in your default branch in your cond).
There are ways to work around that, one being to capture the value:
(cond
...
(t (let ((val (positionRec c (rest l))))
(when val ;; Here we "pun" on nil being both false and the "not found" value
(1+ val)))))
Another would be to use a method amenable to tail-recursion:
(defun positionrec (element list &optional (pos 1))
(cond ((null list) nil)
((eql element (head list)) pos)
(t (positionrec element (rest list) (1+ pos)))))
The second function can (with a sufficently smart compiler) be turned into, basically, a loop. The way it works is by passing the return value as an optional parameter.
You could build a version using return, but you would probably need to make use of labels for that to be straight-forward (if you return nil directly from the function, it still ends up in the (1+ ...), where you then have numerical incompatibility) so I would go with either "explicitly capture the value and do the comparison against nil/false" or "the version amenable to tail-call elimination" and simply pick the one you find the most readable.

Clisp : select sublists with a given length

Working on CLISP in Sublime Text.
Exp. in CLISP : less than 1 year
It's already for a while that I'm trying to solve this exercice... without success... as you might guess.
In fact I have to create a function which will modify the list and keeps only sublists which are equals or greater than the given number (watch below)
The list on which I have to work :
(setq liste '((a b) c (d) (e f) (e g x) f))
I'm supposed to find this as result :
(lenght 2 liste) => ((a b) (e f) (e g x))
liste => ((a b) (e f) (e g x))
Here my code :
(defun lenght(number liste)
(cond
((atom liste) nil)
((listp (car liste))
(rplacd liste (lenght number (cdr liste))) )
((<= (lenght number (car liste)) number)
(I don't know what to write) )
((lenght number (cdr liste))) ) )
It will be very kind if you could give me only some clue so as to let me find the good result.
Thanks guys.
Modifying the list does not make much sense, because it gets hairy at the head of the list to retain the original reference. Return a new list.
This is a filtering operation. The usual operator in Common Lisp for that is remove-if-not (or remove-if, or remove, depending on the condition). It takes a predicate that should return whether the element should be kept. In this case, it seems to be (lambda (element) (and (listp element) (>= (length element) minlength))).
(defun filter-by-min-length (minlength list)
(remove-if-not (lambda (element)
(and (listp element)
(>= (length element) minlength)))
list))
In many cases, when the condition is known at compile time, loop produces faster compiled code:
(defun filter-by-min-length (minlength list)
(loop :for element :in list
:when (and (listp element)
(>= (length element) minlength))
:collect element))
This returns a new list that fulfills the condition. You'd call it like (let ((minlength-list (filter-by-min-length 2 raw-list))) …).
Many basic courses insist on recursively using primitive operations on cons cells for teaching purposes at first.
The first attempt usually disregards the possible stack exhaustion. At each step, you first look whether you're at the end (then return nil), whether the first element should be discarded (then return the result of recursing on the rest), or if it should be kept (then cons it to the recursion result).
If tail call optimization is available, you can refactor this to use an accumulator. At each step, instead of first recursing and then consing, you cons a kept value onto the accumulator and pass it to the recursion. At the end, you do not return nil, but reverse the accumulator and return that.
Well, I have found the answer that I was looking for, after scratching my head until blood...
Seriously, here is the solution which is working (and thanks for the correction about length which helped me to find the solution ^^) :
(defun filter-by-min-length (min-length liste)
(cond
((atom liste) nil)
((and (listp (car liste))(>= (length (car liste)) min-length))
(rplacd liste (filter-by-min-length min-length (cdr liste))) )
((filter-by-min-length min-length (cdr liste))) ) )
A non-modifying version
(defun filter-by-min-length (min-length le)
(cond ((atom le) nil)
((and (listp (car le)) (>= (length (car le)) min-length))
(cons (car le) (filter-by-min-length min-length (cdr le))))
(t (filter-by-min-length min-length (cdr le)))))
Test:
(defparameter *liste* '((a b) c (d) (e f) (e g x) f))
(filter-by-min-length 2 *liste*)
;; ((A B) (E F) (E G X))
*liste*
;; ((A B) C (D) (E F) (E G X) F) ; -> *liste* not modified
For building good habits, I would recommend to use defparameter instead of setq, since the behaviour of setq might not always be defined (see here). In the link, it is said:
use defvar, defparameter, or let to introduce new variables. Use setf
and setq to mutate existing variables. Using them to introduce new
variables is undefined behaviour

Explaining Lisp's dotimes: What is result-form doing?

I'm looking at the LispWorks Hyperspec on dotimes but I don't understand what the third variable [result-form] is doing. The examples are as follows:
(dotimes (temp-one 10 temp-one)) => 10
(setq temp-two 0) => 0
(dotimes (temp-one 10 t) (incf temp-two)) => T
temp-two => 10
The Hyperspec says
...Then result-form is evaluated. At the time result-form is
processed, var is bound to the number of times the body was executed.
Not sure what this is saying. Why is the third variable necessary in these two dotimes examples? I seem to be able to leave it out entirely in the second example and it works. My next example (not sure where I found it),
(defun thing (n)
(let ((s 0))
(dotimes (i n s)
(incf s i))))
Puzzles me as well. What use is s serving?
Since dotimes is a macro, looking at it's macro expansion can make things clearer:
Take your first example and expand it:
(pprint (MACROEXPAND-1 '(dotimes (temp-one 10 temp-one))))
I get the following output: (Yours may vary depending on the CL implementation)
(BLOCK NIL
(LET ((#:G8255 10) (TEMP-ONE 0))
(DECLARE (CCL::UNSETTABLE TEMP-ONE))
(IF (CCL::INT>0-P #:G8255)
(TAGBODY
#:G8254 (LOCALLY (DECLARE (CCL::SETTABLE TEMP-ONE))
(SETQ TEMP-ONE (1+ TEMP-ONE)))
(UNLESS (EQL TEMP-ONE #:G8255) (GO #:G8254))))
TEMP-ONE))
There's a lot going on, but the key thing to look at is that temp-one is bound to the value 0, and is returned as the expression's value (in standard lisp evaluation order).
Take the last example:
(pprint (macroexpand-1 '(dotimes (i n s) (incf s i))))
outputs:
(BLOCK NIL
(LET ((#:G8253 N) (I 0))
(DECLARE (CCL::UNSETTABLE I))
(IF (CCL::INT>0-P #:G8253)
(TAGBODY
#:G8252 (INCF S I)
(LOCALLY (DECLARE (CCL::SETTABLE I))
(SETQ I (1+ I)))
(UNLESS (EQL I #:G8253) (GO #:G8252))))
S))
As you can see S here is treated the same way as temp-one in the example before.
Try one without passing the last variable:
(pprint (macroexpand-1 '(dotimes (i n) (do-something i))))
and you get:
(BLOCK NIL
(LET ((#:G8257 N) (I 0))
(DECLARE (CCL::UNSETTABLE I))
(IF (CCL::INT>0-P #:G8257)
(TAGBODY
#:G8256 (DO-SOMETHING I)
(LOCALLY (DECLARE (CCL::SETTABLE I))
(SETQ I (1+ I)))
(UNLESS (EQL I #:G8257) (GO #:G8256))))
NIL))
Notice how NIL is the return value.

What's wrong with my Lisp code?

I have some lisp code that I have to write multiple different ways. I've tried two different ways and I'm unsure of why they don't work. The function has to take a list and return only integers in that list. The first one has to take a map function and the second one has to use loop. This is in Clisp.
Here is my code.
(defun posint1 (l)
(mapcan #'(lambda (x)
(and (integerp x)
(list l)))))
and
(defun posint1 (l)
(loop for x in (list l)
when (integerp x)
collect x)
(format t "~A " x))))
mapcan requires at least one list argument and you have supplied none in your first function (I can't use names since you call both the same)
The second function tried to format a variable, x, that does not exist in that scope. In loop x are the one element in (list l) which probably should just be l since making a one number list doesn't really need iteration. Perhaps you wanted something like:
(defun print-integers (list)
(loop :for x :in list
:when (integerp x)
:collect x :into result
:finally (format t "~A " result)))
;; or using the result as argument
(defun print-integers (list)
(format t
"~A "
(loop :for x :in list
:when (integerp x)
:collect x)))
(print-integers '(-1 0.5 1/3 +inf.0 9)) ; ==> NIL (prints (-1 9)
Also notice that integerp works for whole numbers, also negative ones. The name hinted that you might want to use (and (integerp x) (>= x 0)) instead.

Resources