I have a Lisp program that's going through nested list and deleting elements that match the element passed through to the function. My issue is, if everything in one of the nested list is deleted, I need to print out () instead of NIL.
(defun del (x l &optional l0)
(cond ((null l) (reverse l0))
((if (atom x) (eq x (car l)) (remove (car l) x)) (del x (cdr l) l0))
(T (del x (cdr l) (cons (if (not (atom (car l)))
(del x (car l))
(car l))
l0)))))
(defun _delete(a l)
(format t "~a~%" (del a l)))
(_delete 'nest '(nest (second nest level) (third (nest) level)))
This returns
((SECOND LEVEL (THIRD NIL LEVEL))
And I need
((SECOND LEVEL (THIRD () LEVEL))
I've tried using the ~:S format but that apparently doesn't work with composite structures. I've also tried the substitute function to replace NIL, also with no results.
Two possible solutions:
I. You can use the format directives ~:A or ~:S
(format t "~:a" '()) => ()
However, this directive works only on the top level elements of a list, i.e.
(format t "~:a" '(a b () c))
will not print (A B () C)
but (A B NIL C)
So you need to loop through the list applying the ~:A to each element recursively if it is a cons.
(defun print-parentheses (l)
(cond ((consp l) (format t "(")
(do ((x l (cdr x)))
((null x) (format t ")" ))
(print-parentheses (car x))
(when (cdr x) (format t " "))))
(t (format t "~:a" l)) ))
(print-parentheses '(a b (c () d))) => (A B (C () D))
II. Create a print-dispatch function for empty lists and add it to the pretty print dispatch table:
(defun print-null (stream obj)
(format stream "()") )
(set-pprint-dispatch 'null #'print-null)
(print '(a () b)) => (A () B)
The latter is simpler, but it affects all the environment, which might not be what you want.
We can write an :around method for print-object, for the case when the object to be printed is NIL.
(defvar *PRINT-NIL-AS-PARENS* nil
"When T, NIL will print as ().")
(defmethod print-object :around ((object (eql nil)) stream)
(if *print-nil-as-parens*
(write-string "()" stream)
(call-next-method)))
(defun write-with-nil-as-parens (list)
(let ((*print-nil-as-parens* t))
(write list)))
Example:
CL-USER 73 > (write-with-nil-as-parens '(a b c nil (()) (nil)))
(A B C () (()) (())) ; <- printed
(A B C NIL (NIL) (NIL)) ; <- return value
I've also tried the substitute function to replace NIL, also with no results.
None of the standard substitution functions will work. substitute is a sequence processing function: it will not recurse into the tree structure.
The sublis and subst functions will process the tree structure, but they treat the car and cdr fields of conses equally: if we replace nil throughout a tree structure with :whatever, that applies to all of the terminating atoms, so that (a nil b) becomes (a :whatever b . :whatever).
We must make our out function which is like subst, but only affects car-s:
(defun subcar (old new nested-list)
(cond
((eq nested-list old) new)
((atom nested-list) nested-list)
(t (mapcar (lambda (atom-or-sublist)
(subcar old new atom-or-sublist))
nested-list))))
With this, we can replace nil-s with the character string "()":
[1]> (subcar nil "()" '(a b c nil (e nil f (g nil)) nil))
(A B C "()" (E "()" F (G "()")) "()")
If we pretty-print that, the character strings just print as the data rather than as machine-readable string literals:
[2]> (format t "~a~%" *) ;; * in the REPL refers to result of previous evaluation
(A B C () (E () F (G ())) ())
I hope you understand that nil and () mean exactly the same thing; they are the same object:
[3]> (eq nil ())
T
The only way the symbol token nil can denote an object other than () is if we we are in a package which hasn't imported the nil symbol from the common-lisp package (and nil is interned as a local symbol in that package, completely unrelated to cl:nil):
[1]> (defpackage "FOO" (:use))
#<PACKAGE FOO>
[2]> (in-package "FOO")
#<PACKAGE FOO>
Sanity test: from within package foo check that cl:nil is the same as the () object. We have to refer to the eq function as cl:eq because package foo doesn't import anything from cl:
FOO[3]> (cl:eq cl:nil ())
COMMON-LISP:T
Now let's see if nil in this package is ():
FOO[4]> (cl:eq nil ())
*** - SYSTEM::READ-EVAL-PRINT: variable NIL has no value
OOPS! This is not the standard nil anymore; it doesn't have special the behavior that it evaluates to itself. We must quote it:
FOO[6]> (cl:eq 'nil ())
COMMON-LISP:NIL
Nope, not the () object. Note how the return values of the cl:eq function are printed as COMMON-LISP:NIL or COMMON-LISP:T. Symbols are printed without a package prefix only if they are present in the current package.
Related
I'm trying to make my own union function and realizing how much I dislike LISP. The goal is to give the function two lists and it will return a set theoretic union of the two. My attempted solution has grown increasingly complex with the same result: NIL. I can't change that from being the result no matter what I do.
I was thinking of building a separate list in my "removeDuplicates" function below, but then idk how I'd return that with recursion. I think what's happening is my "removeDuplicates" function eventually returns an empty list (as intended) but then an empty list is return at every level of the stack when the recursion unfurls (starts returning values up the stack) but I could be wrong. I've always had trouble understanding recursion in detail. The code is below.
(defun rember (A LAT)
(cond
((null LAT) ())
((EQ (car LAT) A) (cdr LAT))
(T (cons (car LAT)(rember A (cdr LAT))))
)
)
(defun my_member (A LAT)
(cond
((null LAT) nil)
((EQ (car LAT) A) T)
(T (my_member A (cdr LAT)))
)
)
(defun removeDuplicates (L)
(cond
((null L) '())
((my_member (car L) (cdr L)) (rember (car L) L) (removeDuplicates (cdr L)))
(T (removeDuplicates (cdr L)))
)
)
(defun my_union (A B)
(setq together(append A B))
(removeDuplicates together)
)
I'm aware most people are not a fan of this format of LISP code, but I prefer it. It allows me to see how parentheses line up better than if you just put all the closing parentheses together at the end of functions and condition blocks.
If I run (my_union '(a b) '(b c)) for example, the result is NIL.
When you call removeDuplicates recursively in the last condition, you're not combining the result with the car of the list, so you're discarding that element.
You're also not using the result of rember.
(defun removeDuplicates (L)
(cond
((null L) '())
((my_member (car L) (cdr L))
(cons (car L)
(removeDuplicates
(rember (car L) (cdr L))
))
)
(T (cons (car L) (removeDuplicates (cdr L))))
)
)
Here's a simple, obvious, union function:
(defun union/tfb (&rest lists)
;; compute the union of any number of lists, implicitly using EQL
(labels ((union/spread (l1 ls)
;; UNION/SPREAD just exists to avoid the impedance
;; mismatch in argument convention
(if (null ls)
l1
(let ((result l1))
(destructuring-bind (l2 . more) ls
(dolist (e l2 (union/spread result more))
(pushnew e result)))))))
(union/spread (first lists) (rest lists))))
I think this is reasonably natural CL, although of course the whole point of using a language like CL is avoiding endless wheel-reinvention like this.
So the rules of the game perhaps say you're not allowed to use PUSHNEW: well, you can easily can replace it with a conditional involving MEMBER:
(defun union/tfb (&rest lists)
;; compute the union of any number of lists, implicitly using EQL
(labels ((union/spread (l1 ls)
;; UNION/SPREAD just exists to avoid the impedance
;; mismatch in argument convention
(if (null ls)
l1
(let ((result l1))
(destructuring-bind (l2 . more) ls
(dolist (e l2 (union/spread result more))
;; Really use PUSHNEW for this
(unless (member e result)
(setf result (cons e result)))))))))
(union/spread (first lists) (rest lists))))
And perhaps you are also not allowed to use MEMBER: well you can easily write a predicate which does what you need:
(defun union/tfb (&rest lists)
;; compute the union of any number of lists, implicitly using EQL
(labels ((union/spread (l1 ls)
;; UNION/SPREAD just exists to avoid the impedance
;; mismatch in argument convention
(if (null ls)
l1
(let ((result l1))
(destructuring-bind (l2 . more) ls
(dolist (e l2 (union/spread result more))
;; Really use MEMBER for this, and in fact
;; PUSHNEW
(unless (found-in-p e result)
(setf result (cons e result))))))))
(found-in-p (e list)
;; is e found in LIST? This exists only because we're not
;; meant to use MEMBER
(cond ((null list) nil)
((eql e (first list)) t)
(t (found-in-p e (rest list))))))
(union/spread (first lists) (rest lists))))
If you want the result to be a set with unique elements even if the first list is not you can trivially do that (note CL's UNION does not promise this, and you can get the same result with the earlier version of UNION/TFB by (union/tfb '() ...)):
(defun union/tfb (&rest lists)
;; compute the union of any number of lists, implicitly using EQL
(labels ((union/spread (l1 ls)
;; UNION/SPREAD just exists to avoid the impedance
;; mismatch in argument convention
(if (null ls)
l1
(let ((result l1))
(destructuring-bind (l2 . more) ls
(dolist (e l2 (union/spread result more))
;; Really use MEMBER for this, and in fact
;; PUSHNEW
(unless (found-in-p e result)
(setf result (cons e result))))))))
(found-in-p (e list)
;; is e found in LIST? This exists only because we're not
;; meant to use MEMBER
(cond ((null list) nil)
((eql e (first list)) t)
(t (found-in-p e (rest list))))))
(union/spread '() lists)))
Finally if the rules prevent you using iterative constructs and assignment you can do that too:
(defun union/tfb (&rest lists)
;; compute the union of any number of lists, implicitly using EQL
(labels ((union/spread (l1 ls)
;; UNION/SPREAD just exists to avoid the impedance
;; mismatch in argument convention
(if (null ls)
l1
(union/loop l1 (first ls) (rest ls))))
(union/loop (result l more)
;; UNION/LOOP is just an iteration
(if (null l)
(union/spread result more)
(destructuring-bind (e . remainder) l
(union/loop (if (found-in-p e result)
result
(cons e result))
remainder more))))
(found-in-p (e list)
;; is e found in LIST? This exists only because we're not
;; meant to use MEMBER
(cond ((null list) nil)
((eql e (first list)) t)
(t (found-in-p e (rest list))))))
(union/spread '() lists)))
The final result of all these changes is something which is, perhaps, very pure, but is not natural CL at all: something like it might be more natural in Scheme (albeit not gratuitously replacing MEMBER with a home-grown predicate like this).
One way to test your Common Lisp code is to ask your interpreter to TRACE functions:
(trace removeDuplicates my_member rember)
To avoid having too many traces, use small examples.
First, let's try with an empty list; this is an example from the REPL ("read eval print loop"), tested with SBCL, while in the "SO" package (StackOverflow); the trace is printed a bit indented, a is numbered according to the depth of the recursion. Here the call is not recursive and terminates right away:
SO> (removeduplicates nil)
0: (SO::REMOVEDUPLICATES NIL)
0: REMOVEDUPLICATES returned NIL
NIL
This works, let's try an example with a singleton list, where there is obviously no duplicate:
SO> (removeduplicates '(1))
0: (SO::REMOVEDUPLICATES (1))
1: (SO::MY_MEMBER 1 NIL)
1: MY_MEMBER returned NIL
1: (SO::REMOVEDUPLICATES NIL)
1: REMOVEDUPLICATES returned NIL
0: REMOVEDUPLICATES returned NIL
NIL
removeDuplicate calls my_member, which correctly returns nil, followed by a recursive call to removeDuplicates with nil, which correctly returns nil. There is however a problem because then, the outermost call returns nil too, which is incorrect.
Looking at the trace, we have to look back at the code to find a place where my_member is called, followed by a recursive call to removeDuplicates. There is only one place wher my_member is called, as a test to the second clause in the cond;
Since the result is nil for that test, the next clause is tried, in that case the default case:
(cond
...
;; this is the call to my_member (= nil)
((my_member (car L) (cdr L)) ...)
;; this is the recursive call
(t (removeDuplicates (cdr L))))
The value of the cond is the one given by the last (removeDuplicates (cdr L)), which just does not retain the existing elements in front of L. If you were mutating a sequence, you could just recurse down the subsequence and ignore the previous elements: in that case the caller would still hold a reference to the original sequence, which would get its element removed by a side-effect of your functions. But here you are following a strictly immutable approach, and you have to recontruct a list as a return value.
In other words, removeDuplicates is expressed as: return a new list which contains the same elements as the original list, but without duplicates.
So you have to add (car L) in front of (removeDuplicates (cdr L)).
(defun removeDuplicates (L)
(cond
((null L) '())
((my_member (car L) (cdr L)) (rember (car L) L) (removeDuplicates (cdr L)))
(T (cons (car L)
(removeDuplicates (rest L))))))
Let's test:
SO> (removeduplicates '())
0: (SO::REMOVEDUPLICATES NIL)
0: REMOVEDUPLICATES returned NIL
NIL
SO> (removeduplicates '(1))
0: (SO::REMOVEDUPLICATES (1))
1: (SO::MY_MEMBER 1 NIL)
1: MY_MEMBER returned NIL
1: (SO::REMOVEDUPLICATES NIL)
1: REMOVEDUPLICATES returned NIL
0: REMOVEDUPLICATES returned (1)
(1)
You can test with a longer list (without duplicates), the result is correct, but the trace is longer.
Now, let's add duplicates:
SO> (removeduplicates '(1 2 2 1))
0: (SO::REMOVEDUPLICATES (1 2 2 1))
1: (SO::MY_MEMBER 1 (2 2 1))
2: (SO::MY_MEMBER 1 (2 1))
3: (SO::MY_MEMBER 1 (1))
3: MY_MEMBER returned T
2: MY_MEMBER returned T
1: MY_MEMBER returned T
1: (SO::REMBER 1 (1 2 2 1))
1: REMBER returned (2 2 1)
1: (SO::REMOVEDUPLICATES (2 2 1))
2: (SO::MY_MEMBER 2 (2 1))
2: MY_MEMBER returned T
2: (SO::REMBER 2 (2 2 1))
2: REMBER returned (2 1)
2: (SO::REMOVEDUPLICATES (2 1))
3: (SO::MY_MEMBER 2 (1))
4: (SO::MY_MEMBER 2 NIL)
4: MY_MEMBER returned NIL
3: MY_MEMBER returned NIL
3: (SO::REMOVEDUPLICATES (1))
4: (SO::MY_MEMBER 1 NIL)
4: MY_MEMBER returned NIL
4: (SO::REMOVEDUPLICATES NIL)
4: REMOVEDUPLICATES returned NIL
3: REMOVEDUPLICATES returned (1)
2: REMOVEDUPLICATES returned (2 1)
1: REMOVEDUPLICATES returned (2 1)
0: REMOVEDUPLICATES returned (2 1)
(2 1)
The result is correct (order does not matter).
So far, our tests are good.
You might not have identified the other problem in that function, namely that all calls to rember are useless, and frankly this is not necessarily easy to spot with the trace. But looking at the code, it should be clear if you write code to have little side-effects that the following clause calls (rember ...) for nothing:
((my_member (car L) (cdr L)) (rember (car L) L) (removeDuplicates (cdr L)))
A cond clause has for syntax (TEST . BODY), where BODY is a sequence of expressions that evaluates like a PROGN: the value of a PROGN is the value of its last clause, all intermediate clauses are only used for their side-effects. For example:
(progn
(print "I am here")
(* 10 3))
Here above, the call to PRINT returns a value, but it is discarded: the value of the enclosing PROGN is 30.
In your code, rember does no side-effect, and its return value is discarded. Just remove it:
(defun removeDuplicates (L)
(cond
((null L) '())
((my_member (car L) (cdr L))
(removeDuplicates (cdr L)))
(T (cons (first L)
(removeDuplicates (rest L))))))
I would write the same code as follows, personally:
(defun remove-duplicate-elements (list)
(when list
(let ((head (first list))
(tail (remove-duplicate-elements (rest list))))
(if (member head tail) tail (cons head tail)))))
Here is a remove-dupes that removes duplicates from a list in O(n) time using a hash table. It supports a custom equality function (which must be eq, eql, equal or `equalp) and a custom test function, so that any aspect of an item can be treated as the key.
(defun remove-dupes (list &key (test #'eql) (key #'identity))
(let ((hash (make-hash-table :test test)))
(loop for item in list
for item-key = (funcall key item)
for seen = (gethash item-key hash)
unless seen collect item and
do (setf (gethash item-key hash) t))))
For instance, suppose we have the assoc list ((a . 1) (a . 2) (b . 3) (c . 4) (b . 4)). We'd like to remove duplicates by car:
[1]> (remove-dupes '((a . 1) (a . 2) (b . 3) (c . 4) (b . 4)) :key #'car)
((A . 1) (B . 3) (C . 4))
Only the leftmost A, B and C entries are reported; the duplicates are suppressed. Now let's do it by cdr:
[2]> (remove-dupes '((a . 1) (a . 2) (b . 3) (c . 4) (b . 4)) :key #'cdr)
((A . 1) (A . 2) (B . 3) (C . 4))
The (b . 4) got culled due to the duplicated 4 value.
But, why do all this, when Common Lisp provides a remove-duplicates function (not to mention union).
remove-duplicates is more general than what I have here: it handles sequences, rather than just lists, so it works on vectors and strings. It has more keyword parameters.
I want to create a function that would flatten a list and remove all potential nil inside.
Expected behavior, example 1:
(myfunc '(a (b (c) (d)) (e f) (g (h)) nil)) => (a b c d e f g h)
Expected behavior, example 2:
(myfunc '(a . d)) => (a d)
my function so far:
(defun myfunc (l)
(cond
((atom l) nil)
((and (atom (car l)) (not (equal (car l) nil))) (cons (car l) (myfunc (cdr l))))
(t (append (myfunc (car l)) (myfunc (cdr l))))))
My function works as expected for the first example, but not the second.
I get:
(myfunc '(a . d)) => (a)
Why doesn't it keep that d?
Is there a way to fix it?
Perhaps you should think about what the flatten function should do, in plain English:
Base case: If flattening nil, return an empty list.
Base case: If flattening single atoms, return a list containing just that.
Recursive case: If flattening pairs, return a list appending the flattening of its car with the flattening of its cdr.
Here's how I'd implement the description I just gave:
(defun flatten (x)
(cond ((null x) x)
((atom x) (list x))
(t (nconc (flatten (car x)) (flatten (cdr x))))))
Preface: I'm currently taking a condensed course that is apparently taught in LISP and I've never worked with LISP in my life so I had to learn the language over a weekend. I apologize in advance for the abysmal code. I'm just familiar enough with LISP's syntax to get the code working and not much more.
I'm currently working on a program that solves the map coloring problem. This code takes a sequence where the first element of each sub sequence is a state and the second element represents a color. ex: '((A R) (B G) (C G) (D Y) (E B) (F B)) and then checks to make sure that no state has the same color as a state it's constrained by (defined by the constraint list). I know there are probably a lot of cleaner and simpler ways to do this but what I'm currently struggling with is having my dolist loops immediately return the value T whenever the if statement is met. So far I've been unable to get the functions to simply return a value and had to resort to this really ugly/wrong method of setting a variable to true and waiting for the loop to finish in order to make the code work. I've tried using return and just having T inside the if statements but, in both cases, the loop would finish instead of returning a value and I have no idea why.
(setq constraint '((A (B C E)) (B (A E F)) (C (A E F)) (D (F)) (E (A B C F)) (F (B C D E))))
(defun check_constraint (f s)
(setf ans nil)
(dolist (state constraint)
(if (eq (first state) f)
(if (search (list s) (second state))
(setf ans T) ;;where I want it to just return T
)
)
)
ans
)
;;ex: ((A R) (B R) (C B) (D R) (E B) (F G))
(defun check_conflict (lst)
(setf anb nil)
(dolist (state lst)
(dolist (neighbor (remove state lst))
(if (check_constraint (first state) (first neighbor))
(if (eq (second state) (second neighbor))
(setf anb T)) ;;where I want it to just return T
)
)
)
anb
)
EDIT: I ended up just fixing this with recursion. The code is cleaner now but I'd still love to know what my issue was. This is the recursive code.
(setq constraint '((A (B C E)) (B (A E F)) (C (A E F)) (D (F)) (E (A B C F)) (F (B C D E))))
(defun check_constraint (lst f s)
(COND
((null lst) nil)
((search (list (car (car lst))) f)
(if (search s (second (car lst))) T))
(t (check_constraint (cdr lst) f s))
)
)
(defun check_neighbor (check lst)
(COND
((null lst) nil)
((check_constraint constraint (list (car check)) (list (first (first lst))))
(if (eq (second check) (second (car lst))) T))
(t (check_neighbor check (cdr lst)))
)
)
;;(check_state '((A R) (B R) (C B) (D R) (E B) (F G)))
(defun check_state (lst)
(COND
((null lst) nil)
((check_neighbor (car lst) (cdr lst)) T)
(t (check_state (cdr lst)))
)
)
First a few style issues. You should use DEFVAR or DEFPARAMETER to declare global variables. Those should also have asterisks around the name to show that they are global (or special actually).
(defparameter *constraint*
'((A (B C E))
(B (A E F))
(C (A E F))
(D (F))
(E (A B C F))
(F (B C D E))))
The lisp convention for naming things is to use dashes between words (CHECK-CONSTRAINT instead of CHECK_CONSTRAINT). You should also prefer full words for variable names instead of abbreviations (LIST instead of LST). The closing parentheses should not be written on their own line.
Then the actual problem. You can use RETURN to return a value from a block named NIL. Loops establish such a block, so you can write the first function like
(defun check-constraint (first second)
(dolist (state *constraint*)
(when (and (eq first (first state))
(member second (second state)))
(return t))))
It's better to use WHEN instead of IF when there's only a then-branch. I also combined the two IFs into one using AND. Since you were wrapping S in a list for using SEARCH, I figured you probably want to use MEMBER instead (although I'm not sure since I don't exactly know what the code is supposed to do). You can change that back if it's wrong.
You probably could also simplify it to
(defun check-constraint (first second)
(member second (second (find first *constraint* :key #'first))))
In the second function you have two loops. If you use RETURN to return from the inner one, you just end up continuing the outer loop and ignoring the return value. So you have to use RETURN-FROM to return from the function instead of the inner loop.
(defun check-conflict (list)
(dolist (state list)
(dolist (neighbor (remove state list))
(when (and (check-constraint (first state) (first neighbor))
(eq (second state) (second neighbor)))
(return-from check-conflict t)))))
I want to ask why this function doesn't work...
(defun nenum(ls)
(cond
((null ls) nil)
((listp car(ls)) (nenum (rest ls)))
((numberp car(ls)) (nenum (rest ls)))
(t (cons (car ls) (nenum (rest ls))))))
Example: (nenum '(l 1 i (b) (5) s -2 p)) --> (l i s p)
Thank you!
Looking at the predicate you have in one of your cond terms:
(listp car (ls))
Thus apply the function listp with the two arguments car and the result of calling the function ls with no arguments. car and ls both need to be free variables and listp needs to be a different function than the one defined in CLHS since it only takes one argument.
Perhaps you have though you were writing Algol? An Algol function call look like operator(operand) but not CL. CL is a LISP dialect and we have this form on our function calls:
(operand operator)
If we nest we do the same:
(operand (operand operator))
You got it right in the alternative (cons (car ls) (nenum (rest ls)))
Replace car(ls) with (car ls).
Here's a much easier way to write that function:
(defun nenum (list)
(remove-if (lambda (item)
(or (listp item)
(numberp item)))
list))
Note that NIL doesn't need its own test because listp covers it.
There's no need to write a function like this from scratch. Common Lisp already provides remove-if, and you can give it a predicate that matches numbers and non-atoms:
CL-USER> (remove-if #'(lambda (x)
(or (numberp x)
(not (atom x))))
'(l 1 i (b) (5) s -2 p))
;=> (L I S P)
Or, to make it even clearer that you're keeping non-numeric atoms, you can use remove-if-not with a predicate that checks for numeric atoms:
CL-USER> (remove-if-not #'(lambda (x)
(and (atom x)
(not (numberp x))))
'(l 1 i (b) (5) s -2 p))
;=> (L I S P)
Note that the empty list, which is often written as (), is just the symbol nil. As such, it too is a non-numeric atom. If you'd want to keep other symbols, e.g.,
CL-USER> (remove-if-not #'(lambda (x)
(and (atom x)
(not (numberp x))))
'(li (b) -1 (5) sp))
;=> (LI SP)
then you'll probably want to keep nil as well:
CL-USER> (remove-if-not #'(lambda (x)
(and (atom x)
(not (numberp x))))
'(van (b) () (5) a))
;=> (VAN NIL A)
I can't figure, is there any way to put something like _ in erlang, for "unused value" in destructuring-bind?
For example there we have something like that:
(destructuring-bind ((_SNIPPET
(_TITLE . title)
(_DESCRIPTION . description)
_RESOURCE-ID (_VIDEO-ID . video-id)))) entry
(declare (ignore
_SNIPPET _TITLE _DESCRIPTION _RESOURCE-ID _VIDEO-ID))
(list video-id title description)))
It'll be great not to put specific variable for every unused value, and write something like that:
(destructuring-bind ((_
(_ . title)
(_ . description)
(_ (_ . video-id)))) entry
(list video-id title description)))
Is there any way to get such behavior with standart destructuring-bind or any other standart macros? Or I have to use some ML-like pattern matching library, and if so - which one?
It's not possible with DESTRUCTURING-BIND (you can't use a variable more than once, some compiler will complain). You can enumerate the variables, _1, _2, ... But then you have to ignore each of them.
LOOP can do it:
CL-USER 23 > (loop for ((a b nil c) nil d) in '(((1 2 3 4) 5 6)
((1 2 3 4) 5 6))
collect (list a b c d))
((1 2 4 6) (1 2 4 6))
NIL is used as the wildcard variable.
You can reuse the LOOP macro:
(defmacro match-bind (pattern object &body body)
`(loop with ,pattern = ,object
while nil
finally (return (progn ,#body))))
CL-USER 37 > (match-bind ((a b nil c) nil d)
'((1 2 3 4) 5 6)
(list a b c d))
(1 2 4 6)
You can use some LET-MATCH from some library. For example: https://github.com/schani/clickr/blob/master/let-match.lisp
There are probably more fancy versions.
There's nothing built into the language for this. Rainer Joswig's answer points out that loop can do some destructuring, but it doesn't do nearly as much. In an earlier version of this answer, I suggested traversing the destructuring lambda list and collecting a list of all the symbols that begin with _ and adding a declaration to the form to ignore those variables. A safer version replaces each one with a fresh variable (so that there are no repeated variables), and ignores them all. Thus something like
(destructuring-bind (_a (_b c)) object
c)
would expand into
(destructuring-bind (#:g1 (#:g2 c)) object
(declare (ignore #:g1 #:g2))
c)
This approach will work OK if you're only using the "data-directed" described in 3.4.4.1.1 Data-directed Destructuring by Lambda Lists. However, if you're using "lambda-list-directed" approach described in 3.4.4.1.2 Lambda-list-directed Destructuring by Lambda Lists, where you can use lambda-list keywords like &optional, &key, etc., then things are much more complicated, because you shouldn't replace variables in some parts of those. For instance, if you have
&optional (_x '_default-x)
then it might be OK to replace _x with something, but not _default-x, because the latter isn't a pattern. But, in Lisp, code is data, so we can still write a macro that maps over the destructuring-lambda-list and replaces only in locations that are patterns. Here's somewhat hairy code that does just that. This takes a function and a destructuring lambda list, and calls the function for each pattern variable in the lambda list, along with the type of the argument (whole, required, optional, etc.).
(defun map-dll (fn list)
(let ((result '())
(orig list)
(keywords '(&allow-other-keys &aux &body
&key &optional &rest &whole)))
(labels ((save (x)
(push x result))
(handle (type parameter)
(etypecase parameter
(list (map-dll fn parameter))
(symbol (funcall fn type parameter)))))
(macrolet ((parse-keyword ((&rest symbols) &body body)
`(progn
(when (and (not (atom list))
(member (first list) ',symbols))
(save (pop list))
,#body)))
(doparameters ((var) &body body)
`(do () ((or (atom list) (member (first list) keywords)))
(save (let ((,var (pop list)))
,#body)))))
(parse-keyword (&whole)
(save (handle :whole (pop list))))
(doparameters (required)
(handle :required required))
(parse-keyword (&optional)
(doparameters (opt)
(if (symbolp opt)
(handle :optional opt)
(list* (handle :optional (first opt)) (rest opt)))))
(when (and (atom list) (not (null list))) ; turn (... . REST)
(setq list (list '&rest list))) ; into (... &rest REST)
(parse-keyword (&rest &body)
(save (handle :rest (pop list))))
(parse-keyword (&key)
(doparameters (key)
(if (symbolp key)
(handle :key key)
(destructuring-bind (keyspec . more) key
(if (symbolp keyspec)
(list* (handle :key keyspec) more)
(destructuring-bind (keyword var) keyspec
(list* (list keyword (handle :key var)) more)))))))
(parse-keyword (&allow-other-keys))
(parse-keyword (&aux)
(doparameters (aux) aux))
(unless (null list)
(error "Bad destructuring lambda list: ~A." orig))
(nreverse result)))))
Using this, it's pretty easy to write a destructuring-bind* that replaces each pattern variable beginning with _ with a fresh variable that will be ignored in the body.
(defmacro destructuring-bind* (lambda-list object &body body)
(let* ((ignores '())
(lambda-list (map-dll (lambda (type var)
(declare (ignore type))
(if (and (> (length (symbol-name var)) 0)
(char= #\_ (char (symbol-name var) 0)))
(let ((var (gensym)))
(push var ignores)
var)
var))
lambda-list)))
`(destructuring-bind ,lambda-list ,object
(declare (ignore ,#(nreverse ignores)))
,#body)))
Now we should look at the expansions it produces:
(macroexpand-1
'(destructuring-bind* (&whole (a _ . b)
c _ d
&optional e (f '_f)
&key g _h
&aux (_i '_j))
object
(list a b c d e f g)))
;=>
(DESTRUCTURING-BIND
(&WHOLE (A #:G1041 &REST B) C #:G1042 D
&OPTIONAL E (F '_F)
&KEY G #:G1043
&AUX (_I '_J))
OBJECT
(DECLARE (IGNORE #:G1041 #:G1042 #:G1043))
(LIST A B C D E F G))
We haven't replaced anywhere we shouldn't (init forms, aux variables, etc.), but we've taken care of the places that we should. We can see this work in your example too:
(macroexpand-1
'(destructuring-bind* ((_ (_ . title)
(_ . description)
_
(_ . video-id)))
entry
(list video-id title description)))
;=>
(DESTRUCTURING-BIND ((#:G1044 (#:G1045 &REST TITLE)
(#:G1046 &REST DESCRIPTION)
#:G1047
(#:G1048 &REST VIDEO-ID)))
ENTRY
(DECLARE (IGNORE #:G1044 #:G1045 #:G1046 #:G1047 #:G1048))
(LIST VIDEO-ID TITLE DESCRIPTION))