Failed attempt at tracking output
(defun tracking-pprint-to-string/sbcl (object) | |
(let ((positions nil) | |
(original-table *print-pprint-dispatch*) | |
(table (copy-pprint-dispatch))) | |
(values (with-output-to-string (stream) | |
(set-pprint-dispatch 'cons | |
(lambda (stream cons) | |
(push (list (+ (sb-pretty::pretty-stream-buffer-fill-pointer stream) | |
(sb-pretty::pretty-stream-buffer-offset stream)) | |
cons) | |
positions) | |
(funcall (pprint-dispatch cons original-table) stream cons)) | |
most-positive-fixnum | |
table) | |
(write object | |
:stream stream | |
:pretty t | |
:pprint-dispatch table)) | |
positions))) |
(in-package :swank-macrostep) | |
(defparameter *dbg* nil) | |
(defclass tracking-string-output-stream | |
(swank/gray:fundamental-character-output-stream) | |
((output :initarg :output :accessor output-of | |
:initform (make-array 30 | |
:adjustable t | |
:fill-pointer 0 | |
:element-type 'character)) | |
(position :initform 0 :accessor position-of))) | |
(defmethod swank/gray:stream-write-char ((stream tracking-string-output-stream) | |
character) | |
(vector-push-extend character (output-of stream)) | |
(push (incf (position-of stream)) *dbg*)) | |
(let ((result) | |
(position 0) | |
(stream (make-instance 'tracking-string-output-stream)) | |
(table (copy-pprint-dispatch))) | |
(set-pprint-dispatch 'cons | |
(lambda (stream cons) | |
(push cons *dbg*) | |
(pprint-fill stream cons)) | |
0 | |
table) | |
(write '(unless t (foo)) | |
:stream stream | |
:pretty t | |
:pprint-dispatch table) | |
*dbg*) | |
; => | |
((UNLESS T (FOO)) (FOO) 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment