[plt-scheme] Detecting cycles when traversing through shared graph syntax objects?

From: Danny Yoo (dyoo at hkn.eecs.berkeley.edu)
Date: Wed Apr 12 17:49:54 EDT 2006

Hi everyone,

I've been recently trying to understand how people deal with graphs in 
syntax objects.  One example of this is:

(module test-evil mzscheme
   (require (lib "stx.ss" "syntax")
            (lib "list.ss"))

   (define nice-syntax-object (syntax (hello (world))))

   ;; The syntax object representing an infinite series of ones.
   (define evil-syntax-object
      (open-input-string "#0=(1 . #0#)")))

   ;; Go through syntax, return list of all identifiers we see, free or
   ;; bound.
   (define (find-identifiers-broken stx)
     (let ([seen-stxs (make-hash-table)])
       (let loop ([stx stx])
         (cond [(hash-table-get seen-stxs stx (lambda () #f))
                (hash-table-put! seen-stxs stx #t)
                (syntax-case stx ()
                  [_ (identifier? stx)
                     (list stx)]
                  [(x y ...)
                   (append (loop #'x)
                           (loop #'(y ...)))]
                  [else empty])])))))

Trying to evaluate find-identifiers-broken on evil-syntax-object is an 
infinite loop. I naively thought that keeping some hash-table to traverse 
the structure would allow me to avoid cycles, but unfortunately, nope. 
My question is: how do people handle this?

(This actually seems like a problem for other things like the DrScheme 
repl, which doesn't appear to capture the cycles either when it tries to 
display the evil-syntax-object.)

I see that Help Desk's documentation on syntax-graph? recommends using 
syntax-object->datum to detect cycles, so I suppose I could do some kind 
of parallel traversal of the syntax object and its datum partner.

Ah.  This appears to do the trick:

   (define (find-identifiers stx)
     (let ([seen-data (make-hash-table)])
       ;; subtle: we can't reliably do eq? on syntax to detect sharing,
       ;; but we CAN do it on the syntax-object->datum-ed value.  So
       ;; we keep both, and do a parallel traversal.
       (let loop ([stx stx]
                  [datum (syntax-object->datum stx)])
         (cond [(hash-table-get seen-data datum (lambda () #f))
                (hash-table-put! seen-data datum #t)
                  [(identifier? stx)
                   (list stx)]
                  [(stx-pair? stx)
                   (append (loop (stx-car stx)
                                 (car datum))
                           (loop (stx-cdr stx)
                                 (cdr datum)))]
                  [else empty])]))))

Am I understanding the situation properly?

Thanks in advance!

Posted on the users mailing list.