commit 8352e11979282b36702f67aa7915d79bd83960a3
parent 3a4f5fb119a6565d7e9e9897b689ccbea462d139
Author: Ryan Culpepper <ryanc@racket-lang.org>
Date: Fri, 5 Mar 2010 01:40:42 +0000
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
Diffstat:
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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
