[plt-scheme] A question on "expand"

On Nov 12, Robert Bruce Findler wrote:
> The latest version of DrScheme gives you much better feedback about
> syntax objects. In the REPL, they have a little turn down knobby
> that, when turned, shows you all kinds of information about them.

[Wouldn't it be possible to use the syntax marks thing to do a step by
step expansion and show the new stuff at each stage with a different
color?]


> If you can't get to the CVS archive, you might instead use
> syntax-object->datum -- it produces an sexp version of the syntax
> object.

I have some code that fits nicely in the .mzschemerc file.  It allows
you to do this:

  > (-test (let/cc foo (cond (x1 x2))))
  --> (let/cc foo (cond (x1 x2)))
  > -step*
  --> (call/cc (lambda (foo) (cond (x1 x2))))
  --> (#%app call/cc (lambda (foo) (if (#%top . x1) (begin (#%top . x2)) (#%app void))))
  --> (#%app call/cc (lambda (foo) (if (#%top . x1) (begin (#%top . x2)) (#%app void))))
  --> ...

You get these things:

  (-test foo) - uses `foo' as the current syntax
  -test       - return the current syntax as an s-exp (the rest return
                void)
  -step       - expand-once
  -expand     - complete expand
  -step*      - expand-once until no change

and you can set and do some operation quickly by supplying an initial
syntax as in:

  > (-step* (let/cc foo (cond (x1 x2))))
  --> (let/cc foo (cond (x1 x2)))
  --> (call/cc (lambda (foo) (cond (x1 x2))))
  --> (#%app call/cc (lambda (foo) (if (#%top . x1) (begin (#%top . x2)) (#%app void))))
  --> (#%app call/cc (lambda (foo) (if (#%top . x1) (begin (#%top . x2)) (#%app void))))
  --> ...

I couldn't figure out any way to do a step-by-step expansion and
avoid getting the result infected with "#%"s and other things you
usually don't want to see (like define/let-values etc).  At least not
without some reimplementation of expand.

Here is the code:
-------------------------------------------------------------------------------
;; 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
(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) v)
                             ((:expand) (expand v))
                             ((:expand-once :expand*) (expand-once v))
                             (else msg))))
             (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)
  (apply values (map (lambda (msg)
                       (lambda (stx)
                         (syntax-case stx ()
                           ((_ expr) #'(begin (-test expr) _))
                           (_ #`(-test #,msg)))))
                     '(:expand-once :expand* :expand))))
-------------------------------------------------------------------------------

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