Suggestion: Pretty print readtables? #32
Description
Hi!
Minor suggestion, in case you think it fits the project. What do you think about having a feature to pretty print readtables, for better readability? Something like this:
; Sample usage:
;CL-USER> (pretty-print-readtable)
;Readtable #<READTABLE {10000386B3}>
; Case Sensitivity: UPCASE
;
; Terminating Macro Characters:
; '"' => #<FUNCTION SB-IMPL::READ-STRING>
; ''' => #<FUNCTION SB-IMPL::READ-QUOTE>
; '(' => READ-LIST
; ')' => READ-RIGHT-PAREN
; ',' => COMMA-CHARMACRO
; ';' => #<FUNCTION SB-IMPL::READ-COMMENT>
; '`' => BACKQUOTE-CHARMACRO
;
; Dispatch Macro Characters:
; '#' :
; #\Backspace => #<FUNCTION SB-IMPL::SHARP-ILLEGAL>
; #\Tab => #<FUNCTION SB-IMPL::SHARP-ILLEGAL>
; #\Newline => #<FUNCTION SB-IMPL::SHARP-ILLEGAL>
; #\Page => #<FUNCTION SB-IMPL::SHARP-ILLEGAL>
; #\Return => #<FUNCTION SB-IMPL::SHARP-ILLEGAL>
; ' ' => #<FUNCTION SB-IMPL::SHARP-ILLEGAL>
; '#' => #<FUNCTION SB-IMPL::SHARP-SHARP>
; ''' => #<FUNCTION SB-IMPL::SHARP-QUOTE>
; '(' => #<FUNCTION SB-IMPL::SHARP-LEFT-PAREN>
; ')' => #<FUNCTION SB-IMPL::SHARP-ILLEGAL>
; '*' => #<FUNCTION SB-IMPL::SHARP-STAR>
; '+' => #<FUNCTION SB-IMPL::SHARP-PLUS-MINUS>
; '-' => #<FUNCTION SB-IMPL::SHARP-PLUS-MINUS>
; '.' => #<FUNCTION SB-IMPL::SHARP-DOT>
; ':' => #<FUNCTION SB-IMPL::SHARP-COLON>
; '<' => #<FUNCTION SB-IMPL::SHARP-ILLEGAL>
; '=' => #<FUNCTION SB-IMPL::SHARP-EQUAL>
; '\' => #<FUNCTION SB-IMPL::SHARP-BACKSLASH>
; 'A' => #<FUNCTION SB-IMPL::SHARP-A>
; 'a' => #<FUNCTION SB-IMPL::SHARP-A>
; 'B' => #<FUNCTION SB-IMPL::SHARP-B>
; 'b' => #<FUNCTION SB-IMPL::SHARP-B>
; 'C' => #<FUNCTION SB-IMPL::SHARP-C>
; 'c' => #<FUNCTION SB-IMPL::SHARP-C>
; 'O' => #<FUNCTION SB-IMPL::SHARP-O>
; 'o' => #<FUNCTION SB-IMPL::SHARP-O>
; 'P' => #<FUNCTION SB-IMPL::SHARP-P>
; 'p' => #<FUNCTION SB-IMPL::SHARP-P>
; 'R' => #<FUNCTION SB-IMPL::SHARP-R>
; 'r' => #<FUNCTION SB-IMPL::SHARP-R>
; 'S' => #<FUNCTION SB-IMPL::SHARP-S>
; 's' => #<FUNCTION SB-IMPL::SHARP-S>
; 'X' => #<FUNCTION SB-IMPL::SHARP-X>
; 'x' => #<FUNCTION SB-IMPL::SHARP-X>
; '|' => #<FUNCTION SB-IMPL::SHARP-VERTICAL-BAR>
An implementation could be something like this:
(defun safe-char-name (char)
"Return a printable representation of a character."
(cond ((graphic-char-p char) (format nil "'~C'" char))
(t (format nil "#\\~A" (char-name char)))))
(defun get-character-range ()
"Generates a list of characters ASCII characters."
(loop for code from 0 to 255
for char = (code-char code)
when char collect char))
(defun sort-by-char (lst)
"Sorts case-insensitive by character."
(sort lst #'char-lessp :key #'car))
(defun pretty-print-readtable (&key ((readtable rt) *readtable*)
(stream *standard-output*))
"Prints a human-readable summary of a readtable."
(let* ((terminating-macros '())
(potential-dispatch-pairs '())
(dispatch-info '())
(other-macros '())
(characters (get-character-range)))
(loop for char in characters
do (multiple-value-bind (fn non-terminating-p) (get-macro-character char rt)
(when fn
(if non-terminating-p
(push (list char fn) potential-dispatch-pairs)
(push (list char fn) terminating-macros)))))
(loop for (dchar dchar-fn) in potential-dispatch-pairs
do (let ((sub-entries '())
(actually-dispatch nil))
(loop for sub-char in characters
do (let ((sub-fn (get-dispatch-macro-character dchar sub-char rt)))
(when sub-fn
(setf actually-dispatch t)
(push (list sub-char sub-fn) sub-entries))))
(if actually-dispatch
(push (list dchar (nreverse sub-entries)) dispatch-info)
(push (list dchar dchar-fn) other-macros))))
(format stream "Readtable ~A~%" rt)
(format stream " Case Sensitivity: ~A~%~%" (readtable-case rt))
(format stream " Terminating Macro Characters:~%")
(if terminating-macros
(loop for (char fn) in (sort-by-char terminating-macros)
do (format stream " ~A => ~A~%" (safe-char-name char) fn))
(format stream " (None found in the checked character set)~%"))
(format stream "~% Dispatch Macro Characters:~%")
(let ((sorted-dispatch-info (sort-by-char dispatch-info)))
(if sorted-dispatch-info
(loop for (dchar sub-entries) in sorted-dispatch-info
do (format stream " ~A :~%" (safe-char-name dchar))
(let ((sorted-maps (sort-by-char sub-entries)))
(if sorted-maps
(loop for (sub-char sub-fn) in sorted-maps
do (format stream " ~A => ~A~%" (safe-char-name sub-char) sub-fn))
(format stream " (No sub-characters found within the checked set, LOL U OK?)~%"))))
(format stream " (None found with definitions in the checked character set)~%")))
(setf other-macros (sort-by-char other-macros))
(when other-macros
(format stream "~% Other Non-Terminating Macro Characters (No sub-chars found in checked set):~%")
(loop for (char fn) in other-macros
do (format stream " ~A => " (safe-char-name char))
(let ((*print-readably* nil))
(write fn :stream stream :escape t :pretty nil))
(format stream "~%")))
(terpri stream)))Thanks for your work!