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

work around name problem in promise, avoid keeping the original exn in syntax errors in eli-tester

Browse Source 
svn: r16796
This commit is contained in:
Eli Barzilay 2009-11-16 04:34:13 +00:00
parent 860a36d499
commit 77d9f02c90
2 changed files with 9 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
collects/scheme/promise.ss
View File

@ -3,7 +3,7 @@
"private/more-scheme.ss" "private/more-scheme.ss"
"private/define.ss" "private/define.ss"
(rename "private/define-struct.ss" define-struct define-struct*) (rename "private/define-struct.ss" define-struct define-struct*)
(for-syntax '#%kernel "private/stxcase-scheme.ss") (for-syntax '#%kernel "private/stxcase-scheme.ss" "private/name.ss")
'#%unsafe) '#%unsafe)
(#%provide force promise? promise-forced? promise-running?) (#%provide force promise? promise-forced? promise-running?)
@ -189,14 +189,19 @@
(let-values ([(x) (assq (car k) kwds)]) (let-values ([(x) (assq (car k) kwds)])
(if x (cdr x) (cdr k)))) (if x (cdr x) (cdr k))))
keywords) keywords)
#f)]) #f)]
;; some strange bug with `syntax-local-expand-expression' makes this not
;; work well with identifiers, so turn the name into a symbol to work
;; around this for now
[(name0) (syntax-local-infer-name stx)]
[(name) (if (syntax? name0) (syntax-e name0) name0)])
(syntax-case stx () (syntax-case stx ()
[_ (pair? exprs) ; throw a syntax error if anything is wrong [_ (pair? exprs) ; throw a syntax error if anything is wrong
(with-syntax ([(expr ...) exprs] (with-syntax ([(expr ...) exprs]
[(kwd-arg ...) kwd-args]) [(kwd-arg ...) kwd-args])
(with-syntax ([proc (syntax-property (with-syntax ([proc (syntax-property
(syntax/loc stx (lambda () expr ...)) (syntax/loc stx (lambda () expr ...))
'inferred-name (syntax-local-name))] 'inferred-name name)]
[make maker]) [make maker])
(syntax/loc stx (make proc kwd-arg ...))))]))) (syntax/loc stx (make proc kwd-arg ...))))])))

2
collects/tests/eli-tester.ss
View File

@ -7,7 +7,7 @@
(syntax-case stx () (syntax-case stx ()
[(_ expr) [(_ expr)
;; catch syntax errors while expanding, turn them into runtime errors ;; catch syntax errors while expanding, turn them into runtime errors
(with-handlers ([exn? (lambda (e) #`(list 'error #,(exn-message e) #,e))]) (with-handlers ([exn? (lambda (e) #`(list 'error #,(exn-message e) #f))])
(define-values (_ opaque) (define-values (_ opaque)
(syntax-local-expand-expression (syntax-local-expand-expression
#'(with-handlers #'(with-handlers