I have this list code block.
(defun test (y)
(do
((l NIL (setq y (rest y))))
((null y) 1)
(setq l (append l '(1 1)))
(print l)
)
)
And the output is pictured below. For some reason it's setting l to y and then appending '(1 1). Can anyone explain this behavior?
The structure of a do loop is:
(do ((var init-form step-form))
(termination-form result-form)
(body))
I think what you're missing is that step-form is executed at every iteration and the result of this form is set to the variable. So using setq in the step-form is a flag that you're probably not doing what you intend.
So the sequence of the loop from (test '(2 3 4)) is (eliding the print)
- Initialize l to nil
- Check (null y) which is false since y = '(2 3 4).
- (setq l (append l '(1 1))) l now has the value '(1 1)
- Execute the step form, this sets y = '(3 4) _and_ l = '(3 4)
- (null y) still false.
- (setq l (append l '(1 1))) sets l = '(3 4 1 1)
- Execute step form, sets y = '(4) _and_ l = '(4)
- (setq l (append l '(1 1))) sets l = '(4 1 1)
- Execute step form, y = () so loop terminates.
Related
I have a list of two element sublists which will change and grow in the course of the program. I want to write a macro which takes a key and generates a case dynamically like:
;; This is the List for saving CASE clauses
(setf l '((number 2) (symbol 3)))
;; and i want to have the following expansion
(typecase 'y
(number 2)
(symbol 3))
I could have a macro which only refers to the global l:
(defmacro m (x)
`(typecase ,x ,#l))
which would expand correctly
(m 'y) ;expands to (TYPECASE 'Y (number 2) (symbol 3))
But how can i write the macro with a parameter for the list l so that it would work with other lists as well?
;; A macro which should generate the case based on the above list
(defmacro m (x l)
`(typecase ,x ,#l))
This doesn't work since l in the arguments list i a symbol and a call to (m 'y l) will expand to (TYPECASE 'Y . L).
Wanting to adhere to typecase mechanism, my workaround was as follows:
(setf types-x '(((integer 0 *) 38)
((eql neli) "Neli in X")
(symbol 39))
)
(setf types-y '(((eql neli) "Neli in Y")
((array bit *) "A Bit Vector")))
(defmacro m (x types-id)
(case types-id
(:x `(typecase ,x ,#types-x))
(:y `(etypecase ,x ,#types-y))))
(m 'neli :x) ;"Neli in X"
(m 'neli :y) ;"Neli in Y"
(m 'foo :x) ;39
Any hints and comments is appreciated.
You don't need a macro for what you're trying to do: use a function.
For instance, given
(defvar *type-matches*
'((float 0)
(number 1)
(t 3)))
Then
(defun type-match (thing &optional (against *type-matches*))
(loop for (type val) in against
when (typep thing type)
return (values val type)
finally (return (values nil nil))))
Will match a thing against a type:
> (type-match 1.0)
0
float
> (type-match 1)
1
number
You want to keep the variables sorted by type, which you can do by, for instance:
(setf *type-matches* (sort *type-matches* #'subtypep :key #'car))
You want to keep the matches sorted of course.
If you want to delay the execution of the forms then you can do something like this (this also deals with sorting the types):
(defvar *type-matches*
'())
(defmacro define-type-match (type/spec &body forms)
;; define a type match, optionally in a specified list
(multiple-value-bind (type var)
(etypecase type/spec
(symbol (values type/spec '*type-matches*))
(cons (values (first type/spec) (second type/spec))))
(let ((foundn (gensym "FOUND")))
`(let ((,foundn (assoc ',type ,var :test #'equal)))
(if ,foundn
(setf (cdr ,foundn) (lambda () ,#forms))
(setf ,var (sort (acons ',type (lambda () ,#forms) ,var)
#'subtypep :key #'car)))
',type/spec))))
(defun type-match (thing &optional (against *type-matches*))
(loop for (type . f) in against
when (typep thing type)
return (values (funcall f) type)
finally (return (values nil nil))))
The actual problem that you face is that if you do
(setf l '((number 2) (symbol 3)))
already on toplevel, if you evaluate l, you don't come further than
((number 2) (symbol 3))
So if you use l in a macro as an argument, you can't come further
than this. But what you need is to evaluate this form (modified after adding a typecase and an evaluated x upfront) once more within the macro.
This is, why #tfb suggested to write a function which actually evaluates the matching of the types specified in l.
So, we could regard his type-match function as a mini-interpreter for the type specifications given in l.
If you do a simple (defmacro m (x l) `(typecase ,x ,#l))
you face exactly that problem:
(macroexpand-1 '(m 1 l))
;; (typecase 1 . l)
but what we need is that l once more evaluated.
(defmacro m (x l)
`(typecase ,x ,#(eval l)))
Which would give the actually desired result:
(macroexpand-1 '(m 1 l))
;; (TYPECASE 1 (NUMBER 2) (SYMBOL 3)) ;
;; T
;; and thus:
(m 1 l) ;; 2
So far, it seems to work. But somewhere in the backhead it becomes itchy, because we know from books and community: "Don't use eval!! Eval in the code is evil!"
Trying around, you will find out when it will bite you very soon:
# try this in a new session:
(defmacro m (x l) `(typecase ,x ,#(eval l)))
;; m
;; define `l` after definition of the macro works:
(setf l '((number 2) (symbol 3)))
;; ((NUMBER 2) (SYMBOL 3))
(m 1 l)
;; 2 ;; so our `eval` can handle definitions of `l` after macro was stated
(m '(1 2) l)
;; NIL
;; even redefining `l` works!
(setf l '((number 2) (symbol 3) (list 4)))
;; ((NUMBER 2) (SYMBOL 3) (LIST 4))
(m 1 l)
;; 2
(m '(1 2) l)
;; 4 ;; and it can handle re-definitions of `l` correctly.
;; however:
(let ((l '((number 2) (symbol 3)))) (m '(1 2) l))
;; 4 !!! this is clearly wrong! Expected is NIL!
;; so our `eval` in the macro cannot handle scoping correctly
;; which is a no-go for usage!
;; but after re-defining `l` globally to:
(setf l '((number 2) (symbol 3)))
;; ((NUMBER 2) (SYMBOL 3))
(m '(1 2) l)
;; NIL ;; it behaves correctly
(let ((lst '((number 2) (symbol 3) (list 4)))) (m '(1 2) lst))
;; *** - EVAL: variable LST has no value
;; so it becomes clear: `m` is looking in the scoping
;; where it was defined - the global scope (the parent scope of `m` when `m` was defined or within the scope of `m`).
So the conclusion is:
The given macro with eval is NOT working correctly!!
Since it cannot handle local scoping.
So #tfb's answer - writing a mini-evaluator-function for l is the probably only way to handle this in a proper, safe, correct way.
Update
It seems to me that doing:
(defmacro m (x l)
`(typecase ,x ,#l))
(defun m-fun (x l)
(eval `(m ,x ,l)))
(m-fun ''y l) ;; 3
(m-fun 'y l) ;; error since y unknown
(let ((l '((number 2) (symbol 3) (list 4))))
(m-fun ''(1 2) l)) ;; => 4 since it is a list
(let ((l '((number 2) (symbol 3))))
(m-fun ''(1 2) l)) ;; => NIL since it is a list
(let ((l '((number 2) (symbol 3))))
(m-fun ''y l)) ;; => 3 since it is a symbol
(let ((n 12))
(m-fun n l)) ;; => 2 since it is a number
;; to improve `m-fun`, one could define
(defun m-fun (x l)
(eval `(m ',x ,l)))
;; then, one has not to do the strangely looking double quote
;; ''y but just one quote 'y.
(let ((l '((number 2) (symbol 3) (list 4))))
(m-fun '(1 2) l)) ;; => 4 since it is a list
;; etc.
at least hides the eval within a function.
And one does not have to use backquote in the main code.
Macro expansion happens at compile time, not run time, thus if the case clause list changes over the course of the program, the macro expansion will not change to reflect it.
If you want to dynamically select an unevaluated but changeable value, you can use assoc in the expansion instead of case:
(defmacro m (x l)
`(second (assoc ,x ,l)))
Sample expansion:
(m x l)
->
(SECOND (ASSOC X L))
Output of (assoc x l) with the value of l in your question and x = 'x:
(let ((x 'x))
(m x l))
->
2
However if you did decide to do it this way, you could simplify things and replace the macro with a function:
(defun m (x l)
(second (assoc x l)))
UPDATE FOR QUESTION EDIT:
Replace assoc as follows:
(defun m (x l)
(second (assoc-if (lambda (type)
(typep x type))
l)))
I'm quite new to LISP and I am trying to work on the cond statement for class. Currently, I am attempting to check if the value passed is a list and if so, append the letter d onto the list.
Here is my code:
(defun test(L)
(listp L)
(cond ((listp L) (append L (list 'd)))
)
(write L)
)
(test (list 'a 'b 'c))
The output I get is:
(A B C)
(A B C)
If I change the test to: (test (car(list 'a 'b 'c)))
The new output I get is:
A
A
Two things I am wondering is
1.) Why isn't D appended onto the list if the first test passes a list?
2.) Why are they being printed twice? I'm using LISP Works so I figure it's actually something with how it always outputs the final value or something.
1.) The same reason str + "d" doesn't mutate str in Java or Python. It creates a new list that you do not use!
>>> str + "d"
'abcd'
>>> str
'abc'
Crazy similar isn't it?
2.) In CL the return is the last evaluated expression. The REPL prints every top level expression result to the terminal. Python does this too:
>>> def test():
... x = 2 + 3
... print x
... return x
...
>>> test()
5
5
Update
How to mutate the argument list. The simple answer is that you need to mutate the last pair of the argument instead:
(defun test (l)
(assert (consp 1) (l) "l needs to be a non nil list. Got: ~a" l)
(nconc l (list 'd)
(write l)))
(defparameter *test1* (list 1 2 3))
(defparameter *test1-copy* *test1*)
(test *test1*) ; ==> (1 2 3 d) (and prints (1 2 3 d))
*test1* ; ==> (1 2 3 d)
*test1-copy* ; ==> (1 2 3 d)
(eq *test1* *test1-copy*) ; ==> t
(test '())
** error l needs to be a non nil list. Got: NIL
(nconc l x) does (setf (cdr (last l)) x)
If you need to alter the binding, then you need to make a macro:
(defmacro testm (var)
(assert (symbolp var) (var) "List needs to be a variable binding. Got: ~a" var)
`(progn
(when (listp ,var)
(setf ,var (append ,var (list 'd)))
(write ,var))))
(macroexpand '(testm *test2*))
; ==> (progn
; (when (consp *test2*)
; (setf *test2* (append *test2* (list 'd))))
; (write *test2*))
(defparameter *test2* (list 1 2 3))
(defparameter *test2-copy* *test2*)
(testm *test2*) ; ==> (1 2 3 d) (and prints (1 2 3 d))
*test2* ; ==> (1 2 3 d)
*test2-copy* ; ==> (1 2 3)
(eq *test2* *test2-copy*) ; ==> nil
(defparameter *x* nil)
(testm *x*) ; ==> (d) (and prints (d))
*x* ; ==> (d)
(testm '(1))
** error List needs to be a variable binding. Got: '(1)
Idiomatic way to do it
(defun test (list)
(if (consp list)
(append list '(d))
list))
(write (test '(1 2 3)))
; ==> (1 2 3 d) (and prints (1 2 3 d))
(defparameter *test3* '(1 2 3))
(setf *test3* (test *test3*))
*test3* ; ==> (1 2 3 d)
I'm trying to write the "closest" function,in Lisp, without using setq/setf etc...
The function finds the nearest vector of a given vector (finding it on a list of lists).
I tried but without sets is too hard,thanks a lot.
Usually the updating of variable is done by recursion:
(defun main-function (arg)
(main-function-helper arg 0 1))
(defun main-function-helper (arg var1 var2)
(if (= arg var1)
var2
(main-function-helper arg (1+ var1) (1+ var2))))
When you're done you can put the helper into the main function:
(defun main-function (arg)
(labels ((helper (var1 var2) ; arg left out since it's not changed
(if (= arg var1)
var2
(helper (1+ var1) (1+ var2)))))
(helper 0 1)))
This is of course a silly implementation of 1+ for positive arguments.
Without set, returns a list of lists in case there are ties:
(NOTE: loop macro uses set at some point :P)
(defun euclid (v1 v2)
(sqrt (loop for x in v1 for y in v2 sum
(expt (- x y) 2))))
(defun closest (target listoflists distancefn)
(loop for l in listoflists for d = (apply distancefn (list target l))
minimizing d into min
collecting (list l d) into col
finally (return
(loop for (vec dis) in col when
(eql dis min) collect vec))))
(closest '(1 2 3) '((1 2 2) ( 1 2 2) ( 2 2 2)) #'euclid)
> ((1 2 2) (1 2 2))
I have a macro called compare-and-swap!:
(define-macro (compare-and-swap! l x y)
`(if (> (vector-ref ,l ,x) (vector-ref ,l ,y))
(vector-swap! ,l ,x ,y)))
It works, I'm testing it like this:
(define v (list->vector '(5 4 3 2 1)))
(print v)
(compare-and-swap! v 1 2)
(print v)
I have a function that returns a list of pairs that I can call compare-and-swap! on serially to sort the whole list:
(batcher 8) → ((0 1) (2 3) (0 2) (1 3) (1 2) (4 5) (6 7) (4 6) (5 7) (5 6) (0 4) (2 6) (2 4) (1 5) (3 7) (3 5) (1 2) (3 4) (5 6))
Now I wish to create a macro that generates a lambda that sorts an N element list by calling batcher and doing the compare-and-swap! for each pair.
For example,
(generate-sorter 8)
→
(lambda (l) (begin (compare-and-swap! l 0 1) (compare-and-swap! l 2 3) ...))
→
(lambda (l) (begin (if (> (vector-ref l 0) (vector-ref l 1)) (vector-swap! 0 1)) (if (> (vector-ref l 2) (vector-ref l 3)) (vector-swap! 2 3))) ... )
I made a function that generates the necessary code:
(define generate-sorter (lambda (len)
(list 'lambda '( li ) 'begin (map (lambda (pair) (list 'compare-and-swap! 'li (first pair) (second pair))) (batcher len)))
))
But I don't now how to make it into a macro.
You don't need a macro for this and, in particular, for the 'generate' part. I suspect that you were thinking macro because the result of generate-sorter can vary from call to call and you hoped to encode the result through macro expansion. An alternative is to capture the result in the lexical environment as such:
(define-syntax compare-and-swap!
(syntax-rules ()
((_ l x y)
(when (> (vector-ref l x) (vector-ref l y))
(vector-swap! l x y)))))
(define (generate-sorter n)
(let ((sorters (generate-sorter n)))
(lambda (l)
(for-each (lambda (sorter)
(compare-and-swap! l (car sorter) (card sorter)))
sorters))))
(define sorter-8 (generate-sorter 8))
(sorter-8 <l-thingy>)
-> <sorted-l-thingy>
How would I recurse through nested lists?
For example, given: '((A 1 2) (B 3 4))
How would I add 2 to the second element in each nested sublist?
(defun get-p0 (points)
(loop for x from 0 to
(- (list-length points) 1) do
(+ 2 (cadr (nth x points)))
)
)
I'm not really sure why (get-p0 '((A 1 2) (B 3 4))) returns NIL.
I'd go with something like this:
(loop for (letter x y) in '((A 1 2) (B 3 4))
collect (list letter (+ 2 x) y))
The reason: it's shorter and you don't measure the length of the list in order to iterate over it (why would you do that?)
Since you ask for a recursive solution:
(defun get-p0 (lst &optional (n 0))
(if (null lst)
nil
(let ((elt1 (first lst)) (eltn (cdr lst)))
(if (listp elt1)
(cons (get-p0 elt1) (get-p0 eltn))
(cons (if (= n 1) (+ elt1 2) elt1) (get-p0 eltn (+ n 1)))))))
so
? (get-p0 '((A 1 2) (B 3 4)))
((A 3 2) (B 5 4))
and it recurses further down if necessary:
? (get-p0 '((A 0 2) ((B -4 4) (C 10 4))))
((A 2 2) ((B -2 4) (C 12 4)))
The way you put it, you can consider the problem as a basic recursion pattern: you go through a list using recursion or iteration (mapcar, reduce, etc.; dolist, loop, etc.) and apply a function to its entries. Here is a functional solution:
(defun get-p0 (points)
(mapcar #'add-2 points))
where the auxiliary function can be defined as follows:
(defun add-2 (lst)
"Add 2 to the 2nd item"
(let ((res '()))
(do ((l lst (cdr l))
(i 1 (1+ i)))
((null l) (nreverse res))
(push (if (= 2 i)
(+ 2 (car l))
(car l))
res))))
As written your 'loop' use does not return anything; thus NIL is returned. As is your code is simply iterating over x and computing something; that something isn't stored anywhere.
So, how to get your desired result? Assuming you are willing to modify each point in points, this should work:
(defun get-p0 (points)
(loop for x from 0 to (- (list-length points) 1) do
(let ((point (nth x points)))
(setf (cadr point) (+ 2 (cadr point)))))
points)