Readable hash tables
Ivar Rummelhoff
defined
(defmethod print-object ((object hash-table) stream)
(write-string "#h" stream)
(write (cons (hash-table-test object)
(hash-table-to-alist object))
stream))
and an appropriate reader macro. Are there any suggestions to how I
can achieve this _locally_? I miss an analogue to readtables...
--
Ivar Rummelhoff
Erik Naggum
| Are there any suggestions to how I can achieve this _locally_? I
| miss an analogue to readtables...
Take a look at *print-pprint-dispatch* and section 22.2.1.4 in CLtS.
#:Erik
--
If this is not what you expected, please alter your expectations.
Ivar Rummelhoff
>
> Take a look at *print-pprint-dispatch* and section 22.2.1.4 in CLtS.
Just what I was looking for! (as always)
For those who might be interested; this is what I came up with:
(defun hash-table-to-alist (hash-table)
(loop for key being the hash-keys of hash-table
using (hash-value value)
collect (cons key value)))
(defun hash-print (s h)
(write-string "#h" s)
(write (cons (hash-table-test h)
(hash-table-to-alist h))
:stream s
:pretty t))
(defun hash-read (stream subchar arg)
(declare (ignore subchar arg))
(destructuring-bind (test &rest entries) (read stream t nil t)
(let ((tab (make-hash-table :test test)))
(loop for (key . value) in entries
do (setf (gethash key tab) value))
tab)))
(let ((pprint-dispatch
(let ((tab (copy-pprint-dispatch nil)))
(set-pprint-dispatch 'hash-table #'hash-print 0 tab)
tab))
(write-dispatch
(let ((tab (copy-pprint-dispatch nil)))
(set-pprint-dispatch
t #'(lambda (s obj) (write obj :stream s :pretty nil))
0 tab)
(set-pprint-dispatch 'hash-table #'hash-print 1 tab)
tab)))
(defun mi-write (obj &rest args)
(let ((*print-pprint-dispatch*
(if (getf args :pretty *print-pretty*) pprint-dispatch
(progn (setf (getf args :pretty) t) write-dispatch))))
(apply #'write obj args))))
(let ((readtable
(let ((tab (copy-readtable nil)))
(set-dispatch-macro-character #\# #\h #'hash-read tab)
tab)))
(defun mi-read (&rest args)
(let ((*readtable* readtable))
(apply #'read args))))
Ivar Rummelhoff
(let ((dispatch
(let ((tab (copy-pprint-dispatch nil)))
(set-pprint-dispatch 'hash-table #'hash-print 0 tab)
tab)))
(defun mi-write (obj &rest args)
(let ((*print-pprint-dispatch* dispatch))
(setf (getf args :pretty) t)
(apply #'write obj args))))
should replace the erroneous function by the same name in my previous
posting. Alas, this the new version insists on printing pretty...
--
Hilsen Ivar
Erik Naggum
| I'm so sorry.
|
| (let ((dispatch
| (let ((tab (copy-pprint-dispatch nil)))
| (set-pprint-dispatch 'hash-table #'hash-print 0 tab)
| tab)))
| (defun mi-write (obj &rest args)
| (let ((*print-pprint-dispatch* dispatch))
| (setf (getf args :pretty) t)
| (apply #'write obj args))))
|
| should replace the erroneous function by the same name in my previous
| posting.
Although not strictly erroneous, you don't really know whether the
argument list is modifiable and safe to modify. I highly recommend
(apply #'write obj :pretty t args)
as only the first occurrence of a keyword argument is used and any
redundancy is just ignored.
| Alas, this the new version insists on printing pretty...
Well, you _could_ empty the pprint-dispatch if *print-pretty* is nil
upon entry to the function. An empty *pprint-dispatch* is returned
from excl::make-pprint-dispatch without arguments in Allegro CL.
Ivar Rummelhoff
>
> I highly recommend
>
> (apply #'write obj :pretty t args)
I agree.
> Well, you _could_ empty the pprint-dispatch if *print-pretty* is nil
> upon entry to the function. An empty *pprint-dispatch* is returned
> from excl::make-pprint-dispatch without arguments in Allegro CL.
Hm... as far as I can see, it is impossible to make an empty dispatch
table in "pure ANSI CL"...?
Anyhow, in Allegro CL Trial Edition 5.0.1
(let ((pretty-dispatch (copy-pprint-dispatch nil))
(nonpretty-dispatch (excl::make-pprint-dispatch)))
(set-pprint-dispatch 'hash-table #'hash-print 0 pretty-dispatch)
(set-pprint-dispatch 'hash-table #'hash-print 0 nonpretty-dispatch)
(defun mi-write (obj &rest args)
(let ((*print-pprint-dispatch*
(if (getf args :pretty *print-pretty*)
pretty-dispatch
nonpretty-dispatch)))
(apply #'write obj :pretty t args))))
almost works. Except that
(with-standard-io-syntax (mi-write (list (make-hash-table))))
returns
Error: Unable to print #<EQL hash-table with 0 entries @ #x20628222> readably and *PRINT-READABLY* is true.
Is this a bug?
--
Ivar
Steven M. Haflich
Ivar Rummelhoff wrote:
> Hm... as far as I can see, it is impossible to make an empty dispatch
> table in "pure ANSI CL"...?
That doesn't matter. Read ANS 22.2.1.4 and 22.4.25 which say that the
printer selects the highest-priority entry that type matches the object
to be printed, and all predefined entries have lower priority than any
entry defined by user code. Therefore a single entry for type T at
priority 0 will have higher precedence than anything already in the
initisl table.
Ivar Rummelhoff
Hmm... Let me make clear what I want to achieve:
I would like to make a print function which should yield exactly the
same output as `write', except for certain types. "Pretty printing
dispatch tables" seem ideal for the purpose, except that the initial
table adds too much whitespace and is (therefore) very slow.
(The print function should of course recognise the exceptional types
at any depth of the structure to be printed.)
| ../HyperSpec/Body/fun_pprint-dispatch.html :
|
| ... If no type specifiers match the object, a function is returned
| that prints object using print-object. ...
This suggests that starting from an empty table, we should get the
desired behaviour; and at least in Allegro CL Trial Edition 5.0.1
this seems to be the case.
As a first attempt to create an empty table, one might try
(let ((tab (copy-pprint-dispatch nil)))
(set-pprint-dispatch t nil tab)
tab)
But
| ../HyperSpec/Body/fun_set-pprint-dispatch.html:
| It is permissible for function to be nil. In this situation, there
| will be no type-specifier entry in table after set-pprint-dispatch
| returns.
so this will leave most of the table unaffected and not have the
desired effect
Will pprint-dispatch return the same function for every object with no
matching type specifier? Suppose so, and let us call this function
`fun'. Then of course the table returned by
(let ((tab (copy-pprint-dispatch nil)))
(set-pprint-dispatch t fun tab)
tab)
should be equivalent to an empty table. However, I suspect that the
functions returned may differ, and in any case the problem remains
how to actually get this function...
--
Ivar