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

Fixing inferred names by using stx-param to track original binding

Browse Source 
svn: r18118
This commit is contained in:
Jay McCarthy 2010-02-17 16:10:37 +00:00
parent 9a468dd9d0
commit c503baac47
1 changed files with 13 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
collects/plai/mutator.ss
View File

@ -40,6 +40,7 @@
(mutator-top-interaction #%top-interaction)
(mutator-module-begin #%module-begin)))
(define-syntax-parameter mutator-name #f)
(define-syntax-parameter mutator-tail-call? #t)
(define-syntax-parameter mutator-env-roots empty)
@ -81,11 +82,18 @@
(define-syntax mutator-define
(syntax-rules ()
[(_ (f a ...) e ...)
(mutator-define-values (f) (mutator-lambda (a ...) e ...))]
(mutator-define-values (f)
(syntax-parameterize ([mutator-name #'f])
(mutator-lambda (a ...) e ...)))]
[(_ id e)
(mutator-define-values (id) e)]))
(mutator-define-values (id)
(syntax-parameterize ([mutator-name #'id])
e))]))
(define-syntax-rule (mutator-let ([id e] ...) be ...)
(mutator-let-values ([(id) e] ...) be ...))
(mutator-let-values ([(id) (syntax-parameterize ([mutator-name #'id])
e)]
...)
be ...))
(define-syntax mutator-let*
(syntax-rules ()
[(_ () be ...)
@ -156,7 +164,8 @@
(let ([env-roots (syntax-parameter-value #'mutator-env-roots)])
(with-syntax ([(free-id ...) (find-referenced-locals env-roots stx)]
[(env-id ...) env-roots]
[closure (or (syntax-local-name)
[closure (or (syntax-parameter-value #'mutator-name)
(syntax-local-name)
(let ([prop (syntax-property stx 'inferred-name)])
(if (or (identifier? prop)
(symbol? prop))