private/pretty-helper.ss
(module pretty-helper mzscheme
  (provide (all-defined))
  
  ;; Fixme: null object still confusable.
  
  ;; Problem: If stx1 and stx2 are two distinguishable syntax objects, it
  ;; still may be the case that (syntax-e stx1) and (syntax-e stx2) are
  ;; indistinguishable.
  
  ;; Solution: Rather than map stx to (syntax-e stx), in the cases where
  ;; (syntax-e stx) is confusable, map it to a different, unique, value.
  ;;   - stx is identifier : map it to an uninterned symbol w/ same rep
  ;;     (Symbols are useful: see pretty-print's style table)
  ;;   - else : map it to a syntax-dummy object
  
  (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)))
  )