another with-syntax/quasisyntax fix for non-syntax inputs
svn: r15420
This commit is contained in:
parent
5adb4eb004
commit
f9aeba626c
|
@ -165,7 +165,7 @@
|
|||
lit)))
|
||||
lits)
|
||||
(quasisyntax/loc stx
|
||||
(syntax-case (wrap expr (quote-syntax #,(datum->syntax #'expr 'ctx)) unwrapped-srcloc #f) (lit ...)
|
||||
(syntax-case (add-wrap expr) (lit ...)
|
||||
. #,(map (lambda (clause)
|
||||
(syntax-case clause ()
|
||||
[(pat val)
|
||||
|
@ -180,6 +180,11 @@
|
|||
(syntax->list #'(clause ...))))))]
|
||||
[(_ . rest) (syntax/loc stx (syntax-case . rest))]))
|
||||
|
||||
(define-syntax (add-wrap stx)
|
||||
(syntax-case stx ()
|
||||
[(_ expr)
|
||||
#`(wrap expr (quote-syntax #,(datum->syntax #'expr 'ctx)) unwrapped-srcloc #f)]))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
(define (unwrap-reconstructed data stx datum)
|
||||
|
@ -238,7 +243,7 @@
|
|||
(define-syntax r6rs:with-syntax
|
||||
(syntax-rules ()
|
||||
[(_ [(p e0) ...] e1 e2 ...)
|
||||
(r6rs:syntax-case (mlist e0 ...) ()
|
||||
(r6rs:syntax-case (mlist (add-wrap e0) ...) ()
|
||||
[(p ...) (let () e1 e2 ...)])]))
|
||||
|
||||
(define-syntax (r6rs:quasisyntax stx)
|
||||
|
|
Loading…
Reference in New Issue
Block a user