[plt-scheme] pretty-print not so pretty

On Thu, 18 Jan 2007, Kyle Smith wrote:

> Hi folks,
>
> What I'm after is to display the application, whence a result came from; 
> this was my attempt:
>
> (require (lib "pretty.ss"))
>
> (define-syntax (phere stx)
> (syntax-case stx ()
>   ((_ app ...) #'(begin (pretty-display 'app ...) app ...))))
> (phere (let ([x 0])
>        (let ([y 1])
>          (display (+ y x)))))


Hi Kyle,

What I did is more involved than I anticipated, but here's something that 
might help:

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(module pretty-tab mzscheme
   (require (lib "framework.ss" "framework")
            (lib "pretty.ss")
            (lib "class.ss"))

   (provide pretty-scheme-stx->string)

   ;; pretty-scheme-stx->string: stx -> string
   ;; Tries to prettify the stx using scheme:text%'s tabify.
   (define (pretty-scheme-stx->string stx)
     (define (open stx)
       (case (syntax-property stx 'paren-shape)
         [(#\[) "["]
         [(#\{) "{"]
         [else "("]))
     (define (close stx)
       (case (syntax-property stx 'paren-shape)
         [(#\[) "]"]
         [(#\{) "}"]
         [else ")"]))

     (define (write-stx stx outp)
       (let loop ([stx stx]
                  [last-line (syntax-line stx)])
         (when (not (= last-line (syntax-line stx)))
           (newline outp))
         (syntax-case stx ()
           [(e1 e2 ...)
            (begin
              (display (open stx) outp)
              (loop (syntax e1) (syntax-line stx))
              (for-each (lambda (sub-stx)
                          (display " " outp)
                          (loop sub-stx (syntax-line stx)))
                        (syntax-e (syntax (e2 ...))))
              (display (close stx) outp))]
           [else
            (print (syntax-object->datum stx) outp)])))

     (let-values ([(text) (new scheme:text%)]
                  [(inp outp) (make-pipe)])
       (write-stx stx outp)
       (close-output-port outp)
       (send text insert-port inp)
       (send text tabify-all)
       (send text get-text))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


The provided function takes in an stx and returns a string using the same 
indentation standards as DrScheme:

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
> (display (pretty-scheme-stx->string #' (module foo mzscheme
                                    (define x 42)
                                    (let ([x 4])
                                      (let ([y 3]
                                            [z 5])
                                        (+ x y x x x x x x x x y x))))))
(module foo mzscheme
   (define x 42)
   (let ([x 4])
     (let ([y 3]
           [z 5])
       (+ x y x x x x x x x x y x))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



Your macro then can become:

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(module test mzscheme
   (require "pretty-tab.scm")
   (define-syntax (phere stx)
     (syntax-case stx ()
       ((_ app)
        (with-syntax ([app-stx (datum->syntax-object
                                #f
                                (syntax-e (syntax app))
                                stx)])
          #'(begin
              (display (pretty-scheme-stx->string (syntax app-stx)))
              (newline)
              app)))))


   (phere (let ([x 0]
                {z 42})
            (let ([y 1])
              (display (+ y x))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



I hope this helps!