From 9bee07b7c048b0db9716c1ccdd0655e7f2797124 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Thu, 7 Jul 2011 13:37:54 -0600
Subject: [PATCH] fix debugger for syntax taints

---
 collects/gui-debugger/annotator.rkt | 33 +++++++++++++++++------------
 1 file changed, 20 insertions(+), 13 deletions(-)

diff --git a/collects/gui-debugger/annotator.rkt b/collects/gui-debugger/annotator.rkt
index 17b8593155..cc96b2afc6 100644
--- a/collects/gui-debugger/annotator.rkt
+++ b/collects/gui-debugger/annotator.rkt
@@ -159,14 +159,18 @@
       (define (top-level-annotate stx)
         (kernel:kernel-syntax-case/phase
          stx (namespace-base-phase)
-         [(module identifier name (plain-module-begin . module-level-exprs))
-          (with-syntax ([(module . _) stx])
-            (quasisyntax/loc stx (module identifier name
-                                   (plain-module-begin 
-                                    #,@(map (lambda (e) (module-level-expr-iterator
-                                                         e (list (syntax-e #'identifier)
-                                                                 (syntax-source #'identifier))))
-                                            (syntax->list #'module-level-exprs))))))]
+         [(module identifier name mb)
+          (syntax-case (disarm #'mb) ()
+            [(plain-module-begin . module-level-exprs)
+             (with-syntax ([(module . _) stx])
+               (quasisyntax/loc stx (module identifier name
+                                      #,(rearm
+                                         #'mb
+                                         #`(plain-module-begin 
+                                            #,@(map (lambda (e) (module-level-expr-iterator
+                                                                 e (list (syntax-e #'identifier)
+                                                                         (syntax-source #'identifier))))
+                                                    (syntax->list #'module-level-exprs)))))))])]
          [else-stx
           (general-top-level-expr-iterator stx  #f)]))
       
@@ -238,7 +242,7 @@
         
         (define (let/rec-values-annotator letrec?)
           (kernel:kernel-syntax-case
-           expr #f
+           (disarm expr) #f
            [(label (((var ...) rhs) ...) . bodies)
             (let* ([new-bindings (apply append
                                         (map syntax->list
@@ -305,9 +309,10 @@
                    #,@new-bodies))))]))
         
         (define annotated
-          (syntax-rearm
+          (rearm
+           expr
            (kernel:kernel-syntax-case
-            (syntax-disarm expr code-insp) #f
+            (disarm expr) #f
             [var-stx (identifier? (syntax var-stx))
                      (let ([binder (and (syntax-original? expr)
                                         (srfi:member expr bound-vars free-identifier=?))])
@@ -378,8 +383,7 @@
             [(#%variable-reference . _) expr]
             
             [else (error 'expr-syntax-object-iterator "unknown expr: ~a"
-                         (syntax->datum expr))])
-           expr))
+                         (syntax->datum expr))])))
         
         (if annotate-break?
             (break-wrap
@@ -391,4 +395,7 @@
       
       (values (top-level-annotate stx) (hash-map breakpoints (lambda (k v) k)))))
 
+  (define (disarm stx) (syntax-disarm stx code-insp))
+  (define (rearm old new) (syntax-rearm new old))
+
   (define code-insp (current-code-inspector)))