From 8352e11979282b36702f67aa7915d79bd83960a3 Mon Sep 17 00:00:00 2001
From: Ryan Culpepper <ryanc@racket-lang.org>
Date: Fri, 5 Mar 2010 01:40:42 +0000
Subject: [PATCH] macro-debugger:   fixed bug re eval'd top-level forms that
 cause errors   fixed bug re lazy phase 1 init and #%top-interaction
 unwrapping

svn: r18472

original commit: 68c4c11514b625a8b4dc4127cb5e21a518f7108f
---
 collects/macro-debugger/model/deriv-c.ss      |  4 ++--
 collects/macro-debugger/model/deriv-parser.ss | 13 ++++++++-----
 collects/macro-debugger/model/reductions.ss   |  5 +++--
 collects/macro-debugger/model/trace.ss        |  1 +
 collects/macro-debugger/view/stepper.ss       |  7 ++++---
 5 files changed, 18 insertions(+), 12 deletions(-)

diff --git a/collects/macro-debugger/model/deriv-c.ss b/collects/macro-debugger/model/deriv-c.ss
index 7bfb10c..09966bf 100644
--- a/collects/macro-debugger/model/deriv-c.ss
+++ b/collects/macro-debugger/model/deriv-c.ss
@@ -169,6 +169,6 @@
 
 
 ;; ECTE represents expand/compile-time-evals
-;; (make-ecte stx ?stx (listof LocalAction) Deriv Deriv)
+;; (make-ecte stx ?stx (listof LocalAction) Deriv Deriv (listof LocalAction))
 
-(define-struct (ecte deriv) (locals first second) #:transparent)
+(define-struct (ecte deriv) (locals first second locals2) #:transparent)
diff --git a/collects/macro-debugger/model/deriv-parser.ss b/collects/macro-debugger/model/deriv-parser.ss
index f4c7dd8..9124ea6 100644
--- a/collects/macro-debugger/model/deriv-parser.ss
+++ b/collects/macro-debugger/model/deriv-parser.ss
@@ -68,10 +68,12 @@
    (productions/I
 
     (ExpandCTE
-     ;; The 'Eval' is there for---I believe---lazy phase 1 initialization.
-     [(visit start (? Eval) (? CheckImmediateMacro/Lifts) top-non-begin start (? EE) return)
-      (make ecte $1 $8 $3 $4 $7)]
-     [(visit start Eval CheckImmediateMacro/Lifts top-begin (? NextExpandCTEs) return)
+     ;; The first 'Eval' is there for---I believe---lazy phase 1 initialization.
+     [(visit start (? Eval) (? CheckImmediateMacro/Lifts)
+             top-non-begin start (? EE) (? Eval) return)
+      (make ecte $1 $9 $3 $4 $7 $8)]
+     [(visit start Eval CheckImmediateMacro/Lifts
+             top-begin (? NextExpandCTEs) return)
       (begin
         (unless (list? $6)
           (error "NextExpandCTEs returned non-list ~s" $6))
@@ -80,7 +82,8 @@
                     (make lderiv (cdr (stx->list $5))
                           (and $7 (cdr (stx->list $7)))
                           #f
-                          $6))))])
+                          $6))
+              null))])
 
     (CheckImmediateMacro/Lifts
      [((? CheckImmediateMacro))
diff --git a/collects/macro-debugger/model/reductions.ss b/collects/macro-debugger/model/reductions.ss
index c7474b9..574a211 100644
--- a/collects/macro-debugger/model/reductions.ss
+++ b/collects/macro-debugger/model/reductions.ss
@@ -280,13 +280,14 @@
 
     ;; expand/compile-time-evals
 
-    [(Wrap ecte (e1 e2 locals first second))
+    [(Wrap ecte (e1 e2 locals first second locals2))
      (R [#:pattern ?form]
         [#:pass1]
         [LocalActions ?form locals]
         [Expr ?form first]
         [#:pass2]
-        [Expr ?form second])]
+        [Expr ?form second]
+        [LocalActions ?form locals2])]
 
     ;; Lifts
 
diff --git a/collects/macro-debugger/model/trace.ss b/collects/macro-debugger/model/trace.ss
index 9bd48ca..3d0b0da 100644
--- a/collects/macro-debugger/model/trace.ss
+++ b/collects/macro-debugger/model/trace.ss
@@ -115,6 +115,7 @@
          (begin
            (emit 'top-non-begin)
            (let ([e (expand-syntax e1)])
+             ;; Must set to void to avoid catching DrScheme's annotations...
              (parameterize ((current-expand-observe void))
                (eval-compile-time-part e))
              e))]))
diff --git a/collects/macro-debugger/view/stepper.ss b/collects/macro-debugger/view/stepper.ss
index 00f73ec..f4f2e5f 100644
--- a/collects/macro-debugger/view/stepper.ss
+++ b/collects/macro-debugger/view/stepper.ss
@@ -433,16 +433,17 @@
            (and first
                 (let ([e1 (wderiv-e1 first)])
                   (make-lift-deriv e1 e2 first lifted-stx second))))]
-        [(Wrap ecte (e1 e2 locals first second))
+        [(Wrap ecte (e1 e2 '() first second locals2))
+         ;; Only adjust if no locals...
          (let ([first (adjust-deriv/lift first)])
            (and first
                 (let ([e1 (wderiv-e1 first)])
-                  (make ecte e1 e2 locals first second))))]
+                  (make ecte e1 e2 '() first second locals2))))]
         [else (adjust-deriv/top deriv)]))
 
     ;; adjust-deriv/top : Derivation -> Derivation
     (define/private (adjust-deriv/top deriv)
-      (if (or (not deriv)
+      (if (or (not (base? deriv))
               (syntax-original? (wderiv-e1 deriv))
               (p:module? deriv))
           deriv