CODEWITHSUNDEEP
common-lispsbclslime
Andrei
Andrei

Reputation: 2665

Limit length of strings in debug output

I use emacs, slime, and sbcl. When I'm thrown into debugger when condition occurs, how do I limit the size of the output? I have figured out *print-length* and *print-level*, but what to do about long strings or strings with many lines? Say,

(defun monkeys (length)
  "Generate a random string"
  (with-output-to-string (out)
    (dotimes (i length)
      (write-char
       (code-char
        (let ((c (random 27)))
          (if (zerop c)
              (if (zerop (random 5)) 10 32)
              (+ 95 c)))) out))))

(1+ (monkeys 10000)) ; drop into debugger

Upvotes: 4

Views: 440

Answers (2)

Andrei
Andrei

Reputation: 2665

Long story short, on sbcl *print-vector-length* can be used. From the SBCL source code:

(defparameter *print-vector-length* nil
  "Like *PRINT-LENGTH* but works on strings and bit-vectors.
Does not affect the cases that are already controlled by *PRINT-LENGTH*")

Long story long, I somehow never thought to look at the source code. However, thanks to the answer from @tfb, I at least had a starting point. So I went on to read about the pretty printer's dispatch table, and, just to see how dispatch functions look, I checked what the default dispatch function for 'string is:

(pprint-dispatch 'string)

That gives #<FUNCTION SB-KERNEL:OUTPUT-UGLY-OBJECT>. I searched for it in the SBCL source code and found the necessary parameter along the way.

Upvotes: 5

user5920214
user5920214

Reputation:

The CL printer is a complicated and wonderful thing, and I've forgotten most of the little I used to know about it, so this answer may well be wrong.

There is no trivial way to control the printing of large strings: you can control the printing of large general arrays with *print-array*, but there is a special exception for strings in that.

There is then a bad approach and a less-bad approach.

The bad approach: define a method on print-object. I think you are allowed to do this for strings, but if you do this then your method will be called whenever you want a string to be printed, so you had better be sure it is right. Probably the way of ensuring that is to make sure that it listens to some variable and, unless the variable asks it to do something it just uses call-next-method to punt to an implementation which probably is right.

The less-bad approach: use the pretty printer's dispatch table to do what you need. This is less-bad (and perhaps even good) because it won't alter what happens when *print-pretty* is false and you also can simply put back the original table whenever you want to.

Here is a toy attempt to do this. Warning: I have not spent enough time to think hard enough about how this interacts with all the printer control settings, and as I said I have forgotten a lot of the details, so it is almost certainly simply incorrect in many cases. So, don't use this in production code, but something like it might be adequate for debugging purposes, where what gets printed just has to tell you enough to debug the program & need not be correct in every detail.

(defvar *toy-print-pprint-dispatch*
  ;; a copy of the default pprint dispatch table
  (copy-pprint-dispatch nil))

(defvar *longest-string*
  ;; the longest string we try to print properly
  40)

(defun write-string-maybe (stream string)
  ;; Maybe write a string.
  (check-type string string "not a string")
  (cond (*print-readably*
         (write string :stream stream :pretty nil :readably t))
        ((<= (length string) *longest-string*)
         (write string :stream stream :pretty nil))
        (t
         ;; pretty sure this is wrong as it should defang the string
         ;; at least
         (print-unreadable-object (string stream :type t)
           (write-string string stream :start 0 :end *longest-string*)
           (write-string "..." stream )))))

(set-pprint-dispatch 'string 'write-string-maybe 0 *toy-print-pprint-dispatch*)

(defun monkeys (length)
  "Generate a random string"
  (with-output-to-string (out)
    (dotimes (i length)
      (write-char
       (code-char
        (let ((c (random 27)))
          (if (zerop c)
              (if (zerop (random 5)) 10 32)
              (+ 95 c)))) out))))

(defun test-it ()
  (let ((*print-pretty* t)
        (*print-pprint-dispatch* *toy-print-pprint-dispatch*))
    (print (monkeys *longest-string*))
    (print (monkeys (* *longest-string* 2)))
    (let ((*print-pretty* nil))
      (print (monkeys (* *longest-string* 2))))
    (values)))

And now:

> (test-it)

"pcbkhetnbanuvsvsvqobbqlcodnafmpgdnlku pf" 
#<simple-base-string vehgsgnjxixyp`hq`wcwwskmcg`r`jdplcsbdxvo...> 
"tp ixreii ixpeb`pgrvcobcbysgikylabidrierclrijo`edugnerlslj srryypbpravomcuxupynf"

Upvotes: 4

Related Questions