By "artificial", I mean one created from a string using intern or make-symbol.
I have a section of my code that declares up to 49 global variables:
(defparameter *CHAR-COUNT-1-1* (make-hash-table))
...
(defparameter *CHAR-COUNT-1-7* (make-hash-table))
...
(defparameter *CHAR-COUNT-7-7* (make-hash-table))
I thought, instead, I could create a function to do all that:
(loop for n from 1 to 7 do
(loop for i from 1 to 7 do
(defparameter (symbol-value (intern (concatenate 'string "*CHAR-COUNT-" (write-to-string n) "-" (write-to-string i) "*")))
(make-hash-table :test 'equalp))))
But get the error(sbcl):
unhandled SIMPLE-ERROR in thread #<SB-THREAD:THREAD "main thread" RUNNING
{1002978EE3}>:
Can't declare a non-symbol as SPECIAL: (SYMBOL-VALUE
(INTERN
(CONCATENATE 'STRING "*CHAR-COUNT-"
(WRITE-TO-STRING N) "-"
(WRITE-TO-STRING I)
"*")))
What is the correct way to do this?
Defparameter is a macro, not a function. That means that it defines a special syntax. The defparameter form needs to have a symbol as its second argument, but you're providing the list:
(symbol-value (intern (concatenate 'string "*CHAR-COUNT-" (write-to-string n) "-" (write-to-string i) "*")))
What you want is a form like
(progn
(defparameter *foo-1-1* (make-hash-table ...))
...
(defparameter *foo-n-n* (make-hash-table ...)))
You seem familiar enough with loop and creating the symbols to create that list; just change
(loop … do (loop … do (defparameter …)))
to
`(progn
,#(loop … nconcing
(loop … collecting
`(defparameter ,(intern …) …))))
and you can get the form you need. Then it's just a matter of putting it all into a macro
(defmacro … (…)
`(progn
,#(loop … nconcing
(loop … collecting
`(defparameter ,(intern …) …)))))
and calling the macro.
One of "use a macro that returns a PROGN with DEFPARAMETER stanzas" or "use PROCLAIM, it is a function, not a macro".
The correct way is to use a proper data structure instead of encoding dimensions in symbol names. Do you really want to calculate and encode symbol names any time you want to access the correct table?
(defparameter *char-counts* (make-array '(7 7)))
(dotimes (i 49) ; or (reduce #'* (array-dimensions *char-counts*))
(setf (row-major-aref *char-counts* i) (make-hash-table)))
Now you can access the array of tables just with the indices (x and y in this example):
(gethash (aref *char-counts* x y) :foo)
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))))
So I have lists, looking like this:
((24 . 23) (9 . 6) ... )
and want to custom format the output to something looking like this:
"24/23 9/6 ..."
I tried:
(defun show-pair (ostream pair col-used atsign-used)
(declare (ignore col-used atsign-used))
(format ostream "~d/~d" (first pair) (second pair)))
(let ((x '( 1 . 2))) (format nil "~{~/show-pair/~^~}" (list x)))
as a simple warming up exercise to show a list with only 1 pair. But when trying this in the emacs slime repl, I get the error
The value
2
is not of type
LIST
[Condition of type TYPE-ERROR]
Which, of course is confusing as ~/show-pair/ was expected to handle one entry in the list, which is is the pair, passing the pair to show-pair. But it appears, something else is actually happening.
If you want to do it with format - the problem is to access first and second element of the alist using format directives. I didn't found how I could access them inside a format directive.
However, in such regularly formed structures like an alist, one could flatten the list first and then let format-looping directive consume two elements per looping - then one consumes the pair.
Since the famous :alexandria library doesn't count as dependency in Common Lisp world, one could directly use alexandria:flatten:
(defparameter *al* '((24 . 23) (9 . 6)))
(ql:quickload :alexandria) ;; import alexandria library
(format nil "~{~a/~a~^ ~}" (alexandria:flatten *al*))
;; => "24/23 9/6"
nil return as string
~{ ~} loop over the list
~a/~a the fraction
~^ empty space between the elements but not after last element
flatten by the way without :alexandria-"dependency" would be in this case:
(defun flatten (l)
(cond ((null l) nil)
((atom l) (list l))
(t (append (flatten (car l)) (flatten (cdr l))))))
While waiting for feedback, I found out, where the problem is coming from:
So far, I considered (second x) to behave exactly like (cdr x) but for tagged values, this assumption is wrong. If I change in show-pairs above (in the question) accordingly, it all works.
So, it is not a formatting problem at all, nor any surprises with how ~/foo~/ works.
(defun show-pair (ostream pair col-used atsign-used)
(declare (ignore col-used atsign-used))
(format ostream "~d/~d" (first pair) (cdr pair))) ;; second -> cdr fixes the problem
It is fairly seldom a good idea to use ~/.../ in format in my experience. It's probably much better to simply turn the list you have into the list you need and then process that directly. So, for instance:
> (format t "~&~:{~D/~D~:^, ~}~%"
(mapcar (lambda (p)
(list (car p) (cdr p)))
'((1 . 2) (3 . 4))))
1/2, 3/4
nil
Or if you want to use loop:
> (format t "~&~:{~D/~D~:^, ~}.~%"
(loop for (n . d) in '((1 . 2) (3 . 4))
collect (list n d)))
1/2, 3/4.
nil
The cost (and storage) associated with converting the list is likely to be absolutely tiny compared with the I/O cost of printing it.
Using hints from Redefinition of the print-object method for conses..., you could end up with something like this:
CL-USER> (let ((std-function (pprint-dispatch 'cons)))
(unwind-protect
(progn (set-pprint-dispatch
'cons
(lambda (s o) (format s "~d/~d" (car o) (cdr o))))
(format t "~{~a~%~}" '((23 . 24) (5 . 9))))
(set-pprint-dispatch 'cons std-function))
(format t "~{~a~%~}" '((23 . 24) (5 . 9))))
23/24
5/9
(23 . 24)
(5 . 9)
NIL
CL-USER>
Hiding the bookkeeping;
(defmacro with-fractional-conses (&body body)
(let ((std-function (gensym "std-function")))
`(let ((,std-function (pprint-dispatch 'cons)))
(unwind-protect
(progn (set-pprint-dispatch
'cons
(lambda (s o) (format s "~d/~d"
(car o)
(cdr o))))
,#body)
(set-pprint-dispatch 'cons ,std-function)))))
CL-USER> (with-fractional-conses
(format t "~{~a~%~}"
'((23 . 24) (5 . 9))))
23/24
5/9
NIL
CL-USER>
I'm trying to write a macro that defines some helpers for struct-of-arrays data structure (based on this snippet). Inside that macro I define another macro that helps with traversing all of the slot values in struct. The thing is I can't make double unquoting work properly. Here's the code:
(defmacro defcomponent (name-and-options &body slots)
(setf name-and-options (ensure-list name-and-options))
(let ((struct (first name-and-options))
(slot-names (iter (for s in slots)
(collecting
(ematch s
((or (and name (symbol)
(<> _ '*)
(<> _ nil))
(list* name _ (plist :type _ :read-only _)))
name))))))
`(progn (defstruct ,name-and-options
;; some task-specific stuff omitted here
)
(defmacro ,(symbolicate 'with- struct) (components &rest body)
`(loop
,#',(iter (for s in slot-names)
(appending `(for ,s across (,(symbolicate struct '- s) components))))
do ,#body)))))
So for instance (defcomponent buzz x y) macroexpands to
(PROGN
(DEFSTRUCT (BUZZ)
X Y) ;; details omitted
(DEFMACRO WITH-BUZZ (COMPONENTS &REST BODY)
`(LOOP ,#'(FOR X ACROSS (BUZZ-X COMPONENTS) FOR Y ACROSS (BUZZ-Y COMPONENTS))
DO ,#BODY))
which kinda works, but I want to access components parameter of the internal with-buzz macro, i.e. something like this
(DEFMACRO WITH-BUZZ (COMPONENTS &REST BODY)
`(LOOP FOR X ACROSS (BUZZ-X ,COMPONENTS) FOR Y ACROSS (BUZZ-Y ,COMPONENTS)
DO ,#BODY))
How do I possibly acheive that? I've tried a lot of the combinations of , and ,# to no avail.
Sometimes it helps not to work with backquote patterns. Then scope problems can be easier understood with the help of a compiler, which would warn about the usual variable scope problems.
As a slightly simplified exercise, we will write a function, which generates code. The generated code is a macro definition, which itself generates code.
(defun makeit (name slots)
(labels ((symbolicate (pattern &rest things)
(intern (apply #'format nil pattern things)))
(compute-for-clauses (slots)
(loop for s in slots
append (list ''for (list 'quote s)
''across (list 'list
(list 'quote
(symbolicate "~a-~a" name s))
'components)))))
(list 'progn
(list 'defmacro
(symbolicate "WITH-~a" name)
'(components &rest body)
(append '(list* 'loop)
(compute-for-clauses slots)
(list ''do 'body))))))
Example
CL-USER 51 > (pprint (makeit 'buzz '(x y)))
(PROGN
(DEFMACRO WITH-BUZZ (COMPONENTS &REST BODY)
(LIST* 'LOOP
'FOR
'X
'ACROSS
(LIST 'BUZZ-X COMPONENTS)
'FOR
'Y
'ACROSS
(LIST 'BUZZ-Y COMPONENTS)
'DO
BODY)))
CL-USER 52 > (eval *)
NIL
CL-USER 53 > (macroexpand-1 '(with-buzz a (+ 12) (+ 30)))
(LOOP FOR X ACROSS (BUZZ-X A) FOR Y ACROSS (BUZZ-Y A) DO (+ 12) (+ 30))
T
All right, I've managed to do it by resorting to manual list construction + eval instead of quasiquoting, but sweet mother of god it looks so hakish.
;; skip
(defmacro ,(symbolicate 'with- struct) (components &rest body)
(append
'(loop)
(eval
`(iter (for s in ',',slot-names)
(appending `(for ,s across (,(symbolicate ',',struct '- ,'s) ,,components)))))
'(do)
body))
I'll gladly accept any other answer solving the problem more idiomatically.
How do I join a series of path components in common lisp?
In python, I can do,
`os.path.join("/home/", username, "dira", "dirb", "dirc");`
What would be the equivalent in common lisp?
Of course I can write my own function, but I suspect I should be able to use something built-in.
If you insist on using strings to represent pathnames, then there seems to be no built-in solution except rolling your own.
(defun join-strings (list &key (separator "/") (force-leading nil))
(let* ((length (length list))
(separator-size (length separator))
(text-size (reduce #'+ (mapcar #'length list) :initial-value 0))
(size (+ text-size (* separator-size (if force-leading length (1- length)))))
(buffer (make-string size)))
(flet ((copy-to (position string)
(loop
:with wp := position
:for char :across string
:do (setf (char buffer (prog1 wp (incf wp))) char)
:finally (return wp))))
(loop
:with wp := 0
:for string :in list
:do (when (or force-leading (plusp wp)) (setf wp (copy-to wp separator)))
(setf wp (copy-to wp string)))
buffer)))
(join-strings '("home" "kurt" "source" "file.txt") :force-leading t)
==> "/home/kurt/source/file.txt"
However, if you can use pathnames, then you could, for example, do:
(merge-pathnames #P"subdir1/subdir2/file.type" #P"/usr/share/my-app")
==> #P"/usr/share/my-app/subdir1/subdir2/file.type"
The pathname API also provides functions to manipulate pathnames symbolically, extract the components of a pathname, etc.:
(pathname-directory #P"subdir1/subdir2/file.type")
==> '(:relative "subdir1" "subdir2")
(pathname-name #P"subdir1/subdir2/file.type")
==> "file"
(pathname-type #P"subdir1/subdir2/file.type")
==> "type"
(make-pathname :name "file" :type "type" :directory '(:relative "subdir1" "subdir2"))
==> #P"subdir1/subdir2/file.type"
In particular, the directory component of a pathname is represented as a list, and thus, you can use the full set of list handling functions to derive directory values from others:
(make-pathname :directory (append '(:absolute "usr" "share") '("more" "stuff"))
:name "packages" :type "lisp")
A simpler join-strings
(defun join-strings (lst sep)
(if
(atom lst)
lst
(reduce
(lambda (a b)
(concatenate 'string a sep b))
(cdr lst)
:initial-value (car lst))))