specifying a slot value as a key when removing duplicates - lisp

The following code does what I want:
1 (defclass some-class ()
2 ((some-slot
3 :initarg :somearg
4 :initform (error ":somearg not specified"))))
5 (defparameter *alpha* (make-instance 'some-class :somearg 3))
6 (defparameter *beta* (make-instance 'some-class :somearg 5))
7 (defparameter *gamma* (make-instance 'some-class :somearg 3))
8 (princ (slot-value *beta* 'some-slot)) (terpri)
9 (defparameter *delta* (list *alpha* *beta* *gamma*))
10 (princ *delta*) (terpri)
11 (princ (remove-duplicates *delta*
12 :test #'equal
13 :key (lambda (x) (slot-value x 'some-slot))))
14 (terpri)
5
(#<SOME-CLASS #x21C1D71E> #<SOME-CLASS #x21C1DAFE> #<SOME-CLASS #x21C1DC3E>)
(#<SOME-CLASS #x21C1DAFE> #<SOME-CLASS #x21C1DC3E>)
But is there a way to do this without having to write the function on line 13? Is there a shorthand way to specify as the key a slot value in the class instance?
The following blows up with a syntax error, of course, but it gives the general idea of what I'm seeking.
1 (princ (remove-duplicates *delta*
2 :test #'equal
3 :key '(slot-value 'some-slot)))
4 (terpri)
*** - FUNCALL: (SLOT-VALUE 'SOME-SLOT) is not a function name; try using a
symbol instead

You could try a :reader or :accessor.
Doing
(defclass some-class ()
((some-slot
:initarg :somearg :reader some-slot
:initform (error ":somearg not specified"))))
should let you re-write lines 11 through 13 as
(princ (remove-duplicates *delta* :test #'equal :key #'some-slot))
That is, (some-slot x) is equivalent to (slot-value x 'some-slot) if the slot in question has a reader/accessor.
After-Sleep Edit:
You also don't need to bother setting :initform to error; a slot will do that by default if you don't specify a default value and someone tries to read it. If you don't want the error, you do something like :initform nil. Check out this excellent CLOS tutorial as well as chapters 16 and 17 of Practical Common Lisp for more information about objects in Common Lisp.
Also, in the future if you have working code that you'd like style advice on, do check out codereview.stackexchange. There's a small, but active population of Lisp reviewers.

You could define a reader function for the slot in the defclass and provide that as key function to remove-duplicates. For example, add this line to the slot definition:
:reader some-slot
and then use this in the call of remove-duplicates:
:key #'some-slot

Related

What does gensym do in Lisp?

contextualization: I've been doing a university project in which I have to write a parser for regular expressions and build the corresponding epsilon-NFA. I have to do this in Prolog and Lisp.
I don't know if questions like this are allowed, if not I apologize.
I heard some of my classmates talking about how they used the function gensym for that, I asked them what it did and even checked up online but I literally can't understand what this function does neither why or when is best to use it.
In particular, I'm more intrested in what it does in Lisp.
Thank you all.
GENSYM creates unique symbols. Each call creates a new symbol. The symbol usually has a name which includes a number, which is counted up. The name is also unique (the symbol itself is already unique) with a number, so that a human reader can identify different uninterned symbols in the source code.
CL-USER 39 > (gensym)
#:G1083
CL-USER 40 > (gensym)
#:G1084
CL-USER 41 > (gensym)
#:G1085
CL-USER 42 > (gensym)
#:G1086
gensym is often used in Lisp macros for code generation, when the macro needs to create new identifiers, which then don't clash with existing identifiers.
Example: we are going to double the result of a Lisp form and we are making sure that the Lisp form itself will be computed only once. We do that by saving the value in a local variable. The identifier for the local variable will be computed by gensym.
CL-USER 43 > (defmacro double-it (it)
(let ((new-identifier (gensym)))
`(let ((,new-identifier ,it))
(+ ,new-identifier ,new-identifier))))
DOUBLE-IT
CL-USER 44 > (macroexpand-1 '(double-it (cos 1.4)))
(LET ((#:G1091 (COS 1.4)))
(+ #:G1091 #:G1091))
T
CL-USER 45 > (double-it (cos 1.4))
0.33993432
a little clarification of the existing answers (as the op is not yet aware of the typical common lisp macros workflow):
consider the macro double-it, proposed by mr. Joswig. Why would we bother creating this whole bunch of let? when it can be simply:
(defmacro double-it (it)
`(+ ,it ,it))
and ok, it seems to be working:
CL-USER> (double-it 1)
;;=> 2
but look at this, we want to increment x and double it
CL-USER> (let ((x 1))
(double-it (incf x)))
;;=> 5
;; WHAT? it should be 4!
the reason can be seen in macro expansion:
(let ((x 1))
(+ (setq x (+ 1 x)) (setq x (+ 1 x))))
you see, as the macro doesn't evaluate form, just splices it into generated code, it leads to incf being executed twice.
the simple solution is to bind it somewhere, and then double the result:
(defmacro double-it (it)
`(let ((x ,it))
(+ x x)))
CL-USER> (let ((x 1))
(double-it (incf x)))
;;=> 4
;; NICE!
it seems to be ok now. really it expands like this:
(let ((x 1))
(let ((x (setq x (+ 1 x))))
(+ x x)))
ok, so what about the gensym thing?
let's say, you want to print some message, before doubling your value:
(defmacro double-it (it)
`(let* ((v "DOUBLING IT")
(val ,it))
(princ v)
(+ val val)))
CL-USER> (let ((x 1))
(double-it (incf x)))
;;=> DOUBLING IT
;;=> 4
;; still ok!
but what if you accidentally name value v instead of x:
CL-USER> (let ((v 1))
(double-it (incf v)))
;;Value of V in (+ 1 V) is "DOUBLING IT", not a NUMBER.
;; [Condition of type SIMPLE-TYPE-ERROR]
It throws this weird error! Look at the expansion:
(let ((v 1))
(let* ((v "DOUBLING IT") (val (setq v (+ 1 v))))
(princ v)
(+ val val)))
it shadows the v from the outer scope with string, and when you are trying to add 1, well it obviously can't. Too bad.
another example, say you want to call the function twice, and return 2 results as a list:
(defmacro two-funcalls (f v)
`(let ((x ,f))
(list (funcall x ,v) (funcall x ,v))))
CL-USER> (let ((y 10))
(two-funcalls (lambda (z) z) y))
;;=> (10 10)
;; OK
CL-USER> (let ((x 10))
(two-funcalls (lambda (z) z) x))
;; (#<FUNCTION (LAMBDA (Z)) {52D2D4AB}> #<FUNCTION (LAMBDA (Z)) {52D2D4AB}>)
;; NOT OK!
this class of bugs is very nasty, since you can't easily say what's happened.
What is the solution? Obviously not to name the value v inside macro. You need to generate some sophisticated name that no one would reproduce in their code, like my-super-unique-value-identifier-2019-12-27. This would probably save you, but still you can't really be sure. That's why gensym is there:
(defmacro two-funcalls (f v)
(let ((fname (gensym)))
`(let ((,fname ,f))
(list (funcall ,fname ,v) (funcall ,fname ,v)))))
expanding to:
(let ((y 10))
(let ((#:g654 (lambda (z) z)))
(list (funcall #:g654 y) (funcall #:g654 y))))
you just generate the var name for the generated code, it is guaranteed to be unique (meaning no two gensym calls would generate the same name for the runtime session),
(loop repeat 3 collect (gensym))
;;=> (#:G645 #:G646 #:G647)
it still can potentially be clashed with user var somehow, but everybody knows about the naming and doesn't call the var #:GXXXX, so you can consider it to be impossible. You can further secure it, adding prefix
(loop repeat 3 collect (gensym "MY_GUID"))
;;=> (#:MY_GUID651 #:MY_GUID652 #:MY_GUID653)
GENSYM will generate a new symbol at each call. It will be garanteed, that the symbol did not exist before it will be generated and that it will never be generated again. You may specify a symbols prefix, if you like:
CL-USER> (gensym)
#:G736
CL-USER> (gensym "SOMETHING")
#:SOMETHING737
The most common use of GENSYM is generating names for items to avoid name clashes in macro expansion.
Another common purpose is the generaton of symbols for the construction of graphs, if the only thing demand you have is to attach a property list to them, while the name of the node is not of interest.
I think, the task of NFA-generation could make good use of the second purpose.
This is a note to some of the other answers, which I think are fine. While gensym is the traditional way of making new symbols, in fact there is another way which works perfectly well and is often better I find: make-symbol:
make-symbol creates and returns a fresh, uninterned symbol whose name is the given name. The new-symbol is neither bound nor fbound and has a null property list.
So, the nice thing about make-symbol is it makes a symbol with the name you asked for, exactly, without any weird numerical suffix. This can be helpful when writing macros because it makes the macroexpansion more readable. Consider this simple list-collection macro:
(defmacro collecting (&body forms)
(let ((resultsn (make-symbol "RESULTS"))
(rtailn (make-symbol "RTAIL")))
`(let ((,resultsn '())
(,rtailn nil))
(flet ((collect (it)
(let ((new (list it)))
(if (null ,rtailn)
(setf ,resultsn new
,rtailn new)
(setf (cdr ,rtailn) new
,rtailn new)))
it))
,#forms
,resultsn))))
This needs two bindings which the body can't refer to, for the results, and the last cons of the results. It also introduces a function in a way which is intentionally 'unhygienic': inside collecting, collect means 'collect something'.
So now
> (collecting (collect 1) (collect 2) 3)
(1 2)
as we want, and we can look at the macroexpansion to see that the introduced bindings have names which make some kind of sense:
> (macroexpand '(collecting (collect 1)))
(let ((#:results 'nil) (#:rtail nil))
(flet ((collect (it)
(let ((new (list it)))
(if (null #:rtail)
(setf #:results new #:rtail new)
(setf (cdr #:rtail) new #:rtail new)))
it))
(collect 1)
#:results))
t
And we can persuade the Lisp printer to tell us that in fact all these uninterned symbols are the same:
> (let ((*print-circle* t))
(pprint (macroexpand '(collecting (collect 1)))))
(let ((#2=#:results 'nil) (#1=#:rtail nil))
(flet ((collect (it)
(let ((new (list it)))
(if (null #1#)
(setf #2# new #1# new)
(setf (cdr #1#) new #1# new)))
it))
(collect 1)
#2#))
So, for writing macros I generally find make-symbol more useful than gensym. For writing things where I just need a symbol as an object, such as naming a node in some structure, then gensym is probably more useful. Finally note that gensym can be implemented in terms of make-symbol:
(defun my-gensym (&optional (thing "G"))
;; I think this is GENSYM
(check-type thing (or string (integer 0)))
(let ((prefix (typecase thing
(string thing)
(t "G")))
(count (typecase thing
((integer 0) thing)
(t (prog1 *gensym-counter*
(incf *gensym-counter*))))))
(make-symbol (format nil "~A~D" prefix count))))
(This may be buggy.)

CLOS slot accessors: read but not write

I have a list of the names of slots of a CLOS object:
(DEFCLASS TRIAL-DATA (STANDARD-OBJECT)
((A-DATUM :ACCESSOR A-DATUM :INITARG :A-DATUM :INITFORM NIL)
(BOTH-DATA :ACCESSOR BOTH-DATA :INITARG :BOTH-DATA :INITFORM 0)
(CUMULATIVE-DATA :ACCESSOR CUMULATIVE-DATA :INITARG :CUMULATIVE-DATA :INITFORM NIL)
(NAME :ACCESSOR NAME :INITARG :NAME :INITFORM VALUE)))
(let* ((td (make-instance 'trial-data))
(slot-lst (mapcar #'slot-definition-name (class-slots (class-of td)))))
I can read the values of these slots:
(let* ((td (make-instance 'trial-data))
(slot-lst (mapcar #'slot-definition-name (class-slots (class-of td)))))
(funcall (symbol-function (nth 0 slot-lst)) td))
==> NIL
But why can I not write new values to these slots? Shouldn't my class definition of trial-data have created an accessor function for each slot?
;; Should set the first slot, a-datum's, value to 42
(let* ((td (make-instance 'trial-data))
(slot-lst (mapcar #'slot-definition-name (class-slots (class-of td)))))
(setf (funcall (symbol-function (nth 0 slot-lst)) td) 42))
==>
;Compiler warnings for "/Users/frank/Documents/NRL/Error/Patrolbot/Patrol Construction Notes & Testing.lisp" :
; In an anonymous lambda form at position 123: Undefined function (SETF FUNCALL)
> Error: Undefined function (SETF FUNCALL) called with arguments (42 #<STANDARD-GENERIC-FUNCTION A-DATUM #x302001D1C5DF> #<TRIAL-DATA #x30200200D95D>) .
> While executing: #<Anonymous Function #x30200200EB7F>, in process Listener-2(5).
The accessor is called a-datum.
The reader:
CL-USER 9 > #'a-datum
#<STANDARD-GENERIC-FUNCTION A-DATUM 406000091C>
The writer:
CL-USER 10 > #'(setf a-datum)
#<STANDARD-GENERIC-FUNCTION (SETF A-DATUM) 422000958C>
If you want to call via funcall the writer, you need to call above function.
If you have a plain form (setf (a-datum foo) 'bar)) then this needs to be resolved at macro expansion time.
The error message says that #'(setf funcall) is undefined. Thus (setf (funcall ...) ...) does not exist.
How do you get the writer function in your case?
CL-USER 11 > (fdefinition '(setf a-datum))
#<STANDARD-GENERIC-FUNCTION (SETF A-DATUM) 422000958C>
CL-USER 12 > (let ((name 'a-datum)) (fdefinition `(setf ,name)))
#<STANDARD-GENERIC-FUNCTION (SETF A-DATUM) 422000958C>
Task for you: what are the correct arguments for above function?
Rainer Joswigs's answer addresses the issue of why you can't set with the code that you have now. However, it's also important to note that there's no reason that reader, writer, or accessor name has to be the same as the slot name, so if what you've actually got is the slot name, then you should use (setf slot-value) with it. E.g.,
(defclass foo ()
((bar :accessor getbar :initform 42)))
(defparameter *foo* (make-instance 'foo))
;; neither of these work
(setf (bar *foo*) 34)
(funcall #'(setf bar) 34 *foo*)
(slot-value *foo* 'bar)
;=> 42
(setf (slot-value *foo* 'bar) 36)
;=> 26
(slot-value *foo* 'bar)
;=> 36

reduce using cl-loop facility

CL library manual "map over sequences" says "All of these mapping operations can be expressed conveniently in terms of the cl-loop macro" but I don't see how cl-reduce can be expressed in terms of cl-loop
Not sure how "conveniently" expressed it is, but here's my take on it:
(defun loop-reduce (func sequence &rest initial-element)
(loop with result =
(or (car initial-element)
(prog1 (car sequence)
(setf sequence (cdr sequence))))
for x in sequence do (setf result (funcall func result x))
finally (return result)))
(loop-reduce '+ '(1 2 3 4 5))
;; 15
(loop-reduce '+ '(1 2 3 4 5) 10)
;; 25

Circular list in Common Lisp

I am working using a visual programming environment for musical composition based on CL . I am trying to create a function that when given say 3 elements (1 2 3) will return 1, 2, 3, 1, 2, 3 etc., one number at the time each time it is evaluated. The book Common Lisp a Gentle Introduction, mentions briefly that it's possible to create circular lists using sharp-equal notation but does not get into details on how to use them.
Keep in mind that I can insert actual Lisp code in the program using a object specifically designed for that.
CL-USER 3 > (defun circular (items)
(setf (cdr (last items)) items)
items)
CIRCULAR
CL-USER 4 > (setf *print-circle* t)
T
CL-USER 5 > (circular (list 1 2 3))
#1=(1 2 3 . #1#)
Example:
CL-USER 16 > (setf c1 (circular (list 1 2 3)))
#1=(1 2 3 . #1#)
CL-USER 17 > (pop c1)
1
CL-USER 18 > (pop c1)
2
CL-USER 19 > (pop c1)
3
CL-USER 20 > (pop c1)
1
also:
CL-USER 6 > '#1=(1 2 3 . #1#)
#1=(1 2 3 . #1#)
With a bit of CLOS added:
(defclass circular ()
((items :initarg :items)))
(defmethod initialize-instance :after ((c circular) &rest initargs)
(setf (slot-value c 'items) (circular (slot-value c 'items))))
(defmethod next-item ((c circular))
(prog1 (first (slot-value c 'items))
(setf (slot-value c 'items)
(rest (slot-value c 'items)))))
CL-USER 7 > (setf circ1 (make-instance 'circular :items (list 1 2 3)))
#<CIRCULAR 40200017CB>
CL-USER 8 > (next-item circ1)
1
CL-USER 9 > (next-item circ1)
2
CL-USER 10 > (next-item circ1)
3
CL-USER 11 > (next-item circ1)
1
CL-USER 12 > (next-item circ1)
2
In Sharpsign Equal-Sign notation, it's written as #0=(1 2 3 . #0#).
Here's a function which creates such a list from the given arguments:
(defun circular (first &rest rest)
(let ((items (cons first rest)))
(setf (cdr (last items)) items)))
Then, calling (circular 1 2 3) will return the circular list you wanted. Just use car and cdr to iterate through the elements ad infinitum.
And if you really want an iterator function that takes no arguments and returns the next item for each call, here's how you might do it:
(defun make-iter (list)
(lambda ()
(pop list)))
First, you want to let the printer know to recognize circular lists instead of trying to print the whole list:
(setf *print-circle* t)
Next, you can create a circular list using the Sharpsign Equal-Sign notation:
(setq x '#1=(1 2 3 . #1#))
Here is an idea worked out for a circular list in Lisp.
;;; Showing structure of the list
;;; (next prev is-end val)
; create items
setf L-0 (L-1 L-3 t "L-0 sentry") ; this will be the sentry item so know where to stop
setf L-1 (L-2 L-0 nil "L-1")
setf L-2 (L-3 L-1 nil "L-2")
setf L-3 (L-0 L-2 nil "L-3")
; how to access L-2 from L-0
eval (first (eval (first L-0)))
; result: (L-3 L-1 NIL "L-2")
I'm not giving defun functions to make adding, removing, and accessing the items. I'm thinking that what I gave is enough to show what you need to do in any functions you define for this kind of circular list. This appeared to me to work in the Listener.

Why does this Lisp macro as a whole work, even though each piece doesn't work?

I'm reading/working through Practical Common Lisp. I'm on the chapter about building a test framework in Lisp.
I have the function "test-+" implemented as below, and it works:
(defun test-+ ()
(check
(= (+ 1 2) 3)
(= (+ 5 6) 11)
(= (+ -1 -6) -7)))
Remember, I said, it works, which is why what follows is so baffling....
Here is some code that "test-+" refers to:
(defmacro check (&body forms)
`(combine-results
,#(loop for f in forms collect `(report-result ,f ',f))))
(defmacro combine-results (&body forms)
(with-gensyms (result)
`(let ((,result t))
,#(loop for f in forms collect `(unless ,f (setf ,result nil)))
,result)))
(defmacro with-gensyms ((&rest names) &body body)
`(let ,(loop for n in names collect `(,n (gensym)))
,#body))
(defun report-result (value form)
(format t "~:[FAIL~;pass~] ... ~a~%" value form)
value)
Now, what I've been doing is using Slime to macro-expand these, step by step (using ctrl-c RET, which is mapped to macroexpand-1).
So, the "check" call of "test-+" expands to this:
(COMBINE-RESULTS
(REPORT-RESULT (= (+ 1 2) 3) '(= (+ 1 2) 3))
(REPORT-RESULT (= (+ 5 6) 11) '(= (+ 5 6) 11))
(REPORT-RESULT (= (+ -1 -6) -7) '(= (+ -1 -6) -7)))
And then that macro-expands to this:
(LET ((#:G2867 T))
(UNLESS (REPORT-RESULT (= (+ 1 2) 3) '(= (+ 1 2) 3)) (SETF #:G2867 NIL))
(UNLESS (REPORT-RESULT (= (+ 5 6) 11) '(= (+ 5 6) 11)) (SETF #:G2867 NIL))
(UNLESS (REPORT-RESULT (= (+ -1 -6) -7) '(= (+ -1 -6) -7))
(SETF #:G2867 NIL))
#:G2867)
And it is THAT code, directly above this sentence, which doesn't work. If I paste that into the REPL, I get the following error (I'm using Clozure Common Lisp):
Unbound variable: #:G2867 [Condition of type UNBOUND-VARIABLE]
Now, if I take that same code, replace the gensym with a variable name such as "x", it works just fine.
So, how can we explain the following surprises:
The "test-+" macro, which calls all of this, works fine.
The macro-expansion of the "combine-results" macro does not run.
If I remove the gensym from the macro-expansion of "combine-results", it
does work.
The only thing I can speculate is that you cannot use code the contains literal usages of gensyms. If so, why not, and how does one work around that? And if that is not the explanation, what is?
Thanks.
GENSYM creates uninterned symbols. When the macro runs normally, this isn't a problem, because the same uninterned symbol is being substituted throughout the expression.
But when you copy and paste the expression into the REPL, this doesn't happen. #: tells the reader to return an uninterned symbol. As a result, each occurrence of #:G2867 is a different symbol, and you get the unbound variable warning.
If you do (setq *print-circle* t) before doing the MACROEXPAND it will use #n= and #n# notation to link the identical symbols together.
The code, after being printed and read back, is no longer the same code. In particular, the two instances of #:G2867 in the printed representation would be read back as two separated symbols (albeit sharing the same name), while they should be the same in the original internal representation.
Try setting *PRINT-CIRCLE* to T to preserve the identity in the printed representation of the macro-expanded code.