限制调试输出中的字符串长度

Limit length of strings in debug output

我使用 emacs、slime 和 sbcl。当条件发生时我被扔进调试器,我该如何限制输出的大小? *print-length**print-level*我都算出来了,但是长字符串或者多行字符串怎么办呢?说,

(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

CL 打印机是一个复杂而奇妙的东西,我已经忘记了大部分我以前对它的了解,所以这个答案很可能是错误的。

没有简单的方法来控制大字符串的打印:您可以使用 *print-array* 控制大的一般数组的打印,但字符串有一个特殊的例外。

然后有一个不好的方法和一个不太坏的方法。

糟糕的方法:在print-object上定义一个方法。我认为您可以对字符串执行此操作,但如果您这样做,那么只要您想要打印字符串,就会调用您的方法,因此您最好确保它是正确的。确保这一点的方法可能是确保它监听某个变量,除非变量要求它做某事,否则它只使用 call-next-method 来实现可能是正确的。

不太坏的方法:使用漂亮的打印机调度table做你需要的。这没有那么糟糕(甚至可能很好),因为它不会改变 *print-pretty* 为假时发生的事情,你也可以随时放回原来的 table。

这是一个尝试这样做的玩具。 警告:我没有花足够的时间认真思考它是如何与所有打印机控制设置交互的,正如我所说的,我已经忘记了很多细节,所以它几乎是在许多情况下肯定是不正确的。所以,不要在生产代码中使用它,但类似的东西可能足以用于调试目的,其中打印的内容只需要告诉你足够的信息来调试程序并且不需要在每个细节上都是正确的。

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

现在:

> (test-it)

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

长话短说,在sbcl上*print-vector-length*可以用。来自 SBCL 源代码:

(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*")

长话短说,我从来没想过要看源代码。但是,感谢@tfb 的回答,我至少有了一个起点。所以我继续阅读有关漂亮打印机的调度 table,并且为了查看调度函数的外观,我检查了 'string 的默认调度函数是什么:

(pprint-dispatch 'string)

那就是 #<FUNCTION SB-KERNEL:OUTPUT-UGLY-OBJECT>。我在SBCL源码里找了找,顺带找到了必要的参数