[plt-scheme] how to debug expansions to top-level forms?

On Jun 26, Matthew Flatt wrote:
> 
> At Thu, 26 Jun 2003 10:39:23 -0400, "Felix Klock's PLT scheme proxy" wrote:
> >  > (expand (bind-to-vals (values 1 2 3) x y z))
> > define-values: illegal use (not at top-level) in: (define-values (x y 
> > z) (values 1 2 3))
> 
> `expand' is a function, nor a syntactic form, and it takes an
> S-expression or syntax object.

I think that I posted this once already, but it doesn't hurt to
repeat...  I have the code below in my .mzschemerc, which I can use to
do stuff like this:

  > (-test (when foo bar))
  --> (when foo bar)
  > -step
  --> (if foo (begin bar))
  > (-test (when foo bar))
  --> (when foo bar)
  > -step*
  --> (if foo (begin bar))
  --> (if (#%top . foo) (begin (#%top . bar)))
  --> (if (#%top . foo) (begin (#%top . bar)))
  --> ...

There is a `-pp', which should probbaly be the default for all of
them.

----------------------------------------------------------------------
;; Syntax debugging
;; -test or (-test)     returns current syntax object as an s-expression
;; (-test foo)          set current
;; (-test :this)        show current
;; (-test :expand)      expand current (possibly in a context)
;; (-test :expand-once) expand one step
;; (-test :expand*)     expand one step repeatedly
;; (-test :pp)                 pprint current
(define-syntax -test
  (let ((v #f)
        (->datum (lambda (x) (if (syntax? x) (syntax-object->datum x) x))))
    (lambda (stx)
      (syntax-case stx ()
        ((_ m)
         (let ((msg #'m))
           (let loop ((new (case (->datum msg)
                             ((:this :pp) v)
                             ((:expand) (expand v))
                             ((:expand-once :expand*) (expand-once v))
                             (else msg))))
             (if (eq? ':pp (->datum msg))
               ((dynamic-require '(lib "pretty.ss") 'pretty-print)
                (->datum new))
               (printf "--> ~s\n" (->datum new)))
             (let ((old v))
               (set! v new)
               (when (eq? (->datum msg) ':expand*)
                 (if (equal? (->datum new) (->datum old))
                   (printf "--> ...\n")
                   (loop (expand-once v))))))
           #'(void)))
        (_ #`'#,v)))))
;; shortcuts: each one calls the above with a message when used as -foo,
;; setting the expression first if it was used with one as in (-foo expr).
(define-syntaxes (-step -step* -expand -pp)
  (apply values (map (lambda (msg)
                       (lambda (stx)
                         (syntax-case stx ()
                           ((_ expr) #'(begin (-test expr) _))
                           (_ #`(-test #,msg)))))
                     '(:expand-once :expand* :expand :pp))))
----------------------------------------------------------------------

-- 
          ((lambda (x) (x x)) (lambda (x) (x x)))          Eli Barzilay:
                  http://www.barzilay.org/                 Maze is Life!