syntax/loc: only use loc arg if it has source or position
This commit is contained in:
parent
7f12dc567c
commit
a48259ba29
|
@ -486,16 +486,28 @@ Illegal as an expression form. The @racket[unsyntax-splicing] form is
|
||||||
for use only with a @racket[quasisyntax] template.}
|
for use only with a @racket[quasisyntax] template.}
|
||||||
|
|
||||||
|
|
||||||
@defform[(syntax/loc stx-expr template)]{
|
@defform[(syntax/loc stx-expr template)
|
||||||
|
#:contracts ([stx-expr syntax?])]{
|
||||||
|
|
||||||
Like @racket[syntax], except that the immediate resulting syntax
|
Like @racket[syntax], except that the immediate resulting syntax
|
||||||
object takes its source-location information from the result of
|
object takes its source-location information from the result of
|
||||||
@racket[stx-expr] (which must produce a syntax object), unless the
|
@racket[stx-expr] (which must produce a syntax object).
|
||||||
@racket[template] is just a pattern variable, or both the source and
|
|
||||||
position of @racket[stx-expr] are @racket[#f].}
|
|
||||||
|
|
||||||
|
Only the source location of the immediate result---the ``outermost''
|
||||||
|
syntax object---is adjusted. The source location is @emph{not}
|
||||||
|
adjusted if both the source and position of @racket[stx-expr] are
|
||||||
|
@racket[#f]. The source location is adjusted only if the resulting
|
||||||
|
syntax object comes from the template itself rather than the value of
|
||||||
|
a syntax pattern variable. For example, if @racket[_x] is a syntax
|
||||||
|
pattern variable, then @racket[(syntax/loc stx-expr _x)] does not use
|
||||||
|
the location of @racket[stx-expr].
|
||||||
|
|
||||||
@defform[(quasisyntax/loc stx-expr template)]{
|
@history[#:changed "6.90.0.25" @elem{Previously, @racket[syntax/loc]
|
||||||
|
did not enforce the contract on @racket[stx-expr] if @racket[template]
|
||||||
|
was just a pattern variable.}]}
|
||||||
|
|
||||||
|
@defform[(quasisyntax/loc stx-expr template)
|
||||||
|
#:contracts ([stx-expr syntax?])]{
|
||||||
|
|
||||||
Like @racket[quasisyntax], but with source-location assignment like
|
Like @racket[quasisyntax], but with source-location assignment like
|
||||||
@racket[syntax/loc].}
|
@racket[syntax/loc].}
|
||||||
|
|
|
@ -2646,6 +2646,26 @@
|
||||||
(with-syntax ([(x ...) #'(4 5 6)])
|
(with-syntax ([(x ...) #'(4 5 6)])
|
||||||
(syntax->datum #'((~? x) ...))))
|
(syntax->datum #'((~? x) ...))))
|
||||||
|
|
||||||
|
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; Tests for syntax/loc
|
||||||
|
|
||||||
|
(let ()
|
||||||
|
(define (f stx) (list (syntax-source stx) (syntax-position stx)))
|
||||||
|
(define (same-src? x y) (equal? (syntax-source x) (syntax-source y)))
|
||||||
|
(define good1 (datum->syntax #f 'good '(source #f #f 1 4)))
|
||||||
|
(define good3 (datum->syntax #f 'good '(source #f #f #f #f)))
|
||||||
|
(define good4 (datum->syntax #f 'good '(#f #f #f 1 4)))
|
||||||
|
(define bad1 (datum->syntax #f 'bad #f))
|
||||||
|
(test '(source 1) 'syntax/loc (f (syntax/loc good1 (x))))
|
||||||
|
(test '(source #f) 'syntax/loc (f (syntax/loc good3 (x))))
|
||||||
|
(test '(#f 1) 'syntax/loc (f (syntax/loc good4 (x))))
|
||||||
|
(test #t 'syntax/loc (same-src? (syntax/loc bad1 (x)) (syntax (x))))
|
||||||
|
;; syntax/loc only applies loc to *new* syntax
|
||||||
|
(with-syntax ([x #'here])
|
||||||
|
(test #t 'syntax/loc (same-src? (syntax/loc good1 x) (syntax x))))
|
||||||
|
(with-syntax ([(x ...) #'()] [y #'(here)])
|
||||||
|
(test #t 'syntax/loc (same-src? (syntax/loc good1 (x ... . y)) (syntax y)))))
|
||||||
|
|
||||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(report-errs)
|
(report-errs)
|
||||||
|
|
|
@ -596,9 +596,15 @@
|
||||||
(do-template stx (cadr s) #f #f)
|
(do-template stx (cadr s) #f #f)
|
||||||
(raise-syntax-error #f "bad syntax" stx)))
|
(raise-syntax-error #f "bad syntax" stx)))
|
||||||
|
|
||||||
|
;; check-loc : Symbol Any -> (U Syntax #f)
|
||||||
|
;; Raise exn if not syntax. Returns same syntax if suitable for srcloc
|
||||||
|
;; (ie, if at least syntax-source or syntax-position set), #f otherwise.
|
||||||
(define (check-loc who x)
|
(define (check-loc who x)
|
||||||
(if (syntax? x) x (raise-argument-error who "syntax?" x)))
|
(if (syntax? x)
|
||||||
|
(if (or (syntax-source x) (syntax-position x))
|
||||||
|
x
|
||||||
|
#f)
|
||||||
|
(raise-argument-error who "syntax?" x)))
|
||||||
|
|
||||||
;; ============================================================
|
;; ============================================================
|
||||||
;; Run-time support
|
;; Run-time support
|
||||||
|
@ -653,7 +659,7 @@
|
||||||
|
|
||||||
(define (t-append xs ys) (if (null? ys) xs (append xs ys)))
|
(define (t-append xs ys) (if (null? ys) xs (append xs ys)))
|
||||||
(define (t-resyntax loc stx g) (datum->syntax stx g (or loc stx) stx))
|
(define (t-resyntax loc stx g) (datum->syntax stx g (or loc stx) stx))
|
||||||
(define (t-relocate g loc) (datum->syntax g (syntax-e g) loc g))
|
(define (t-relocate g loc) (datum->syntax g (syntax-e g) (or loc g) g))
|
||||||
(define (t-orelse* g1 g2)
|
(define (t-orelse* g1 g2)
|
||||||
((let/ec escape
|
((let/ec escape
|
||||||
(with-continuation-mark
|
(with-continuation-mark
|
||||||
|
|
Loading…
Reference in New Issue
Block a user