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.
in common lisp I have a tree of symbols like:
(setf a '((shoe (walks(town)) (has-laces(snow)))
(tree (grows(bob)) (is-green(house)) (is tall(work)))))
all are symbols.
I want to return the sublist that contains the symbol I search for (in this case I might search using the symbol shoe and return the entire sublist in which they are contained. the keywords are always in the second layer never deeper
trying to use:
(mapcar #'member (shoe my-list))
but requires shoe to be a list (because of mapcar?) things got very convoluted after that. help please!
Given:
(setf a '((shoe (walks(town)) (has-laces(snow)))
(tree (grows(bob)) (is-green(house)) (is tall(work)))))
We can find the first (shoe ...) sublist like this:
(find 'shoe a :key #'car)
-> (SHOE (WALKS (TOWN)) (HAS-LACES (SNOW)))
I.e. search through the list of objects, which are lists, and use their car as the search key.
If there can be duplicates and we want a list of all of the sublists which start with shoe, then Common Lisp's standard library shows itself a bit clumsy. There isn't a nice function which finds all occurrences of an item; we resort to remove-if-not with a lambda:
(remove-if-not (lambda (x) (eq x 'shoe)) a :key #'car)
We can also write a loop expression:
(loop for (sym . rest) in a and
for whole in a
if (eq sym 'shoe) collect whole)
We can also make ourselves a quick and dirty find-all which can be invoked similarly to all:
(defun find-all (item sequence &key (key #'identity) (test #'eql))
(remove-if-not (lambda (elem) (funcall test item elem)) sequence :key key))
Then:
(find-all 'shoe a :key #'car)
--> ((SHOE (WALKS (TOWN)) (HAS-LACES (SNOW))))
(find-all 'x '((x 1) (y 2) (x 3) (z 4)) :key #'car)
--> ((X 1) (X 3))
(find 'x '((x 1) (y 2) (x 3) (z 4)) :key #'car)
--> ((X 1))
I'm trying different binding models for macro lambda lists.
Edit: in fact the lambda list for my test macros is always (&rest ...). Which means that I'm 'destructuring' the argument list and not the lambda list. I try to get a solution that works for combining optional with key arguments or rest/body with key arguments - both combinations don't work in the Common Lisp standard implementation.
So I have different functions giving me a list of bindings having the same syntax as used by 'let'.
E.g:
(build-bindings ...) => ((first 1) middle (last "three"))
Now I thought to use a simple macro inside my test macros feeding such a list to 'let'.
This is trivial if I have a literal list:
(defmacro let-list (_list &rest _body)
`(let ,_list ,#_body))
(let-list ((a 236)) a) => 236
But that's the same as a plain 'let'.
What I'd like to have is the same thing with a generated list.
So e.g.
(let-list (build-bindings ...)
(format t "first: ~s~%" first)
last)
with (build-bindings ...), evaluated in the same lexical scope as the call (let-list ...), returning
((first 1) middle (last "three"))
the expansion of the macro should be
(let
((first 1) middle (last "three"))
(format t "first: ~s~%" first)
last)
and should print 1 and return "three".
Any idea how to accomplish that?
Edit (to make the question more general):
If I have a list of (symbol value) pairs, i.e. same syntax that let requires for it's list of bindings, e.g. ((one 1) (two 'two) (three "three")), is there any way to write a macro that creates lexical bindings of the symbols with the supplied values for it's &rest/&body parameter?
This is seems to be a possible solution which Joshua pointed me to:
(let ((list_ '((x 23) (y 6) z)))
(let
((symbols_(loop for item_ in list_
collect (if (listp item_) (car item_) item_)))
(values_ (loop for item_ in list_
collect (if (listp item_) (cadr item_) nil))))
(progv symbols_ values_
(format t "x ~s, y ~s, z ~s~%" x y z))))
evaluates to:
;Compiler warnings :
; In an anonymous lambda form: Undeclared free variable X
; In an anonymous lambda form: Undeclared free variable Y
; In an anonymous lambda form: Undeclared free variable Z
x 23, y 6, z NIL
I could also easily rearrange my build-bindings functions to return the two lists needed.
One problem is, that the compiler spits warnings if the variables have never been declared special.
And the other problem that, if the dynamically bound variables are also used in a surrounding lexical binding, they a shadowed by the lexical binding - again if they have never been declared special:
(let ((x 47) (y 11) (z 0))
(let ((list_ '((x 23) (y 6) z)))
(let
((symbols_(loop for item_ in list_
collect (if (listp item_) (car item_) item_)))
(values_ (loop for item_ in list_
collect (if (listp item_) (cadr item_) nil))))
(progv symbols_ values_
(format t "x ~s, y ~s, z ~s~%" x y z)))))
evaluates to:
x 47, y 11, z 0
A better way could be:
(let ((x 47) (y 11) (z 0))
(locally
(declare (special x y))
(let ((list_ '((x 23) (y 6) z)))
(let
((symbols_(loop for item_ in list_
collect (if (listp item_) (car item_) item_)))
(values_ (loop for item_ in list_
collect (if (listp item_) (cadr item_) nil))))
(progv symbols_ values_
(format t "x ~s, y ~s, z ~s~%" x y z))))))
evaluates to:
;Compiler warnings about unused lexical variables skipped
x 23, y 6, z NIL
I can't see at the moment whether there are other problems with the dynamic progv bindings.
But the whole enchilada of a progv wrapped in locally with all the symbols declared as special cries for a macro again - which is again not possible due to same reasons let-list doesn't work :(
The possiblilty would be a kind of macro-lambda-list destructuring-hook which I'm not aware of.
I have to look into the implementation of destructuring-bind since that macro does kind of what I'd like to do. Perhaps that will enlight me ;)
So a first (incorrect) attempt would look something like this:
(defun build-bindings ()
'((first 1) middle (last "three")))
(defmacro let-list (bindings &body body)
`(let ,bindings
,#body))
Then you could try doing something like:
(let-list (build-bindings)
(print first))
That won't work, of course, because the macro expansion leaves the form (build-bindings) in the resulting let, in a position where it won't be evaluated:
CL-USER> (pprint (macroexpand-1 '(let-list (build-bindings)
(print first))))
(LET (BUILD-BINDINGS)
(PRINT FIRST))
Evaluation during Macroexpansion time
The issue is that you want the result of build-bindings at macroexpansion time, and that's before the code as a whole is run. Now, in this example, build-bindings can be run at macroexpansion time, because it's not doing anything with any arguments (remember I asked in a comment what the arguments are?). That means that you could actually eval it in the macroexpansion:
(defmacro let-list (bindings &body body)
`(let ,(eval bindings)
,#body))
CL-USER> (pprint (macroexpand-1 '(let-list (build-bindings)
(print first))))
(LET ((FIRST 1) MIDDLE (LAST "three"))
(PRINT FIRST))
Now that will work, insofar as it will bind first, middle, and last to 1, nil, and "three", respectively. However, if build-bindings actually needed some arguments that weren't available at macroexpansion time, you'd be out of luck. First, it can take arguments that are available at macroexpansion time (e.g., constants):
(defun build-bindings (a b &rest cs)
`((first ',a) (middle ',b) (last ',cs)))
CL-USER> (pprint (macroexpand-1 '(let-list (build-bindings 1 2 3 4 5)
(print first))))
(LET ((FIRST '1) (MIDDLE '2) (LAST '(3 4 5)))
(PRINT FIRST))
You could also have some of the variables appear in there:
(defun build-bindings (x ex y why)
`((,x ,ex) (,y ,why)))
CL-USER> (pprint (macroexpand-1 '(let-list (build-bindings 'a 'ay 'b 'bee)
(print first))))
(LET ((A AY) (B BEE))
(PRINT FIRST))
What you can't do, though, is have the variable names be determined from values that don't exist until runtime. E.g., you can't do something like:
(let ((var1 'a)
(var2 'b))
(let-list (build-bindings var1 'ay var2 'bee)
(print first))
because (let-list (build-bindings …) …) is macroexpanded before any of this code is actually executed. That means that you'd be trying to evaluate (build-bindings var1 'ay var2 'bee) when var1 and var2 aren't bound to any values.
Common Lisp does all its macroexpansion first, and then evaluates code. That means that values that aren't available until runtime are not available at macroexpansion time.
Compilation (and Macroexpansion) at Runtime
Now, even though I said that Common Lisp does all its macroexpansion first, and then evaluates code, the code above actually uses eval at macroexpansion to get some extra evaluation earlier. We can do things in the other direction too; we can use compile at runtime. That means that we can generate a lambda function and compile it based on code (e.g., variable names) provided at runtime. We can actually do this without using a macro:
(defun %dynamic-lambda (bindings body)
(flet ((to-list (x) (if (listp x) x (list x))))
(let* ((bindings (mapcar #'to-list bindings))
(vars (mapcar #'first bindings))
(vals (mapcar #'second bindings)))
(apply (compile nil `(lambda ,vars ,#body)) vals))))
CL-USER> (%dynamic-lambda '((first 1) middle (last "three"))
'((list first middle last)))
;=> (1 NIL "three")
This compiles a lambda expression that is created at runtime from a body and a list of bindings. It's not hard to write a macro that takes some fo the quoting hassle out of the picture:
(defmacro let-list (bindings &body body)
`(%dynamic-lambda ,bindings ',body))
CL-USER> (let-list '((first 1) middle (last "three"))
(list first middle last))
;=> (1 NIL "three")
CL-USER> (macroexpand-1 '(let-list (build-bindings)
(list first middle last)))
;=> (%DYNAMIC-LAMBDA (BUILD-BINDINGS) '((LIST FIRST MIDDLE LAST)))
CL-USER> (flet ((build-bindings ()
'((first 1) middle (last "three"))))
(let-list (build-bindings)
(list first middle last)))
;=> (1 NIL "three")
This gives you genuine lexical variables from a binding list created at runtime. Of course, because the compilation is happening at runtime, you lose access to the lexical environment. That means that the body that you're compiling into a function cannot access the "surrounding" lexical scope. E.g.:
CL-USER> (let ((x 3))
(let-list '((y 4))
(list x y)))
; Evaluation aborted on #<UNBOUND-VARIABLE X {1005B6C2B3}>.
Using PROGV and special variables
If you don't need lexical variables, but can use special (i.e., dynamically scoped) variables instead, you can establish bindings at runtime using progv. That would look something like:
(progv '(a b c) '(1 2 3)
(list c b a))
;;=> (3 2 1)
You'll probably get some warnings with that if run it, because when the form is compiled, there's no way to know that a, b, and c are supposed to be special variables. You can use locally to add some special declarations, though:
(progv '(a b c) '(1 2 3)
(locally
(declare (special a b c))
(list c b a)))
;;=> (3 2 1)
Of course, if you're doing this, then you have to know the variables in advance which is exactly what you were trying to avoid in the first place. However, if you're willing to know the names of the variables in advance (and your comments seem like you might be okay with that), then you can actually use lexical variables.
Lexical variables with values computed at run time
If you're willing to state what the variables will be, but still want to compute their values dynamically at run time, you can do that relatively easily. First, lets write the direct version (with no macro):
;; Declare three lexical variables, a, b, and c.
(let (a b c)
;; Iterate through a list of bindings (as for LET)
;; and based on the name in the binding, assign the
;; corresponding value to the lexical variable that
;; is identified by the same symbol in the source:
(dolist (binding '((c 3) (a 1) b))
(destructuring-bind (var &optional value)
(if (listp binding) binding (list binding))
(ecase var
(a (setf a value))
(b (setf b value))
(c (setf c value)))))
;; Do something with the lexical variables:
(list a b c))
;;=> (1 NIL 3)
Now, it's not too hard to write a macrofied version of this. This version isn't perfect, (e.g., there could be hygiene issues with names, and declarations in the body won't work (because the body is being spliced in after some stuff). It's a start, though:
(defmacro computed-let (variables bindings &body body)
(let ((assign (gensym (string '#:assign-))))
`(let ,variables
(flet ((,assign (binding)
(destructuring-bind (variable &optional value)
(if (listp binding) binding (list binding))
(ecase variable
,#(mapcar (lambda (variable)
`(,variable (setf ,variable value)))
variables)))))
(map nil #',assign ,bindings))
,#body)))
(computed-let (a b c) '((a 1) b (c 3))
(list a b c))
;;=> (1 NIL 3)
One way of making this cleaner would be to avoid the assignment altogether, and the computed values to provide the values for the binding directly:
(defmacro computed-let (variables bindings &body body)
(let ((values (gensym (string '#:values-)))
(variable (gensym (string '#:variable-))))
`(apply #'(lambda ,variables ,#body)
(let ((,values (mapcar #'to-list ,bindings)))
(mapcar (lambda (,variable)
(second (find ,variable ,values :key 'first)))
',variables)))))
This version creates a lambda function where the arguments are the specified variables and the body is the provided body (so the declarations in the body are in an appropriate place), and then applies it to a list of values extracted from the result of the computed bindings.
Using LAMBDA or DESTRUCTURING-BIND
since I'm doing some "destructuring" of the arguments (in a bit a different way), I know which arguments must be present or have which
default values in case of missing optional and key arguments. So in
the first step I get a list of values and a flag whether an optional
or key argument was present or defaulted. In the second step I would
like to bind those values and/or present/default flag to local
variables to do some work with them
This is actually starting to sound like you can do what you need to by using a lambda function or destructuring-bind with keyword arguments. First, note that you can use any symbol as a keyword argument indicator. E.g.:
(apply (lambda (&key
((b bee) 'default-bee b?)
((c see) 'default-see c?))
(list bee b? see c?))
'(b 42))
;;=> (42 T DEFAULT-SEE NIL)
(destructuring-bind (&key ((b bee) 'default-bee b?)
((c see) 'default-see c?))
'(b 42)
(list bee b? see c?))
;;=> (42 T DEFAULT-SEE NIL)
So, if you just make your function return bindings as a list of keyword arguments, then in the destructuring or function application you can automatically bind corresponding variables, assign default values, and check whether non-default values were provided.
Acting a bit indirectly:
a solution that works for combining optional with key arguments or
rest/body with key arguments
Have you considered the not-entirely-uncommon paradigm of using a sub-list for the keywords?
e.g.
(defmacro something (&key (first 1) second) &body body) ... )
or, a practical use from Alexandria:
(defmacro with-output-to-file ((stream-name file-name
&rest args
&key (direction nil direction-p)
&allow-other-keys)
&body body)
I am a newbie in Lisp.
I want to access a particular property from a property list with a string variable like this
(setf sym (list :p1 1))
(setf x "p1")
(getf sym :x)
About cl:getf
Let Petit Prince's answer is right that getf is probably the function you want to use here, but note that it can be used for more than just keyword symbols. You can use it for any objects. A property list is just a list of alternating indicators and values, and any object can be an indicator:
(let ((plist (list 'a 'b 'c 'd)))
(getf plist 'c))
;=> D
You can even use strings as indicators:
(let* ((name "p1")
(plist (list name 1)))
(getf plist name))
;=> 1
However, that's probably not great practice, since getf compares indicators with eq. That means that using strings as indicators might not be reliable, depending on your use case:
(let ((plist (list "p1" 1)))
(getf plist "p1"))
;=> NIL
For your example
In your case, you're trying to take a string and find the object for a symbol with a name that's string-equal (i.e., with the same characters, but disregarding case). It probably makes more sense to loop over the list and compare indicators with string-equal.
(let ((plist '(:p1 1 :p2 2)))
(loop
for (indicator value) on plist by #'cddr
when (string-equal indicator "p1")
return value))
;=> 1
And of course, you can wrap that up in a function for abstraction:
(defun getf-string-equal (plist indicator)
(loop
for (i v) on plist by #'cddr
when (string-equal i indicator)
return v))
(getf-string-equal '(:p1 1 :p2 2) "p1")
;=> 1
The second parameter to getf is a keyword, and you have string. A keyword is a symbol that lives in the package KEYWORD and has usually been uppercased by the reader:
? (setf sym (list :p1 1))
(:P1 1)
? sym
(:P1 1)
So you need to use:
? (getf sym (find-symbol (string-upcase x) "KEYWORD"))
1
I have this procedure:
(define count-calls
(let ((count 0))
(lambda char
(cond ((null? char)
(begin(set! count (+ 1 count))
count))
((eq? char 'how-many-calls) count)
((eq? char 'reset) (set! count 0))))))
It does add 1 when (count-calls) is called but when I call (count-calls 'how-many-calls) it doesn't work as intended. I found that if you define (lambda (char) instead of (lambda char the (eq? ...) part is found but for (lambda char) it doesn't seem to recognize char.
If you dont have parentheses around the lambda parameters then you get all the arguments in a list. So your code is comparing 'how-many-calls to a list.
Welcome to DrRacket, version 5.3.3.5 [3m].
Language: racket [custom]; memory limit: 8192 MB.
> ((lambda args (displayln args)) "a")
(a)
> ((lambda args (displayln args)) "a" "b")
(a b)
> ((lambda (args) (displayln args)) "a")
a
> ((lambda (args) (displayln args)) "a" "b")
#<procedure>: arity mismatch;
the expected number of arguments does not match the given number
expected: 1
given: 2
arguments...:
"a"
"b"
You have a couple of coding errors, this should fix them:
(define count-calls
(let ((count 0))
(lambda char
(cond ((null? char)
(set! count (+ 1 count))
count)
((eq? (car char) 'how-many-calls)
count)
((eq? (car char) 'reset)
(set! count 0))))))
In particular, notice that:
If a lambda's parameters are not surrounded by parenthesis (as is the case with char), then the procedure expects a list of arguments with variable size, possibly empty
With that in mind, it's clear why you need to do (car char) for extracting a parameter, if it was provided
It's not necessary to use a begin after a condition in cond, it's implicit
Use the procedure like this:
(count-calls)
=> 1
(count-calls 'how-many-calls)
=> 1
(count-calls 'reset)
=>
(count-calls 'how-many-calls)
=> 0
Extending stchang's answer, here's one way to solve this:
(define count-calls
(let ((count 0))
(case-lambda
(() (set! count (+ 1 count)) count)
((char) (cond
((eq? char 'how-many-calls) count)
((eq? char 'reset ) (set! count 0) 'reset)
(else 'wot?))))))