I'm looking for a possibly non-verbose portable way to initialize a hash table in Common Lisp. E.g. something that works for constant hash tables, but also to pre-load variable hashes. In CLISP I am using:
(defconstant +my-map+ #S(HASH-TABLE :TEST FASTHASH-EQ
(key1 . "value1")
...
(keyN . "valueN")
))
but unfortunately this format only works on CLISP.
One can programmatically construct a hash table at read time:
(defvar *ht* #.(let ((ht (make-hash-table)))
(loop for (key . value) in
'((a . 1) (b . 2) (c . 3))
do (setf (gethash key ht) value))
ht))
(describe *ht*)
#. is used for read time evaluation. The compiler then will dump the hash table to the FASL file.
This can then be compiled:
Using SBCL:
* (compile-file "/tmp/test.lisp")
; compiling file "/private/tmp/test.lisp" (written 24 MAY 2012 10:08:49 PM):
; compiling (DEFVAR *HT* ...)
; compiling (DESCRIBE *HT*)
; /tmp/test.fasl written
; compilation finished in 0:00:00.360
#P"/private/tmp/test.fasl"
NIL
NIL
* (load *)
#<HASH-TABLE :TEST EQL :COUNT 3 {100299EA43}>
[hash-table]
Occupancy: 0.2
Rehash-threshold: 1.0
Rehash-size: 1.5
Size: 16
Synchronized: no
T
* *ht*
#<HASH-TABLE :TEST EQL :COUNT 3 {100299EA43}>
Creating a hash table as a function:
(defun create-hashtable (alist
&key (test 'eql)
&aux (ht (make-hash-table :test test)))
(loop for (key . value) in alist
do (setf (gethash key ht) value))
ht)
Alexandria has the alist-hash-table function, which you may find useful.
The Serapeum library has dict:
(dict :a 1 :b 2 :c 3)
#<HASH-TABLE :TEST EQUAL :COUNT 3 {1008906D13}>
You can pretty print hash tables:
CL-USER> (toggle-pretty-print-hash-table)
T
CL-USER> (dict :a 1 :b 2 :c 3)
(dict
:A 1
:B 2
:C 3
)
which is a representation that can be read back in.
We can also use pretty-print-hash-table directly.
Serapeum is a high quality library.
ps: my CIEL meta-package makes dict available by default.
Wow, a question from 9 years ago getting another answer. Coincidentally make-hash came out 2 months after this question was asked and is generally useful for this kind of thing.
Related
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))))
This question already has an answer here:
Unusual stack overflow when inserting nodes in binary tree
(1 answer)
Closed 3 years ago.
I was getting stack overflow with the following code, then I tried it in SBCL and it worked. Wondering what causes the difference there.
Specifically: While I do plan to move to SBCL at some point, can
this be made to work in CLISP?
(defvar *objs* nil) ; [1]
(defun parents (obj) (gethash :parents obj))
(defun obj (&rest parents) ; [2]
(let ((obj (make-hash-table)))
(push obj *objs*)
(setf (parents obj) parents)
obj))
(defun (setf parents) (val obj) ; [3]
(prog1 (setf (gethash :parents obj) val)
(make-precedence obj)))
(defun make-precedence (obj) ; [4]
(setf (gethash :preclist obj) (precedence obj))
(dolist (x *objs*)
(if (member obj (gethash :preclist x))
(setf (gethash :preclist x) (precedence x)))))
(defun precedence (obj) ; [5]
(delete-duplicates (traverse obj)))
(defun traverse (x) ; [6]
(cons x (mapcan #'traverse (gethash :parents x))))
;; [1] We'll store a list of objects we create in *obj*.
;; [2] Function to create an object, called like (setf scoundrel (obj)).
;; [3] Set an objects (multiple) parents & rebuild precedence list for all affected objs.
;; [4] Rebuild precedence list for obj, then for all affected objs.
;; [5] Returns a list of object and all its ancestors in precedence order as we define it.
;; (Can read it like (-> obj traverse delete-duplicates) if it helps)
;; [6] Cons an object to all its parents recursively; depth first search.
;; I pulled this out of labels in precedence above it for clarity & testability.
;; Source: PG's ANSI Common Lisp, Chapter 17, "Example: Objects".
Example - SBCL
(setf scoundrel (obj))
; #<HASH-TABLE :TEST EQL :COUNT 2 {1001A01893}>
(setf sc2 (obj scoundrel))
; #<HASH-TABLE :TEST EQL :COUNT 2 {1001A1F153}>
*objs*
; (#<HASH-TABLE :TEST EQL :COUNT 2 {1001A1F153}>
; #<HASH-TABLE :TEST EQL :COUNT 2 {1001A01893}>)
(parents scoundrel)
; NIL
; T
(parents sc2)
; (#<HASH-TABLE :TEST EQL :COUNT 2 {1001A01893}>)
; T
Example - GNU CLISP
(setf scoundrel (obj))
;; - Lisp stack overflow. RESET
*objs*
;; - Lisp stack overflow. RESET
It might be worth mentioning that I haven't studied the dual interpreted and compiled nature of lisp a lot yet. So far I've simply been using it as an interpreted language; by pasting the above functions into the clisp repl.
So I suspect that compiling all these functions could be one thing to consider. I note we can compile and compile-file, I can't see an operator which compiles all user defined functions though.
GNU CLISP prints the contents of the hash table by default. In your case, it contains circular structures.
Either set *PRINT-CIRCLE* to T, to enable printing circular structures without stack overflow.
> (setq *print-circle* t)
T
> *objs*
(#1=#S(HASH-TABLE :TEST FASTHASH-EQL (:PRECLIST . (#1#)) (:PARENTS . NIL)))
Or set *PRINT-ARRAY* and *PRINT-READABLY* to NIL, to disable printing the contents of the hash table.
> (setq *print-circle* nil *print-array* nil *print-readably* nil)
NIL
> *objs*
(#<HASH-TABLE :TEST FASTHASH-EQL :COUNT 2 #x000335098D40>)
I know this is a recurring question (here, here, and more), and I know that the problem is related to creating lazy sequencies, but I can't see why it fails.
The problem: I had written a (not very nice) quicksort algorithm to sort strings that uses loop/recur. But applied to 10000 elements, I get a StackOverflowError:
(defn qsort [list]
(loop [[current & todo :as all] [list] sorted []]
(cond
(nil? current) sorted
(or (nil? (seq current)) (= (count current) 1)) (recur todo (concat sorted current))
:else (let [[pivot & rest] current
pred #(> (compare pivot %) 0)
lt (filter pred rest)
gte (remove pred rest)
work (list* lt [pivot] gte todo)]
(recur work sorted)))))
I used in this way:
(defn tlfnum [] (str/join (repeatedly 10 #(rand-int 10))))
(defn tlfbook [n] (repeatedly n #(tlfnum)))
(time (count (qsort (tlfbook 10000))))
And this is part of the stack trace:
[clojure.lang.LazySeq seq "LazySeq.java" 49]
[clojure.lang.RT seq "RT.java" 521]
[clojure.core$seq__4357 invokeStatic "core.clj" 137]
[clojure.core$concat$fn__4446 invoke "core.clj" 706]
[clojure.lang.LazySeq sval "LazySeq.java" 40]
[clojure.lang.LazySeq seq "LazySeq.java" 49]
[clojure.lang.RT seq "RT.java" 521]
[clojure.core$seq__4357 invokeStatic "core.clj" 137]]}
As far as I know, loop/recur performs tail call optimization, so no stack is used (is, in fact, an iterative process written using recursive syntax).
Reading other answers, and because of the stack trace, I see there's a problem with concat and adding a doall before concat solves the stack overflow problem. But... why?
Here's part of the code for the two-arity version of concat.
(defn concat [x y]
(lazy-seq
(let [s (seq x)]
,,,))
)
Notice that it uses two other functions, lazy-seq, and seq. lazy-seq is a bit like a lambda, it wraps some code without executing it yet. The code inside the lazy-seq block has to result in some kind of sequence value. When you call any sequence operation on the lazy-seq, then it will first evaluate the code ("realize" the lazy seq), and then perform the operation on the result.
(def lz (lazy-seq
(println "Realizing!")
'(1 2 3)))
(first lz)
;; prints "realizing"
;; => 1
Now try this:
(defn lazy-conj [xs x]
(lazy-seq
(println "Realizing" x)
(conj (seq xs) x)))
Notice that it's similar to concat, it calls seq on its first argument, and returns a lazy-seq
(def up-to-hundred
(reduce lazy-conj () (range 100)))
(first up-to-hundred)
;; prints "Realizing 99"
;; prints "Realizing 98"
;; prints "Realizing 97"
;; ...
;; => 99
Even though you asked for only the first element, it still ended up realizing the whole sequence. That's because realizing the outer "layer" results in calling seq on the next "layer", which realizes another lazy-seq, which again calls seq, etc. So it's a chain reaction that realizes everything, and each step consumes a stack frame.
(def up-to-ten-thousand
(reduce lazy-conj () (range 10000)))
(first up-to-ten-thousand)
;;=> java.lang.StackOverflowError
You get the same problem when stacking concat calls. That's why for instance (reduce concat ,,,) is always a smell, instead you can use (apply concat ,,,) or (into () cat ,,,).
Other lazy operators like filter and map can exhibit the exact same problem. If you really have a lot of transformation steps over a sequence consider using transducers instead.
;; without transducers: many intermediate lazy seqs and deep call stacks
(->> my-seq
(map foo)
(filter bar)
(map baz)
,,,)
;; with transducers: seq processed in a single pass
(sequence (comp
(map foo)
(filter bar)
(map baz))
my-seq)
Arne had a good answer (and, in fact, I'd never noticed cat before!). If you want a simpler solution, you can use the glue function from the Tupelo library:
Gluing Together Like Collections
The concat function can sometimes have rather surprising results:
(concat {:a 1} {:b 2} {:c 3} )
;=> ( [:a 1] [:b 2] [:c 3] )
In this example, the user probably meant to merge the 3 maps into one. Instead, the three maps were mysteriously converted into length-2 vectors, which were then nested inside another sequence.
The conj function can also surprise the user:
(conj [1 2] [3 4] )
;=> [1 2 [3 4] ]
Here the user probably wanted to get [1 2 3 4] back, but instead got a nested vector by mistake.
Instead of having to wonder if the items to be combined will be merged, nested, or converted into another data type, we provide the glue function to always combine like collections together into a result collection of the same type:
; Glue together like collections:
(is (= (glue [ 1 2] '(3 4) [ 5 6] ) [ 1 2 3 4 5 6 ] )) ; all sequential (vectors & lists)
(is (= (glue {:a 1} {:b 2} {:c 3} ) {:a 1 :c 3 :b 2} )) ; all maps
(is (= (glue #{1 2} #{3 4} #{6 5} ) #{ 1 2 6 5 3 4 } )) ; all sets
(is (= (glue "I" " like " \a " nap!" ) "I like a nap!" )) ; all text (strings & chars)
; If you want to convert to a sorted set or map, just put an empty one first:
(is (= (glue (sorted-map) {:a 1} {:b 2} {:c 3}) {:a 1 :b 2 :c 3} ))
(is (= (glue (sorted-set) #{1 2} #{3 4} #{6 5}) #{ 1 2 3 4 5 6 } ))
An Exception will be thrown if the collections to be 'glued' are not all of the same type. The allowable input types are:
all sequential: any mix of lists & vectors (vector result)
all maps (sorted or not)
all sets (sorted or not)
all text: any mix of strings & characters (string result)
I put glue into your code instead of concat and still got a StackOverflowError. So, I also replaced the lazy filter and remove with eager versions keep-if and drop-if to get this result:
(defn qsort [list]
(loop [[current & todo :as all] [list] sorted []]
(cond
(nil? current) sorted
(or (nil? (seq current)) (= (count current) 1))
(recur todo (glue sorted current))
:else (let [[pivot & rest] current
pred #(> (compare pivot %) 0)
lt (keep-if pred rest)
gte (drop-if pred rest)
work (list* lt [pivot] gte todo)]
(recur work sorted)))))
(defn tlfnum [] (str/join (repeatedly 10 #(rand-int 10))))
(defn tlfbook [n] (repeatedly n #(tlfnum)))
(def result
(time (count (qsort (tlfbook 10000)))))
-------------------------------------
Clojure 1.8.0 Java 1.8.0_111
-------------------------------------
"Elapsed time: 1377.321118 msecs"
result => 10000
(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)))
What is the difference between "set", "setq", and "setf" in Common Lisp?
Originally, in Lisp, there were no lexical variables -- only dynamic ones. And
there was no SETQ or SETF, just the SET function.
What is now written as:
(setf (symbol-value '*foo*) 42)
was written as:
(set (quote *foo*) 42)
which was eventually abbreviavated to SETQ (SET Quoted):
(setq *foo* 42)
Then lexical variables happened, and SETQ came to be used for assignment to them too -- so it was no longer a simple wrapper around SET.
Later, someone invented SETF (SET Field) as a generic way of assigning values to data structures, to mirror the l-values of other languages:
x.car := 42;
would be written as
(setf (car x) 42)
For symmetry and generality, SETF also provided the functionality of SETQ. At this point it would have been correct to say that SETQ was a Low-level primitive, and SETF a high-level operation.
Then symbol macros happened. So that symbol macros could work transparently, it was realized that SETQ would have to act like SETF if the "variable" being assigned to was really a symbol macro:
(defvar *hidden* (cons 42 42))
(define-symbol-macro foo (car *hidden*))
foo => 42
(setq foo 13)
foo => 13
*hidden* => (13 . 42)
So we arrive in the present day: SET and SETQ are atrophied remains of older dialects, and will probably be booted from eventual successors of Common Lisp.
(set ls '(1 2 3 4)) => Error - ls has no value
(set 'ls '(1 2 3 4)) => OK
(setq ls '(1 2 3 4)) => OK - make ls to (quote ls) and then have the usual set
(setf ls '(1 2 3 4)) => OK - same as setq so far BUT
(setf (car ls) 10) => Makes ls '(10 2 3 4) - not duplicated by setq/set
You can use setf in place of set or setq but not vice versa since setf can also set the value of individual elements of a variable if the variable has individual elements. See the exaples below:
All four examples will assign the list (1, 2, 3) to the variable named foo.
(set (quote foo) (list 1 2 3)) ;foo => (1 2 3)
(1 2 3)
(set 'foo '(1 2 3)) ;foo => (1 2 3) same function, simpler expression
(1 2 3)
(setq foo '(1 2 3)) ;foo => (1 2 3) similar function, different syntax
(1 2 3)
(setf foo '(1 2 3)) ;foo => (1 2 3) more capable function
(1 2 3)
setf has the added capability of setting a member of the list in foo to a new value.
foo ;foo => (1 2 3) as defined above
(1 2 3)
(car foo) ;the first item in foo is 1
1
(setf (car foo) 4) ;set or setq will fail since (car foo) is not a symbol
4
foo ;the fist item in foo was set to 4 by setf
(4 2 3)
However, you can define a symbol macro that reprents a single item within foo
(define-symbol-macro foo-car (car foo)) ; assumes FOO => (1 2 3)
FOO-CAR
foo-car ;foo-car is now a symbol for the 1st item in foo
1
(setq foo-car 4) ;set or setq can set the symbol foo-car
4
foo ;Lisp macros are so cool
(4 2 3)
You can use defvar if you have not already defined the variable and do not want to give it a value until later in your code.
(defvar foo2)
(define-symbol-macro foo-car (car foo2))
setq is just like set with a quoted first arg -- (set 'foo '(bar baz)) is just like (setq foo '(bar baz)). setf, on the other hand, is subtle indeed -- it's like an "indirection". I suggest http://www.n-a-n-o.com/lisp/cmucl-tutorials/LISP-tutorial-16.html as a better way to get started understanding it than any answer here can give... in short, though, setf takes the first argument as a "reference", so that e.g. (aref myarray 3) will work (as the first arg to setf) to set an item inside an array.
One can think of SET and SETQ being low-level constructs.
SET can set the value of symbols.
SETQ can set the value of variables.
Then SETF is a macro, which provides many kinds of setting things: symbols, variables, array elements, instance slots, ...
For symbols and variables one can think as if SETF expands into SET and SETQ.
* (macroexpand '(setf (symbol-value 'a) 10))
(SET 'A 10)
* (macroexpand '(setf a 10))
(SETQ A 10)
So SET and SETQ are used to implement some of the functionality of SETF, which is the more general construct. Some of the other answers tell you the slightly more complex story, when we take symbol macros into account.
I would like to add to previous answers that setf is macro that call specific function depending on what was passed as its first argument.
Compare results of macro expansion of setf with different types of arguments:
(macroexpand '(setf a 1))
(macroexpand '(setf (car (list 3 2 1)) 1))
(macroexpand '(setf (aref #(3 2 1) 0) 1))
For some types of arguments "setf function" will be called:
(defstruct strct field)
(macroexpand '(setf (strct-field (make-strct)) 1))