macro-stepper: more work on syntax tainting

collects/macro-debugger/model/context.rkt

@@ -1,5 +1,6 @@
 #lang racket/base
-(require syntax/stx)
+(require syntax/stx
+         "stx-util.rkt")
 (provide (struct-out ref)
          (struct-out tail)
          path-get
@@ -7,21 +8,6 @@
          path-replace
          pathseg-replace)
 
-;; Update for syntax taint: On get, disarm stx on the way, but don't
-;; disarm final stx. On replace, disarm and rearm along the way.
-
-(define (stx-disarm stx)
-  (if (syntax? stx) (syntax-disarm stx (current-code-inspector)) stx))
-
-(define (stx-car* stx)
-  (let ([stx (stx-disarm stx)]) (stx-car stx)))
-
-(define (stx-cdr* stx)
-  (let ([stx (stx-disarm stx)]) (stx-cdr stx)))
-
-(define (syntax-e* stx)
-  (syntax-e (stx-disarm stx)))
-
 ;; A Path is a (list-of PathSeg)
 ;; where the PathSegs are listed outermost to innermost
 ;; for example: (path-get #'((a b) (c d)) (list (make-ref 0) (make-ref 1))) = #'b, not #'c

collects/macro-debugger/model/stx-util.rkt

@@ -1,10 +1,42 @@
 #lang racket/base
 (require (for-syntax racket/base)
          syntax/stx)
-(provide stx->datum
+(provide stx-disarm
+         stx-car*
+         stx-cdr*
+         syntax-e*
+         stx->list*
+         stx->datum
          syntaxish?
          syntax-copier)
 
+;; Update for syntax taint: On get, disarm stx on the way, but don't
+;; disarm final stx. On replace, disarm and rearm along the way.
+
+(define (stx-disarm stx)
+  (if (syntax? stx) (syntax-disarm stx (current-code-inspector)) stx))
+
+(define (stx-car* stx)
+  (let ([stx (stx-disarm stx)]) (stx-car stx)))
+
+(define (stx-cdr* stx)
+  (let ([stx (stx-disarm stx)]) (stx-cdr stx)))
+
+(define (syntax-e* stx)
+  (syntax-e (stx-disarm stx)))
+
+(define (stx->list* stx)
+  (if (stx-list? stx)
+      (let loop ([stx stx])
+        (cond [(syntax? stx)
+               (loop (syntax-e* stx))]
+              [(pair? stx)
+               (cons (car stx) (loop (cdr stx)))]
+              [else stx]))
+      #f))
+
+;; ----
+
 (define (stx->datum x)
   (syntax->datum (datum->syntax #f x)))
 

collects/macro-debugger/syntax-browser/pretty-helper.rkt

@@ -3,7 +3,8 @@
          unstable/class-iop
          syntax/stx
          unstable/struct
-         "interfaces.rkt")
+         "interfaces.rkt"
+         "../model/stx-util.rkt")
 (provide (all-defined-out))
 
 ;; Problem: If stx1 and stx2 are two distinguishable syntax objects, it
@@ -100,7 +101,7 @@
                       lp-datum))]
               [(syntax? obj)
                (when partition (send/i partition partition<%> get-partition obj))
-               (let ([lp-datum (loop (syntax-e obj))])
+               (let ([lp-datum (loop (syntax-e* obj))])
                  (hash-set! flat=>stx lp-datum obj)
                  (hash-set! stx=>flat obj lp-datum)
                  lp-datum)]
@@ -151,7 +152,7 @@
 
 ;; check+convert-special-expression : syntax -> #f/syntaxish
 (define (check+convert-special-expression stx)
-  (define stx-list (stx->list stx))
+  (define stx-list (stx->list* stx))
   (and stx-list (= 2 (length stx-list))
        (let ([kw (car stx-list)]
              [expr (cadr stx-list)])