Use conditional places in setf - lisp

Lets say I have two variables and I want to set the variable with lower value to nil.
Is it possible to make it work this way?
(setf a1 5)
(setf a2 6)
(setf
(if (< a1 a2) a1 a2)
nil
)

If you want to do something close to this, you can use (setf (symbol-value var) ...):
> (defparameter a1 5)
> (defparameter a2 6)
> (setf (symbol-value (if (< a1 a2) 'a1 'a2)) nil)
> a1
nil
> a2
6
To get a syntax closer to the one in your question, you can define an setf-expanderfor if:
(defsetf if (cond then else) (value)
`(progn (setf (symbol-value (if ,cond ,then ,else)) ,value)
,value))
Then you can write (setf (if (< a1 a2) 'a1 'a2) nil)
However, the best way of writing the code is probably to do it straight forward, using an if with setf forms in both branches:
(if (< a1 a2)
(setf a1 nil)
(setf a2 nil))

No, because that if form is not a place and thus not setfable.

Although it's not very useful by itself, you might want to regard this as a little hint:
(defun new-values (x y)
(if (< x y) (values nil y) (values x nil)))
(setf a1 5)
(setf a2 6)
(setf (values a1 a2) (new-values a1 a2))

Related

Did anybody write when-let-cond?

I was thinking about a cond with a twist
(let ((a 0))
(let* ((result nil))
(tagbody
(let ((b1 (+ 0 a)))
(when (eq b1 1)
(print "1")
(setf result b1)
(go finish)))
(let ((b2 (+ 0 a)))
(when (eq b2 2)
(print "2")
(setf result b2)
(go finish)))
(when T
(print "else")
(setf result a))
(format t "=== ~A~%" a)
finish)
result))
where when test-form is wrapped in let. On one hand this seems to fit into a problem I am working on, but also seems overcomplicated. Can it be simplified with a macro? What would be the best way to simplify it if I had lots of test-forms?
Part of the problem in trying to do it that way is restricting the let blocks to only one test-form and its body.
But I wonder if I am going down the wrong path. Playing with an imaginary variant of when-let suggests there is no benefit of going down this path.
Trying cond
The version using cond appears to be more compact.
(let ((a 3))
(let* ((b1 (+ 0 a))
(b2 (+ 0 a)))
(cond
((eq b1 1)
(print "1")
b1)
((eq b2 2)
(print "2")
b2)
(T (print "else")
a))))
All boils down to the variables defined in the let* which in real life example would be used to avoid calculating the same value twice and improve readability. What should I do?
I'd prefer to think more in terms of blocks and returning values from them, instead working with goto and variables. If one really needs separate let-bound variables and their own scope:
(prog ((a 0))
(let ((b1 (+ 0 a)))
(when (eql b1 1)
(print "1")
(return b1)))
(let ((b2 (+ 0 a)))
(when (eql b2 2)
(print "2")
(return b2)))
(return
(progn
(print "else")
(return a))))
Somebody did now. I wanted it to be compatible with cond which raises a trouble: if you want the binding clauses to be like
(cond/binding
...
((var expr) <use var>)
...)
But you want to allow just general test clauses, then a function with one argument is ambiguous: should
(cond/binding
...
((car x) ...)
...)
call car or bind car? To make this work then you need to bind a useless variable in that case:
(cond/binding
...
((useless (car x)) <useless not used here>)
...)
And that means you either need to insert ignore or ignorable declarations all over the place, or live with compiler warnings.
So, well, I decided it would be better to go the other way: you have to say when you want to bind a variable. And you do that by a clause like:
(cond/binding
...
((bind var expr) <var is bound here>)
...)
And note that bind is magic in the syntax (so this means you can't call a function called bind, but that's OK as I already use bind as a keyword in other macros.
The macro also tries hard (well, hard given I basically just typed it in and it's had no testing) to actually behave like cond: returning multiple values, for instance.
So this:
(cond/binding
((f x y z) t)
((bind x 3) (print x) (values x t))
(t (values nil nil))
(1))
expands to
(block #:cond/binding
(when (f x y z)
(return-from #:cond/binding (progn t)))
(let ((x 3))
(when x
(return-from #:cond/binding
(progn (print x) (values x t)))))
(when t
(return-from #:cond/binding (progn (values nil nil))))
(let ((r 1))
(when r
(return-from #:cond/binding r))))
(where all the blocks are the same block).
So, here:
(defmacro cond/binding (&body clauses)
;; Like COND but it can bind variables. All clauses are (should be)
;; like COND, except that a clause of the form ((bind var <expr>)
;; ...) will bind a variable. Note that bind has to be literally
;; the symbol BIND: it's magic in the syntax.
(let ((bn (make-symbol "COND/BINDING")))
`(block ,bn
,#(mapcar
(lambda (clause)
(unless (consp clause)
(error "bad clause ~S" clause))
(case (length clause)
(1
`(let ((r ,(car clause)))
(when r (return-from ,bn r))))
(otherwise
(destructuring-bind (test/binding &body forms) clause
(typecase test/binding
(cons
(case (car test/binding)
((bind)
(unless (and (= (length test/binding) 3)
(symbolp (second test/binding)))
(error "bad binding clause ~S" test/binding))
(destructuring-bind (var expr) (rest test/binding)
`(let ((,var ,expr))
(when ,var
(return-from ,bn
(progn ,#forms))))))
(otherwise
`(when ,test/binding
(return-from ,bn
(progn ,#forms))))))
(t
`(when ,test/binding
(return-from ,bn
(progn ,#forms)))))))))
clauses))))
Caveat emptor.
If I understand you problem correctly, then you can use or and rely on the fact that when is evaluated to nil if the condition is not true, e.g.,
(defun example (a)
(or
(let ((b1 (+ 0 a)))
(when (eql b1 1)
(print "1")
b1))
(let ((b2 (+ 0 a)))
(when (eql b2 2)
(print "2")
b2))
(progn
(print "else")
a)))
Using macrolet is the best solution so far. That allows me to bypass the limitations of when-let and not all bindins in the let form have to evaluate to true.
(let ((a 3))
(let ((result nil))
(macrolet ((ret-go (res)
`(progn
(setf result ,res)
(go finish))))
(tagbody
(let ((b1 (+ 0 a)))
(when (eq b1 1)
(print "1")
(ret-go b1)))
(let ((b2 (+ 0 a)))
(when (eq b2 2)
(print "2")
(ret-go b2)))
(when T
(print "else")
(setf result a))
(format t "=== ~A~%" a)
finish)
result)))

How do I append a list recursively in common lisp?

(defun foo (in i out)
(if (>= i 0)
(progn
(append (list (intern (string (elt in i)))) out)
(print output)
(foo in (- i 1) out )
)
(out)
)
)
(print (foo "abcd" (- (length "abcd") 1) (list)))
I am trying to return this string as (a b c d). But it does return nil as output. What do I do wrong here? Thanks
I don’t know what this has to do with appending. I think your desired output is also weird and you shouldn’t do what you’re doing. The right object for a character is a character not a symbol. Nevertheless, a good way to get the list (a b c d) is as follows:
CL-USER> '(a b c d)
Interning symbols at runtime is weird so maybe you would like this:
(defconstant +alphabet+ #(a b c d e f g h i j k l m n o p q r s t u v w x y z))
(defun foo (seq)
(map 'list
(lambda (char)
(let ((index (- (char-code char) (char-code #\a))))
(if (< -1 index (length +alphabet+))
(svref +alphabet+ index)
(error "not in alphabet: ~c" char))))
seq))
You have just some minor mistakes. First, we need to get rid of output and (output); these bear no relation to the code. It seems you were working with a variable called output and then renamed it to out without fixing all the code. Moreover, (output) is a function call; it expects a function called output to exist.
Secondly, the result of append must be captured somehow; in the progn you're just discarding it. Here is a working version:
(defun foo (in i out)
(if (>= i 0)
(foo in (1- i) (cons (intern (string (elt in i))) out))
out))
Note also that instead of your (append (list X) Y), I'm using the more efficient and idiomatic (cons X Y). The result of this cons operation has to be passed to foo. The out argument is our accumulator that is threaded through the tail recursion; it holds how much of the list we have so far.
I.e. we can't have (progn <make-new-list> (foo ... <old-list>)); that just creates the new list and throws it away, and then just passes the old list to the recursive call. Since the old list initially comes as nil, we just keep passing along this nil and when the index hits zero, that's what pops out. We need (foo .... <make-new-list>), which is what I've done.
Tests:
[1]> (foo "" -1 nil)
NIL
[2]> (foo "a" 0 nil)
(|a|)
[3]> (foo "ab" 1 nil)
(|a| |b|)
[4]> (foo "abcd" 3 nil)
(|a| |b| |c| |d|)
[5]> (foo "abcd" 3 '(x y z))
(|a| |b| |c| |d| X Y Z)
Lastly, if you want the (|a| |b| |c| |d|) symbols to appear as (a b c d), you have to fiddle withreadtable-case.
Of course:
[6]> (foo "ABCD" 3 nil)
(A B C D)

Where is 'a1' bound in sortf from the book Let over Lambda?

The book "Let over Lambda" by Doug Hoyte describes a fast sorting function for fixed sized inputs via sorting networks:
(defmacro! sortf (comperator &rest places)
(if places
`(tagbody
,#(mapcar
#`(let ((,g!a #1=,(nth (car a1) places))
(,g!b #2=,(nth (cadr a1) places)))
(if (,comperator ,g!b ,g!a)
(setf #1# ,g!b
#2# ,g!a)))
(build-batcher-sn (length places))))))
Where does the symbol 'a1' in the expressions '(car a1)' and '(cadr a1)' come from?
Btw. 'defmacro!' is a macro to define macros that introduces 'g!{symbol}' syntax to create a fresh symbol via 'gensym'. And 'build-batcher-sn' builds a sorting network using Batcher's algorithm.
I found this strange as well as mapcar will only take a function and a let does not qualify. Thus there has to be something else and surpris surprise #` is a reader-macro that creates a function around the expression that follows:
'#`(list a b c)
; ==> (lambda (a1) `(list a b c))
Notice I quote it and since it's a read-macro it still expands but the result gets quoted. So a1 comes from the reader-macro. Here is it's definition and activation:
(defun |#`-reader| (stream sub-char numarg)
(declare (ignore sub-char))
(unless numarg (setq numarg 1))
`(lambda ,(loop for i from 1 to numarg
collect (symb 'a i))
,(funcall
(get-macro-character #\`) stream nil)))
(set-dispatch-macro-character
#\# #\` #'|#`-reader|)
And the code in question:
'#`(let ((,g!a #1=,(nth (car a1) places))
(,g!b #2=,(nth (cadr a1) places)))
(if (,comperator ,g!b ,g!a)
(setf #1# ,g!b
#2# ,g!a)))
; ==>
(lambda (a1)
`(let ((,g!a ,(nth (car a1) places))
(,g!b ,(nth (cadr a1) places)))
(if (,comperator ,g!b ,g!a)
(setf ,(nth (car a1) places) ,g!b ,(nth (cadr a1) places) ,g!a))))
To make use of more arguments you add the number in front:
'#2`(list ,a1 ,a2)
; ==> (lambda (a1 a2) `(list ,a1 ,a2))

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)))))

Difference between '(()) and (cons null null)

I am confused about the difference between '(()) and (cons null null) in scheme.
The code below show that b and c are completely the same thing.
(define (dup2 x)
(let ((d '(())))
(set-car! d (car x))
(set-cdr! d (cdr x))
d))
(define a '(1 2))
(define b (dup2 a))
(define c (dup2 a))
(set-car! b 2)
> c ;; --> (2 2)
However, when I used dup instead of dup2:
(define (dup x)
(let ((d (cons null null)))
(set-car! d (car x))
(set-cdr! d (cdr x))
d))
(define a '(1 2))
(define b (dup a))
(define c (dup a))
(set-car! b 2)
> c ;; --> (1 2)
Variable b and c are different. I have done some experiments, but I haven't understand yet.
The value of d in the first implementation is literal data, and is modified with undefined consequences. To highlight what's happening, consider the following code:
(define (incorrect-list-null-and-x x)
(let ((l '(()))) ; a list of the form (() . ())
(set-cdr! l (cons x (cdr l))) ; (cdr l) is (), so (cons x (cdr l)) should be (x . ()) == (x), right?
; and now l should be (() . (x . ())) == (() x), right?
l))
The expected result is that (incorrect-list-null-and-x n) should return a list of the form (() n), and it does the first time, but successive calls are still accessing the same data:
(incorrect-list-null-and-x 1) ;=> (() 1)
(incorrect-list-null-and-x 2) ;=> (() 2 1)
(incorrect-list-null-and-x 3) ;=> (() 3 2 1)
(incorrect-list-null-and-x 4) ;=> (() 4 3 2 1)
The same problem manifests itself a bit differently in your dup2. Every value returned from dup2 is actually the same pair:
(let* ((x (dup2 (cons 1 2)))
(y (dup2 (cons 3 4))))
(display x)
(display y))
outputs:
(3 . 4)(3 . 4)
because the call (dup2 (cons 3 4)) modifies the same structure that was previously returned by (dup2 (cons 1 2)).
Data literals, like '(()), are meant to be read-only, and modifying it using set-car! or set-cdr! has undefined behaviour. For predictable behaviour, use the (cons '() '()) version if you want to use set-car! or set-cdr! on it.
In particular, cons creates a new cons cell, whereas a data literal usually won't.
Still, for the purposes of implementing dup, why are you using set-car! and set-cdr! anyway? Just use cons directly:
(define (dup x)
(cons (car x) (cdr x)))
In your first code snippet you use (d '(())) which ends up binding a literal to d. You then modify the literal which is generally undefined. In your second code snippet you use (d (cons null null)) which binds d to a newly created 'cons cell' which you then modify. There is no problem modifying that.
Note: you've not defined null. Perhaps you meant '()?