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

fix problems with errortrace and namespace phases

Browse Source 
svn: r11541
This commit is contained in:
Matthew Flatt 2008-09-04 22:03:06 +00:00
parent b44494abe5
commit e67b138830
3 changed files with 6 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/errortrace/errortrace-lib.ss
View File

@ -323,7 +323,7 @@
(syntax-case top-e (#%plain-module-begin) (syntax-case top-e (#%plain-module-begin)
[(mod name init-import (#%plain-module-begin body ...)) [(mod name init-import (#%plain-module-begin body ...))
(normal (normal
#`(module name init-import #`(#,(namespace-module-identifier) name init-import
#,(syntax-recertify #,(syntax-recertify
#`(#%plain-module-begin #`(#%plain-module-begin
#,((make-syntax-introducer) #,((make-syntax-introducer)

2
collects/errortrace/stacktrace.ss
View File

@ -381,7 +381,7 @@
expr expr
(rebuild expr (list (cons #'rhs marked)))))] (rebuild expr (list (cons #'rhs marked)))))]
[(module name init-import (#%plain-module-begin body ...)) [(module name init-import (__plain-module-begin body ...))
;; Just wrap body expressions ;; Just wrap body expressions
(let ([bodys (syntax->list (syntax (body ...)))] (let ([bodys (syntax->list (syntax (body ...)))]
[mb (list-ref (syntax->list expr) 3)]) [mb (list-ref (syntax->list expr) 3)])

12
collects/syntax/kerncase.ss
View File

@ -3,10 +3,6 @@
(require (for-syntax scheme/base) (require (for-syntax scheme/base)
(for-template scheme/base)) (for-template scheme/base))
(define-for-syntax anchor #f)
(define-for-syntax (quick-phase?)
(= 1 (variable-reference->phase (#%variable-reference anchor))))
(define-syntax kernel-syntax-case-internal (define-syntax kernel-syntax-case-internal
(lambda (stx) (lambda (stx)
(syntax-case stx () (syntax-case stx ()
@ -32,19 +28,19 @@
#%variable-reference))))) #%variable-reference)))))
(let ([p phase]) (let ([p phase])
(cond (cond
[(and #,(or (syntax-e #'rel?) (quick-phase?)) (= p 0)) [(and #,(syntax-e #'rel?) (= p 0))
free-identifier=?] free-identifier=?]
[(and #,(or (syntax-e #'rel?) (quick-phase?)) (= p 1)) [(and #,(syntax-e #'rel?) (= p 1))
free-transformer-identifier=?] free-transformer-identifier=?]
[else (let ([id (namespace-module-identifier p)]) [else (let ([id (namespace-module-identifier p)])
(lambda (a b) (lambda (a b)
(free-identifier=? (datum->syntax id (free-identifier=? (datum->syntax id
(let ([s (syntax-e a)]) (let ([s (syntax-e b)])
(case s (case s
[(#%plain-app) '#%app] [(#%plain-app) '#%app]
[(#%plain-lambda) 'lambda] [(#%plain-lambda) 'lambda]
[else s]))) [else s])))
b a
p)))])) p)))]))
clause ...))]))) clause ...))])))