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
This commit is contained in:
Ryan Culpepper 2010-03-05 01:40:42 +00:00
parent 3a4f5fb119
commit 8352e11979
5 changed files with 18 additions and 12 deletions

View File

@ -169,6 +169,6 @@
;; ECTE represents expand/compile-time-evals ;; 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)

View File

@ -68,10 +68,12 @@
(productions/I (productions/I
(ExpandCTE (ExpandCTE
;; The 'Eval' is there for---I believe---lazy phase 1 initialization. ;; The first 'Eval' is there for---I believe---lazy phase 1 initialization.
[(visit start (? Eval) (? CheckImmediateMacro/Lifts) top-non-begin start (? EE) return) [(visit start (? Eval) (? CheckImmediateMacro/Lifts)
(make ecte $1 $8 $3 $4 $7)] top-non-begin start (? EE) (? Eval) return)
[(visit start Eval CheckImmediateMacro/Lifts top-begin (? NextExpandCTEs) return) (make ecte $1 $9 $3 $4 $7 $8)]
[(visit start Eval CheckImmediateMacro/Lifts
top-begin (? NextExpandCTEs) return)
(begin (begin
(unless (list? $6) (unless (list? $6)
(error "NextExpandCTEs returned non-list ~s" $6)) (error "NextExpandCTEs returned non-list ~s" $6))
@ -80,7 +82,8 @@
(make lderiv (cdr (stx->list $5)) (make lderiv (cdr (stx->list $5))
(and $7 (cdr (stx->list $7))) (and $7 (cdr (stx->list $7)))
#f #f
$6))))]) $6))
null))])
(CheckImmediateMacro/Lifts (CheckImmediateMacro/Lifts
[((? CheckImmediateMacro)) [((? CheckImmediateMacro))

View File

@ -280,13 +280,14 @@
;; expand/compile-time-evals ;; expand/compile-time-evals
[(Wrap ecte (e1 e2 locals first second)) [(Wrap ecte (e1 e2 locals first second locals2))
(R [#:pattern ?form] (R [#:pattern ?form]
[#:pass1] [#:pass1]
[LocalActions ?form locals] [LocalActions ?form locals]
[Expr ?form first] [Expr ?form first]
[#:pass2] [#:pass2]
[Expr ?form second])] [Expr ?form second]
[LocalActions ?form locals2])]
;; Lifts ;; Lifts

View File

@ -115,6 +115,7 @@
(begin (begin
(emit 'top-non-begin) (emit 'top-non-begin)
(let ([e (expand-syntax e1)]) (let ([e (expand-syntax e1)])
;; Must set to void to avoid catching DrScheme's annotations...
(parameterize ((current-expand-observe void)) (parameterize ((current-expand-observe void))
(eval-compile-time-part e)) (eval-compile-time-part e))
e))])) e))]))

View File

@ -433,16 +433,17 @@
(and first (and first
(let ([e1 (wderiv-e1 first)]) (let ([e1 (wderiv-e1 first)])
(make-lift-deriv e1 e2 first lifted-stx second))))] (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)]) (let ([first (adjust-deriv/lift first)])
(and first (and first
(let ([e1 (wderiv-e1 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)])) [else (adjust-deriv/top deriv)]))
;; adjust-deriv/top : Derivation -> Derivation ;; adjust-deriv/top : Derivation -> Derivation
(define/private (adjust-deriv/top deriv) (define/private (adjust-deriv/top deriv)
(if (or (not deriv) (if (or (not (base? deriv))
(syntax-original? (wderiv-e1 deriv)) (syntax-original? (wderiv-e1 deriv))
(p:module? deriv)) (p:module? deriv))
deriv deriv