I have a property list:
(setf *star* '(:points 5))
I'd like to modify this plist. Sometimes the better choice is to do mutation, and sometimes the better choice is to use an immutable update.
How to modify the plist using mutation?
(mutate *star* :points 6)
*star* ; '(:points 6)
And how to modify the plist using an immutable update?
(update *star* :points 6) ; '(:points 6)
*star* ; '(:points 5)
What you are looking for are getf and maybe get-properties.
To modify the plist non-destructively, use list*:
(setq *star* (list* :points 6 *star*))
If your plist is associated with a symbol, you should use get and remprop.
NB: it is a much better idea to use association lists (see assoc and acons) because they are more flexible (e.g., it is easier to switch from associating multiple objects with a key using alists).
To mutate a plist, just use setf:
(setf (getf *star* :points) 59)
To do a non-mutative update, where the original value is left undisturbed, you might do something like this:
(defun update-plist (plist indicator new-value)
(let ((other-properties nil))
(loop while plist
for property = (pop plist)
for value = (pop plist)
when (eq property indicator)
do (return-from update-plist (list* property new-value
(append other-properties plist)))
else do (push value other-properties)
(push property other-properties))
(list* indicator new-value other-properties)))
It differs from your example:
*star* ;; (:points 6 :color :green)
(update-plist *star* :points 5) ;; (:points 5 :color :green)
*star* ;; (:points 6 :color :green) -- Doesn't change.
Related
I am working on a complicated macro and have run into a roadblock.
(defmacro for-each-hashtable-band (body vars on &optional counter name)
`(block o
(with-hash-table-iterator (next-entry ,on)
(destructuring-bind
,(apply #'append vars)
(let ((current-band (list ,#(mapcar #'not (apply #'append vars)))))
(for (i 1 ,(length (apply #'append vars)) 2)
(multiple-value-bind
(succ k v) (next-entry)
(if succ
(progn
(setf (nth i current-band) k)
(setf (nth (+ 1 i) current-band) v))
(return-from o nil))))
current-band)
,#body))))
im getting "Evaluation aborted on #<UNDEFINED-FUNCTION NEXT-ENTRY {100229C693}>"
i dont understand why next-entry appears to be invisible to the macro i have created.
I've tried stripping down this to a small replicable example but i couldnt find a minimal scenario without the macro i created where next-entry would be invisible besides this scenario no matter what I tried, i've always managed to find a way to call next-entry in my other examples so im stumped as to why i cannot get it working here
I've tested the for macro ive created and it seems to generally work in most cases but for some reason it cannot see this next-entry variable. How do i make it visible?
In your code there are multiple places where the macro generates bindings in a way that is subject to variable capture (pdf).
(defmacro for-each-hashtable-band (body vars on &optional counter name)
`(block o ;; VARIABLE CAPTURE
(with-hash-table-iterator (next-entry ,on) ;; VARIABLE CAPTURE
(destructuring-bind ,(apply #'append vars)
(let ((current-band ;;; VARIABLE CAPTURE
(list ,#(mapcar #'not (apply #'append vars)))))
(for
(i ;;; VARIABLE CAPTURE
1 ,(length (apply #'append vars)) 2)
(multiple-value-bind (succ k v) ;;; VARIABLE CAPTURE
,(next-entry) ;;; WRONG EVALUATION TIME
(if succ
(progn
(setf (nth i current-band) k)
(setf (nth (+ 1 i) current-band) v))
(return-from o nil))))
current-band)
,#body))))
A simplified example of such a capture is:
`(let ((x 0)) ,#body)
Here above, the x variable is introduced, but if the code is expanded in a context where xis already bound, then body will not be able to reference that former x binding and will always see x bound to zero (you generally don't want this behavior).
Write a function instead
Instead of writing a big macro for this, let's first try understanding what you want to achieve and write instead a higher-order function, ie. a function that calls user-provided functions.
If I understand correctly, your function iterates over a hash-table by bands of entries. I assume vars holds a list of (key value) pairs of symbols, for example ((k1 v1) (k2 v2)). Then, body works on all the key/value pairs in the band.
In the following code, the function map-each-hashtable-band accepts a function, a hash-table, and instead of vars it accepts a size, the width of the band (the number of pairs).
Notice how in your code, you only have one loop, which builds a band using the hash-table iterator. But then, since the macro is named for-each-hashtable-band, I assume you also want to loop over all the bands. The macro with-hash-table-iterator provides an iterator but does not loop itself. That's why here I have two loops.
(defun map-each-hashtable-band (function hash-table band-size)
(with-hash-table-iterator (next-entry hash-table)
(loop :named outer-loop :do
(loop
:with key and value and next-p
:repeat band-size
:do (multiple-value-setq (next-p key value) (next-entry))
:while next-p
:collect key into current-band
:collect value into current-band
:finally (progn
(when current-band
(apply function current-band))
(unless next-p
(return-from outer-loop)))))))
For example:
(map-each-hashtable-band (lambda (&rest band) (print `(:band ,band)))
(alexandria:plist-hash-table
'(:a 0 :b 1 :c 2 :d 3 :e 4 :f 5 :g 6))
2)
NB. Iterating over a hash-table happens in an arbitrary order, there is no guarantee that you'll see the entries in any particular kind of order, this is implementation-dependant.
With my current version of SBCL this prints the following:
(:BAND (:A 0 :B 1))
(:BAND (:C 2 :D 3))
(:BAND (:E 4 :F 5))
(:BAND (:G 6))
Wrap the function in a macro
The previous function might not be exactly the behavior you want, so you need to adapt to your needs, but once it does what you want, you can wrap a macro around it.
(defmacro for-each-hashtable-band (vars hash-table &body body)
`(map-each-hashtable-band (lambda ,(apply #'append vars) ,#body)
,hash-table
,(length vars)))
For example:
(let ((test (alexandria:plist-hash-table '(:a 0 :b 1 :c 2 :d 3 :e 4 :f 5))))
(for-each-hashtable-band ((k1 v1) (k2 v2)) test
(format t "~a -> ~a && ~a -> ~a ~%" k1 v1 k2 v2)))
This prints:
A -> 0 && B -> 1
C -> 2 && D -> 3
E -> 4 && F -> 5
Macro-only solution, for completeness
If you want to have only one, single macro, you can start by inlining the body of the above function in the macro, you don't need to use apply anymore, but instead you need to establish bindings around the body, using destructuring-bind as you did. A first draft would be to simply as follows, but notice that this is not a proper solution:
(defmacro for-each-hashtable-band (vars hash-table &body body)
(let ((band-size (length vars)))
`(with-hash-table-iterator (next-entry ,hash-table)
(loop :named outer-loop :do
(loop
:with key and value and next-p
:repeat ,band-size
:do (multiple-value-setq (next-p key value) (next-entry))
:while next-p
:collect key into current-band
:collect value into current-band
:finally (progn
(when current-band
(destructuring-bind ,(apply #'append vars) current-band
,#body))
(unless next-p
(return-from outer-loop))))))))
In order to be free of variable capture problems with macros, each temporary variable you introduce must be named after a symbol that cannot exist in any context you expand your code. So instead we first unquote all the variables, making the macro definition fail to compile:
(defmacro for-each-hashtable-band (vars hash-table &body body)
(let ((band-size (length vars)))
`(with-hash-table-iterator (,next-entry ,hash-table)
(loop :named ,outer-loop :do
(loop
:with ,key and ,value and ,next-p
:repeat ,band-size
:do (multiple-value-setq (,next-p ,key ,value) (,next-entry))
:while ,next-p
:collect ,key into ,current-band
:collect ,value into ,current-band
:finally (progn
(when ,current-band
(destructuring-bind ,(apply #'append vars) ,current-band
,#body))
(unless ,next-p
(return-from ,outer-loop))))))))
When compiling the macro, the macro is supposed to inject symbols into the code, but here we have a compilation error that says undefined variables:
;; undefined variables: CURRENT-BAND KEY NEXT-ENTRY NEXT-P OUTER-LOOP VALUE
So now, those variables should be fresh symbols:
(defmacro for-each-hashtable-band (vars hash-table &body body)
(let ((band-size (length vars)))
(let ((current-band (gensym))
(key (gensym))
(next-entry (gensym))
(next-p (gensym))
(outer-loop (gensym))
(value (gensym)))
`(with-hash-table-iterator (,next-entry ,hash-table)
(loop :named ,outer-loop :do
(loop
:with ,key and ,value and ,next-p
:repeat ,band-size
:do (multiple-value-setq (,next-p ,key ,value) (,next-entry))
:while ,next-p
:collect ,key into ,current-band
:collect ,value into ,current-band
:finally (progn
(when ,current-band
(destructuring-bind ,(apply #'append vars) ,current-band
,#body))
(unless ,next-p
(return-from ,outer-loop)))))))))
This above is a bit verbose, but you could simplify that.
Here is what the previous for-each-hashtable-band example expands into with this new macro:
(with-hash-table-iterator (#:g1576 test)
(loop :named #:g1578
:do (loop :with #:g1575
and #:g1579
and #:g1577
:repeat 2
:do (multiple-value-setq (#:g1577 #:g1575 #:g1579) (#:g1576))
:while #:g1577
:collect #:g1575 into #:g1574
:collect #:g1579 into #:g1574
:finally (progn
(when #:g1574
(destructuring-bind
(k1 v1 k2 v2)
#:g1574
(format t "~a -> ~a && ~a -> ~a ~%" k1 v1 k2
v2)))
(unless #:g1577 (return-from #:g1578))))))
Each time you expand it, the #:gXXXX variables are different, and cannot possibly shadow existing bindings, so for example, the body can use variables named like current-band or value without breaking the expanded code.
I've got a data structure that consists of two parts:
A hash table mapping symbols to indices
A vector of vectors containing data
For example:
(defparameter *h* (make-hash-table))
(setf (gethash 'a *h*) 0)
(setf (gethash 'b *h*) 1)
(setf (gethash 'c *h*) 2)
(defparameter *v-of-v* #(#(1 2 3 4) ;vector a
#(5 6 7 8) ;vector b
#(9 10 11 12))) ;vector c
I'd like to define a symbol macro to get at vector a without going through the hashmap. At the REPL:
(define-symbol-macro a (aref *v-of-v* 0))
works fine:
* a
#(1 2 3 4)
but there could be potentially many named vectors, and I don't know what the mappings will be ahead of time, so I need to automate this process:
(defun do-all-names ()
(maphash #'(lambda (key index)
(define-symbol-macro key (aref *v-of-v* index)))
*h*))
But that does nothing. And neither does any of the combinations I have tried of making do-all-names a macro, back-quote/comma templates, etc. I am beginning to wonder if this doesn't have something to do with the define-symbol-macro itself. It seems a little used feature, and On Lisp only mentions it twice. Not too many mentions here nor elsewhere either. In this case I'm using SBCL 2.1
Anyone have any ideas?
You need something like above to do it at runtime:
(defun do-all-names ()
(maphash #'(lambda (key index)
(eval `(define-symbol-macro ,key (aref *v-of-v* ,index)))
*h*))
DEFINE-SYMBOL-MACRO is a macro and does not evaluate all its arguments. So you need to generate a new macro form for each argument pair and evaluate it.
The other way to do it, usually at compile time, is to write a macro which generates these forms on the toplevel:
(progn
(define-symbol-macro a (aref *v-of-v* 0))
(define-symbol-macro b (aref *v-of-v* 1))
; ....
)
I'm not too sure on what you mean by "I don't know what the mappings will be ahead of time".
You could do something like:
(macrolet ((define-accessors ()
`(progn
,#(loop for key being the hash-keys of *h*
collect
`(define-symbol-macro ,key (aref *v-of-v* ,(gethash key *h*)))))))
(define-accessors))
If you know you do not require global access, then, you could do:
(defmacro with-named-vector-accessors (&body body) ; is that the name you want?
`(symbol-macrolet (,#(loop for key being the hash-keys of *h*
collect `(,key (aref *v-of-v* ,(gethash key *h*)))))
,#body))
;;; Example Usage:
(with-named-vector-accessors
(list a b c)) ;=> (#(1 2 3 4) #(5 6 7 8) #(9 10 11 12))
Also,
If you know *h* and the indices each symbol maps to at macroexpansion time, the above works.
If you know *h* at macroexpansion but the indices each symbol maps to will change after macroexpansion, you will want to collect (,key (aref *v-of-v* (gethash ,key *h*))).
PS: If you find loop ugly for hash-tables, you could use the iterate library with the syntax:
(iter (for (key value) in-hashtable *h*)
(collect `(,key (aref *v-of-v* ,value))))
I want to apply or to every element of list, example:
(apply or '(#t #t #f)) expected result #t, but I'm getting error:
'#' to 'apply' has wrong type (kawa.lang.Macro) (expected: procedure, sequence, or other operator)
As I understand or is not a procedure.
Is there any procedure that can be used instead of or?
The easiest way to do this is with exists*. Whenever you would use (apply or some-list), you can use (exists values some-list). Or if you like, you can define a function that uses exists to do that:
#!r6rs
(import (rnrs base)
(rnrs lists))
(define (or* . lst)
(exists values lst))
values is the identity function, so (values x) is just x.
exists is a higher-order function defined so that (exists f (list x ...)) is equivalent to (or (f x) ...).
For example (exists values (list #t #t #f)) is equivalent to (or (values #t) (values #t) (values #f)), which is the same as (or #t #t #f).
Trying it out:
> (apply or* '(#t #t #f))
#t
> (apply or* '(#f #f #f))
#f
> (or* #t #t #f)
#t
> (or*)
#f
*exists is sometimes known as ormap or any
In SRFI-1 List Library you have every and any which basically is and and or for a procedure over a list.
#!r6rs
(import (rnrs base)
(only (srfi :1) every any)
(define num1-10 '(1 2 3 4 5 6 7 8 9 10))
(define odd1-9 '(1 3 5 7 9))
(every odd? num1-10) ; ==> #f
(any odd? num1-10) ; ==> #t
(every odd? odd1-9) ; ==> #t
For a list of booleans the procedure only need to return the argument. values returns it's argument and serve as identity:
(define booleans '(#f #t))
(every values booleans) ; ==> #f
(any values booleans) ; ==> #t
SRFI-1 is a safe choice as it is the list library of the upcoming R7RS Red edition. In many R5RS and R6RS implementations SRFI-1 is included and you can easily add it from the SRFI reference implementation if it isn't. In DrRacket's default language DrRacket, that has ormap and andmap, you can opt to use SRFI-1 instead by importing them with (require srfi/1).
You could define your own procedure that uses or
(define (orp . ls)
(if (null? ls) #f
(if (< (length ls) 2) (car ls) (or (car ls) (orp (cdr ls))))))
And use it:
(apply orp '(#t #f #t))
The main point is that or (and if, cond, and ....) operator has lazy evaluation semantics. Hence (or #t (/ 1 0)) does not make a division by zero. Because of that or cannot be an ordinary function.
You might code a lambda to force the eager evaluation, e.g. define your eager-or variadic function, and apply that.
I'm looking for a built-in function like the pfilter-by-keys below:
(pfilter-by-keys '(:a :b) '(:c 10 :b 20 :a 4))
;; => (:B 20 :A 4)
Its code is pretty simple:
(defun pfilter-by-keys (keys plist)
"List -> PList -> PList
Returns a new plist with only the keys/values correspondent to the given
keys."
(loop for (k v) on plist by #'cddr
when (member k keys :test #'equal)
append (list k v)))
Does CL has some built-in function like the one above?
PS.: Alexandria has a very close function: remove-from-plist.
There is no function to do this (and this isn’t the sort of thing one usually wants to do)
There is a macro remf which removes a key from a plist in some place.
Another way you might achieve this is by:
(destructuring-bind (&key (a nil ap) (b nil bp) &allow-other-keys) plist
(append (if ap (list :a a)) (if bp (list :b b))))
But note that this only works if you already know what keys you want to keep and this does not preserve the order in the plist and it does not preserve repeated keys (i.e. if your plist contains the key :a multiple times the result will contain it only once).
You can modify this for non keyword keys using the normal lambda list syntax for general (symbol) keys.
CL:GET-PROPERTIES is a building block:
(defun keep-properties (plist indicator-list &aux k v)
"Keeps all property list entries for a given indicator-list."
(loop do (setf (values k v plist)
(get-properties plist indicator-list))
while plist
collect k collect v
do (pop plist) (pop plist)))
Note, that it is better to collect twice, than to append/list in a LOOP.
(defstruct (mydate (:constructor make-mydate (year month day)))
(year 1970)
(month 1)
(day 1))
(defvar *date1* (make-mydate 1992 1 1))
The problem is more general, but say I would like to convert an object like date1 to a "document" I can persist to a database (e.g. mongoDB, using package cl-mongo). So I write
(defun mydate->document (mydate)
(cl-mongo:$ (cl-mongo:$ "year" (mydate-year mydate))
(cl-mongo:$ "month" (mydate-month mydate))
(cl-mongo:$ "day" (mydate-day mydate))))
REPL--> (mydate->doc *date1*)
kv-container : #(#S(CL-MONGO::PAIR :KEY year :VALUE 1992)
#S(CL-MONGO::PAIR :KEY month :VALUE 1)
#S(CL-MONGO::PAIR :KEY day :VALUE 1))
But could I, instead of having to write down all fields of my struct, obtained their names and values programmatically? After all, my lisp runtime can do that:
REPL--> (describe *date1*)
#S(MYDATE :YEAR 1992 :MONTH 1 :DAY 1)
[structure-object]
Slots with :INSTANCE allocation:
YEAR = 1992
MONTH = 1
DAY = 1
On the other hand, I did not find anything relevant in any book, and I noticed that the library cl-json cannot convert structs to JSON format (even though it does convert lists and CLOS objects). I guess that if there was a function to convert a struct to a plist, the problem would be solved.
There is no portable way.
Implementations do it differently. Probably most have a way to access the names of the slots. It's not clear to me why such functionality is missing from the standard.
LispWorks for example has:
(structure:structure-class-slot-names (find-class 'some-structure-class))
Maybe there is already a compatibility library somewhere. It would make sense to use the Meta-Object Protocol functionality for CLOS also for structure classes.
SBCL:
* (sb-mop:class-slots (find-class 'foo))
(#<SB-PCL::STRUCTURE-EFFECTIVE-SLOT-DEFINITION A>
#<SB-PCL::STRUCTURE-EFFECTIVE-SLOT-DEFINITION B>)
* (mapcar 'sb-mop:slot-definition-name *)
(A B)
What you are looking for is called Meta-Object Protocol.
Common lisp pioneered MOP, but only for CLOS objects, not for defstruct objects.
Some CL implementations support defstruct MOP, but not all of them, you can check that using:
(defstruct s a)
(slot-definition-initargs (car (class-direct-slots (find-class 's))))
This is SBCL specific:
In REPL is can do this:
(struct-to-list '(NIL #S(N :V 78) #S(OP :V #\*)
#S(E :V1 #S(N :V 456) :OP #S(OP :V #\+) :V2 #S(N :V 123))))
which will give this result =>
(NIL
((N (V 78))
((OP (V #\*)) ((E (V1 (N (V 456))) (OP (OP (V #\+))) (V2 (N (V 123)))) NIL))))
The code used:
(defun struct-names (struct)
(loop for sl in (sb-mop::class-direct-slots (class-of struct))
collect (list
(sb-mop:slot-definition-name sl)
(slot-value sl 'sb-pcl::internal-reader-function))))
(defun struct-values (struct)
(cons (type-of struct)
(loop for np in (struct-names struct)
collect (cons (car np)
(funcall (cadr np) struct)))))
(defun structp (val)
(equalp 'STRUCTURE-OBJECT
(sb-mop:class-name (car (sb-mop:class-direct-superclasses (class-of val))))))
(defun struct-to-list (val)
(cond
((structp val)
(loop for v in (struct-values val)
collect (struct-to-list v)))
((consp val)
(cons (struct-to-list (car val))
(struct-to-list (cdr val))))
(T val)))