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