suzanne.soy/macro-debugger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

macro-debugger: fix deriv parser for begin-for-syntax

Browse Source 
original commit: 57bdb62547483242ad30f44a1aa80c15cfca6cee
This commit is contained in:
Ryan Culpepper 2012-03-14 22:03:33 -06:00
parent d62630672e
commit 890768b3c8
6 changed files with 22 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/macro-debugger/analysis/private/get-references.rkt
View File

@ -130,8 +130,8 @@
(recur/phase-up rhs)] (recur/phase-up rhs)]
[(p:define-values z1 z2 rs ?1 rhs) [(p:define-values z1 z2 rs ?1 rhs)
(recur rhs)] (recur rhs)]
[(p:begin-for-syntax z1 z2 rs ?1 prep body) [(p:begin-for-syntax z1 z2 rs ?1 prep body locals)
(recur prep) (recur prep locals)
(recur/phase-up body)] (recur/phase-up body)]
[(p:#%expression z1 z2 rs ?1 inner untag) [(p:#%expression z1 z2 rs ?1 inner untag)
(recur inner)] (recur inner)]

2
collects/macro-debugger/model/deriv-c.rkt
View File

@ -108,7 +108,7 @@
;; where BFSBody is one of ;; where BFSBody is one of
;; - ModuleBegin/Phase ;; - ModuleBegin/Phase
;; - (list BeginForSyntaxLifts ... LDeriv)) ;; - (list BeginForSyntaxLifts ... LDeriv))
(define-struct (p:begin-for-syntax prule) (prep body) #:transparent) (define-struct (p:begin-for-syntax prule) (prep body locals) #:transparent)
;; (make-p:stop <Base>) ;; (make-p:stop <Base>)
;; (make-p:unknown <Base>) ;; (make-p:unknown <Base>)

8
collects/macro-debugger/model/deriv-parser.rkt
View File

@ -321,8 +321,8 @@
phase-up (? EE/LetLifts) (? Eval) exit-prim) phase-up (? EE/LetLifts) (? Eval) exit-prim)
(make p:define-syntaxes $1 $8 null $3 $4 $6 $7)] (make p:define-syntaxes $1 $8 null $3 $4 $6 $7)]
[(enter-prim prim-begin-for-syntax ! (? PrepareEnv) [(enter-prim prim-begin-for-syntax ! (? PrepareEnv)
phase-up (? ModuleBegin/Phase) exit-prim) phase-up (? ModuleBegin/Phase) (? Eval) exit-prim)
(make p:begin-for-syntax $1 $7 null $3 $4 $6)] (make p:begin-for-syntax $1 $7 null $3 $4 $6 $7)]
[(enter-prim prim-require (? Eval) exit-prim) [(enter-prim prim-require (? Eval) exit-prim)
(make p:require $1 $4 null #f $3)] (make p:require $1 $4 null #f $3)]
[() [()
@ -504,8 +504,8 @@
(PrimBeginForSyntax (PrimBeginForSyntax
(#:args e1 e2 rs) (#:args e1 e2 rs)
[(prim-begin-for-syntax ! (? PrepareEnv) (? BeginForSyntax*)) [(prim-begin-for-syntax ! (? PrepareEnv) (? BeginForSyntax*) (? Eval))
(make p:begin-for-syntax e1 e2 rs $2 $3 $4)]) (make p:begin-for-syntax e1 e2 rs $2 $3 $4 $5)])
(BeginForSyntax* (BeginForSyntax*
[((? EL)) [((? EL))
(list $1)] (list $1)]

2
collects/macro-debugger/model/deriv-util.rkt
View File

@ -36,7 +36,7 @@
(define (ok-node? x) (define (ok-node? x)
(check 'ok-node? node? "node" x) (check 'ok-node? node? "node" x)
(and (node-z1 x) #t)) (and (node-z2 x) #t))
(define (interrupted-node? x) (define (interrupted-node? x)
(check 'interrupted-node? node? "node" x) (check 'interrupted-node? node? "node" x)
(not (node-z2 x))) (not (node-z2 x)))

5
collects/macro-debugger/model/reductions.rkt
View File

@ -270,7 +270,7 @@
[! ?2] [! ?2]
[Expr ?rhs rhs])] [Expr ?rhs rhs])]
[(Wrap p:begin-for-syntax (e1 e2 rs ?1 prep body)) [(Wrap p:begin-for-syntax (e1 e2 rs ?1 prep body locals))
(R [! ?1] (R [! ?1]
[#:pattern ?form] [#:pattern ?form]
[PrepareEnv ?form prep] [PrepareEnv ?form prep]
@ -278,7 +278,8 @@
[#:parameterize ((phase (add1 (phase)))) [#:parameterize ((phase (add1 (phase))))
[#:if (module-begin/phase? body) [#:if (module-begin/phase? body)
[[ModuleBegin/Phase ?forms body]] [[ModuleBegin/Phase ?forms body]]
[[BeginForSyntax ?forms body]]]])] [[BeginForSyntax ?forms body]]]]
[LocalActions ?forms locals])]
;; Macros ;; Macros
[(Wrap mrule (e1 e2 rs ?1 me1 locals me2 ?2 etx next)) [(Wrap mrule (e1 e2 rs ?1 me1 locals me2 ?2 etx next))

10
collects/tests/macro-debugger/tests/regression.rkt
View File

@ -205,4 +205,14 @@
(equal? (syntax->datum (state-e (step-s2 step))) (equal? (syntax->datum (state-e (step-s2 step)))
'(define y 12))) '(define y 12)))
"looking for m => define"))) "looking for m => define")))
;; Added 3/12/2012 based on bug from cce
(test-case "begin-for-syntax ends with phase1 eval"
(let ([d (trace '(module m '#%kernel
(#%module-begin
(#%require (for-syntax '#%kernel))
(begin-for-syntax
(syntax-local-value (quote-syntax lambda) void)))))])
(check-pred deriv? d)
(check-pred ok-node? d)))
)) ))