Non destructive modify hash table - lisp

Is it possible to non-destructively add new key-value pairs to a Common Lisp (SBCL) hash table? The standard way to add new elements to a hash table is to call:
(setf (gethash key *hash-table*) value)
but the call to setf modifies *hash-table* corrupting the original. I have an application where I'd like to take advantage of the efficiency of hash table lookups, but I also would like to non destructively modify them. The work-around I see is to copy the original hash table before operating on it, but that is not practical in my case since the hash tables I'm dealing with contain many thousands of elements and copying large hash tables, say, in a loop would negate the computational efficiency advantage of using them in the first place.

Depending on your needs you may be able to just use an association list, using assoc and other functions to establish new bindings on top of existing ones. The fact that assoc returns the first matching element means you can shadow bindings:
(let ((list '((:a . 1) (:b . 2))))
(acons :b 3 list))
=> ((:b . 3) (:a . 1) (:b . 2))
If you call (assoc :b list) in the resulting list, the entry will be (:b . 3), but the original list is unmodified.
FSet
If association lists are not enough, the FSet library provides purely functional data-structures for Common Lisp, like maps, which are immutable hash-tables. They are implemented as balanced trees, which is better than a naive approach. There are also other data-structures that are more efficient, but you probably need to implement them yourselves (Hash array mapped trie (edit: see https://github.com/danshapero/cl-hamt, thanks #Flux)). That being said, FSet is good enough in general.
FSet is available through Quicklisp
USER> (ql:quickload :fset)
Create a map; notice the printed representation is made to be read again, if you install the appropriate reader macros. But you can perfectly use the library without the modified syntax table.
USER> (fset:map (:a 0) (:b 1))
#{| (:A 0) (:B 1) |}
Update the previous map with a new binding for :c:
USER> (fset:with * :c 3)
#{| (:A 0) (:B 1) (:C 3) |}
Update the previous map with a new binding for :b, which shadows the previous one:
USER> (fset:with * :b 4)
#{| (:A 0) (:B 4) (:C 3) |}
All the intermediate maps are unmodified:
USER> (list * ** *** )
(#{| (:A 0) (:B 4) (:C 3) |}
#{| (:A 0) (:B 1) (:C 3) |}
#{| (:A 0) (:B 1) |})

I don't think that you can pass-by-reference a hash-table to another hash-table in common lisp.
But what I had an idea was how to avoid to copy the entire hashtable,
yet get to a result by one call is to use the default value argument position
of gethash.
(gethash key ht default-value) returns what is given for default-value, when key is not present in ht.
;; prepare three example hash-tables, where *h3* and *h2* gets the additional keys
;; and if a key is not present in *h3*, one should look up in *h2*, and if not there too, in *h1*.
(defparameter *h1* (make-hash-table))
(setf (gethash 'a *h1*) 1)
(setf (gethash 'b *h1*) 2)
(setf (gethash 'c *h1*) 3)
(defparameter *h2* (make-hash-table))
(setf (gethash 'd *h2*) 4)
(setf (gethash 'e *h2*) 5)
(defparameter *h3* (make-hash-table))
(setf (gethash 'f *h3*) 6)
;; the call
(gethash 'a *h3* (gethash 'a *h2* (gethash 'a *h1*)))
;; would give the desired result `1`.
;; let us assume, there is a chain of hash-tables *hk* *h(k-1)* ... *h2* *h1*
;; in which one should look up into that order.
;; Then it is to us to build the code
;; (gethash 'a *hk* (gethash 'a *h(k-1)* ...(gethash 'a *h2* (gethash 'a *h1*))...))
;; automatically for every lookup.
;; this macro does it:
(defmacro mget (key hash-tables-list)
(flet ((inject-last (e1 e2) `(,#e1 ,e2)))
(reduce #'inject-last
(mapcar (lambda (ht) `(gethash ,key ,ht))
(nreverse hash-tables-list)))))
;; let's see its macroexpansion:
(macroexpand-1 '(mget 'a (*h3* *h2* *h1*)))
;; (GETHASH 'A *H3* (GETHASH 'A *H2* (GETHASH 'A *H1*))) ;
;; T
;; and run the code:
(mget 'a (*h2* *h1*))
;; 1 ;
;; NIL
One could attach information which are the next hash table to look in
in the hash-table object. And even automate the generation of the list (*h3* *h2* *h1*) so that one writes only
(gethash* key ht) which then calls mget ...
Well, of course through all this the hash-access gets slowed.
It is a trade-off between copying entire hash-tables or pay the cost in performance at each call ...
automatic finding of hash-tables which are extended by *h3*
(setf (get '*h3* 'extendeds) '(*h2* *h1*))
(setf (get '*h2* 'extendeds) '(*h1*))
(defun collect-extendeds (hts)
(let ((res (loop for ht in hts
nconcing (get ht 'extendeds))))
(remove-duplicates res)))
;; this function can recursively retrieve all hashtables
(defun get-extendeds* (hts &optional (acc '()))
(let ((hts (if (listp hts) hts (list hts))))
(let ((nexts (collect-extendeds hts)))
(cond ((every #'null nexts) (nreverse (remove-duplicates (append hts acc))))
(t (get-extendeds* nexts (remove-duplicates (append hts acc))))))))
;; write a macro to retrieve key's value from all downstream hashtables
(defmacro geth (key ht)
`(mget ,key ,(get-extendeds* ht)))
(geth 'a *h3*)
;; 1 ;
;; NIL ;; NIL because it was not in *h3* directly but in one of the hashtables
;; which it extends.
;; problem is if 'NIL is a value of an existing key,
;; one would still get 'NIL NIL.

Related

Common Lisp: Destructure a list in first, rest, last (like Python iterable unpacking)

Exercise 6.36 of David Touretzky's Common Lisp book asks for a function swap-first-last that swaps the first and last argument of any list. I feel really stupid right now, but I am unable to solve this with destructuring-bind.
How can I do what in Python would be first, *rest, last = (1,2,3,4) (iterable unpacking) in Common Lisp/with destructuring-bind?
After all trying out, and with some comments by #WillNess (thanks!) I came up with this idea:
macro bind
The idea is trying to subdivide the list and use the &rest functionality of the lambda list in destructuring-bind, however, using the shorter . notation - and using butlast and the car-last combination.
(defmacro bind ((first _rest last) expr &body body)
`(destructuring-bind ((,first . ,_rest) ,last)
`(,,(butlast expr) ,,(car (last expr)))
,#body)))
usage:
(bind (f _rest l) (list 1 2 3 4)
(list f _rest l))
;; => (1 (2 3) 4)
My original answer
There is no so elegant possibility like for Python.
destructuring-bind cannot bind more differently than lambda can: lambda-lists take only the entire rest as &rest <name-for-rest>.
No way there to take the last element out directly.
(Of course, no way, except you write a macro extra for this kind of problems).
(destructuring-bind (first &rest rest) (list 1 2 3 4)
(let* ((last (car (last rest)))
(*rest (butlast rest)))
(list first *rest last)))
;;=> (1 (2 3) 4)
;; or:
(destructuring-bind (first . rest) (list 1 2 3 4)
(let* ((last (car (last rest)))
(*rest (butlast rest)))
(list first *rest last)))
But of course, you are in lisp, you could theoretically write macros to
destructuring-bind in a more sophisticated way ...
But then, destructuring-bind does not lead to much more clarity than:
(defparameter *l* '(1 2 3 4))
(let ((first (car *l*))
(*rest (butlast (cdr *l*)))
(last (car (last *l*))))
(list first *rest last))
;;=> (1 (2 3) 4)
The macro first-*rest-last
To show you, how quickly in common lisp such a macro is generated:
;; first-*rest-last is a macro which destructures list for their
;; first, middle and last elements.
;; I guess more skilled lisp programmers could write you
;; kind of a more generalized `destructuring-bind` with some extra syntax ;; that can distinguish the middle pieces like `*rest` from `&rest rest`.
;; But I don't know reader macros that well yet.
(ql:quickload :alexandria)
(defmacro first-*rest-last ((first *rest last) expr &body body)
(let ((rest))
(alexandria:once-only (rest)
`(destructuring-bind (,first . ,rest) ,expr
(destructuring-bind (,last . ,*rest) (nreverse ,rest)
(let ((,*rest (nreverse ,*rest)))
,#body))))))
;; or an easier definition:
(defmacro first-*rest-last ((first *rest last) expr &body body)
(alexandria:once-only (expr)
`(let ((,first (car ,expr))
(,*rest (butlast (cdr ,expr)))
(,last (car (last ,expr))))
,#body))))
Usage:
;; you give in the list after `first-*rest-last` the name of the variables
;; which should capture the first, middle and last part of your list-giving expression
;; which you then can use in the body.
(first-*rest-last (a b c) (list 1 2 3 4)
(list a b c))
;;=> (1 (2 3) 4)
This macro allows you to give any name for the first, *rest and last part of the list, which you can process further in the body of the macro,
hopefully contributing to more readability in your code.

SIMPLE-READER-ERROR , illegal sharp macro character, Subcharacter #\< not defined for dispatch char #\#

In chapter 4 of the book, Successful Lisp, by David B. Lamkins,
there is a simple application to keep track of bank checks.
https://dept-info.labri.fr/~strandh/Teaching/MTP/Common/David-Lamkins/chapter04.html
At the end, we write a macro that will save and restore functions.
The problem occurs when I execute the reader function and the value to read is the hash table.
The macro to save and restore functions is:
(defmacro def-i/o (writer-name reader-name (&rest vars))
(let ((file-name (gensym))
(var (gensym))
(stream (gensym)))
`(progn
(defun ,writer-name (,file-name)
(with-open-file (,stream ,file-name
:direction :output :if-exists :supersede)
(dolist (,var (list ,#vars))
(declare (special ,#vars))
(print ,var ,stream))))
(defun ,reader-name (,file-name)
(with-open-file (,stream ,file-name
:direction :input :if-does-not-exist :error)
(dolist (,var ',vars)
(set ,var (read ,stream)))))
t)))
Here is my hash table and what is going on:
(defvar *payees* (make-hash-table :test #'equal))
(check-check 100.00 "Acme" "Rocket booster T-1000")
CL-USER> *payees*
#<HASH-TABLE :TEST EQUAL :COUNT 0 {25520F91}>
CL-USER> (check-check 100.00 "Acme" "T-1000 rocket booster")
#S(CHECK
:NUMBER 100
:DATE "2020-4-1"
:AMOUNT 100.0
:PAID "Acme"
:MEMO "T-1000 rocket booster")
CL-USER> (def-i/o save-checks charge-checks (*payees*))
T
CL-USER> (save-checks "/home/checks.dat")
NIL
CL-USER> (makunbound '*payees*)
*PAYEES*
CL-USER> (load-checks "/home/checks.dat")
; Evaluation aborted on #<SB-INT:SIMPLE-READER-ERROR "illegal sharp macro character: ~S" {258A8541}>.
In Lispworks, the error message is:
Error: subcharacter #\< not defined for dispatch char #\#.
To simplify, I get the same error if I execute:
CL-USER> (defvar *payees* (make-hash-table :test #'equal))
*PAYEES*
CL-USER> (with-open-file (in "/home/checks.dat"
:direction :input)
(set *payees* (read in)))
; Evaluation aborted on #<SB-INT:SIMPLE-READER-ERROR "illegal sharp macro character: ~S" {23E83B91}>.
Can someone explain to me where the problem is coming from, and what I need to fix in my code for this to work.
Thank you in advance for the explanations you can give me and the help you can give me.
Values which cannot be read back are printed with #<, see Sharpsign Less-Than-Sign. Common Lisp does not define how hash-tables should be printed readably (there is no reader syntax for hash tables):
* (make-hash-table)
#<HASH-TABLE :TEST EQL :COUNT 0 {1006556E53}>
The example in the book is only suitable to be used with the bank example that was previously shown, and is not intended to be a general-purpose serialization mechanism.
There are many ways to print a hash-table and read them back, depending on your needs, but there is no default representation. See cl-store for a library that store arbitrary objects.
Custom dump function
Let's write a form that evaluate to an equivalent hash-table; let's define a generic function named dump, and a default method that simply returns the object as-is:
(defgeneric dump (object)
(:method (object) object))
Given a hash-table, we can serialize it as a plist (sequence of key/value elements in a list), while also calling dump on keys and values, in case our hash-tables contain hash-tables:
(defun hash-table-plist-dump (hash &aux plist)
(with-hash-table-iterator (next hash)
(loop
(multiple-value-bind (some key value) (next)
(unless some
(return plist))
(push (dump value) plist)
(push (dump key) plist)))))
Instead of reinventing the wheel, we could also have used hash-table-plist from the alexandria system.
(ql:quickload :alexandria)
The above is equivalent to:
(defun hash-table-plist-dump (hash)
(mapcar #'dump (alexandria:hash-table-plist hash)))
Then, we can specialize dump for hash-tables:
(defmethod dump ((hash hash-table))
(loop
for (initarg accessor)
in '((:test hash-table-test)
(:size hash-table-size)
(:rehash-size hash-table-rehash-size)
(:rehash-threshold hash-table-rehash-threshold))
collect initarg into args
collect `(quote ,(funcall accessor hash)) into args
finally (return
(alexandria:with-gensyms (h k v)
`(loop
:with ,h := (make-hash-table ,#args)
:for (,k ,v)
:on (list ,#(hash-table-plist-dump hash))
:by #'cddr
:do (setf (gethash ,k ,h) ,v)
:finally (return ,h))))))
The first part of the loop computes all the hash-table properties, like the kind of hash function to use or the rehash-size, and builds args, the argument list for a call to make-hash-table with the same values.
In the finally clause, we build a loop expression (see backquotes) that first allocates the hash-table, then populates it according to the current values of the hash, and finally return the new hash. Note that the generated code does not depend on alexandria, it could be read back from another Lisp system that does not have this dependency.
Example
CL-USER> (alexandria:plist-hash-table '("abc" 0 "def" 1 "ghi" 2 "jkl" 3)
:test #'equal)
#<HASH-TABLE :TEST EQUAL :COUNT 4 {100C91F8C3}>
Dump it:
CL-USER> (dump *)
(LOOP :WITH #:H603 := (MAKE-HASH-TABLE :TEST 'EQUAL :SIZE '14 :REHASH-SIZE '1.5
:REHASH-THRESHOLD '1.0)
:FOR (#:K604 #:V605) :ON (LIST "jkl" 3 "ghi" 2 "def" 1 "abc"
0) :BY #'CDDR
:DO (SETF (GETHASH #:K604 #:H603) #:V605)
:FINALLY (RETURN #:H603))
The generated data is also valid Lisp code, evaluate it:
CL-USER> (eval *)
#<HASH-TABLE :TEST EQUAL :COUNT 4 {100CD5CE93}>
The resulting hash is equalp to the original one:
CL-USER> (equalp * ***)
T

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.)

macro to feed a calculated binding list into a 'let'?

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)

building a hash table with gensym and macrolet

I'm trying to build a hash table (among other actions) while reading. I don't want the hash table to have global scope (yet), so I'm doing this with a macro and gensym. Inside the macro x, I'm defining a macro s which is similar to setf, but defines an entry in a hash table instead of defining a symbol somewhere. It blows up. I think I understand the error message, but how do I make it work?
The code:
#!/usr/bin/clisp -repl
(defmacro x (&rest statements)
(let ((config-variables (gensym)))
`(macrolet ((s (place value)
(setf (gethash 'place ,config-variables) value)))
(let ((,config-variables (make-hash-table :test #'eq)))
(progn ,#statements)
,config-variables))))
(defun load-config ()
(let ((config-file-tree (read *standard-input*)))
(eval config-file-tree)))
(defun load-test-config ()
(with-input-from-string (*standard-input* "(x (s fred 3) (s barney 5))")
(load-config)))
(load-test-config)
The output:
*** - LET*: variable #:G12655 has no value
The following restarts are available:
USE-VALUE :R1 Input a value to be used instead of #:G12655.
STORE-VALUE :R2 Input a new value for #:G12655.
SKIP :R3 skip (LOAD-TEST-CONFIG)
STOP :R4 stop loading file /u/asterisk/semicolon/build.l/stackoverflow-semi
Just guessing what Bill might really want.
Let's say he wants a mapping from some keys to some values as a configuration in a file.
Here is the procedural way.
open a stream to the data
read it as an s-expression
walk the data and fill a hash-table
Example code:
(defun read-mapping (&optional (stream *standard-input*))
(destructuring-bind (type &rest mappings) (read stream)
(assert (eq type 'mapping))
(let ((table (make-hash-table)))
(loop for (key value) in mappings
do (setf (gethash key table) value))
table)))
(defun load-config ()
(read-mapping))
(defun load-test-config ()
(with-input-from-string (*standard-input* "(mapping (fred 3) (barney 5))")
(load-config)))
(load-test-config)
Use:
CL-USER 57 > (load-test-config)
#<EQL Hash Table{2} 402000151B>
CL-USER 58 > (describe *)
#<EQL Hash Table{2} 402000151B> is a HASH-TABLE
BARNEY 5
FRED 3
Advantages:
no macros
data does not get encoded in source code and generated source code
no evaluation (security!) via EVAL needed
no object code bloat via macros which are expanding to larger code
functional abstraction
much easier to understand and debug
Alternatively I would write a read-macro for { such that {(fred 3) (barney 5)} would be directly read as an hash-table.
If you want to have computed values:
(defun make-table (mappings &aux (table (make-hash-table)))
(loop for (key value) in mappings
do (setf (gethash key table) (eval value)))
table)
CL-USER 66> (describe (make-table '((fred (- 10 7)) (barney (- 10 5)))))
#<EQL Hash Table{2} 4020000A4B> is a HASH-TABLE
BARNEY 5
FRED 3
Turning that into a macro:
(defmacro defmapping (&body mappings)
`(make-table ',mappings))
(defmapping
(fred 3)
(barney 5))
In a macrolet you are as well defining a macro, so the usual rules apply, i.e. you have to backquote expressions, that are to be evaluated at run-time. Like this:
(defmacro x (&rest statements)
(let ((config-variables (gensym)))
`(macrolet ((s (place value)
`(setf (gethash ',place ,',config-variables) ,value)))
(let ((,config-variables (make-hash-table :test #'eq)))
(progn ,#statements)
,config-variables))))