private/pretty-helper.ss
(module pretty-helper mzscheme
  (provide (all-defined))
  
  (define-struct syntax-dummy (val))
  
  ;; syntax->datum/tables : stx -> (values s-expr hashtable hashtable)
  ;; Returns three values:
  ;;   - an S-expression
  ;;   - a hashtable mapping S-expressions to syntax objects
  ;;   - a hashtable mapping syntax objects to S-expressions
  ;; Syntax objects which are eq? will map to same flat values
  (define (syntax->datum/tables stx)
    (let ([flat=>stx (make-hash-table)]
          [stx=>flat (make-hash-table)])
      (values (let loop ([obj stx])
                (cond
                  [(hash-table-get stx=>flat obj (lambda _ #f))
                   => (lambda (datum) datum)]
                  [(syntax? obj)
                   (let ([lp-datum (loop (syntax-e obj))])
                     (hash-table-put! flat=>stx lp-datum obj)
                     (hash-table-put! stx=>flat obj lp-datum)
                     lp-datum)]
                  [(pair? obj) 
                   (cons (loop (car obj))
                         (loop (cdr obj)))]
                  [(vector? obj) 
                   (list->vector (map loop (vector->list obj)))]
                  [(symbol? obj)
                   (make-syntax-dummy obj)
                   #;(string->uninterned-symbol (symbol->string obj))]
                  [(number? obj)
                   (make-syntax-dummy obj)]
                  [else obj]))
              flat=>stx
              stx=>flat)))
  )