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

syntax-parse: keep more srclocs in attribute bindings

Browse Source 
to cooperate more with DrRacket check-syntax arrows
This commit is contained in:
Alex Knauth 2015-06-09 10:57:45 -04:00 committed by Vincent St-Amour
parent c50eeeecc9
commit 3c5ed5d8e1
2 changed files with 24 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
racket/collects/syntax/parse/private/rep-data.rkt
View File

@ -286,10 +286,20 @@ expressions are duplicated, and may be evaluated in different scopes.
(cond [(and (stxclass-colon-notation?)
(regexp-match #rx"^([^:]*):(.+)$" (symbol->string (syntax-e id0))))
=> (lambda (m)
(define-values [src ln col pos span]
(syntax-srcloc-values id0))
(define id-str (cadr m))
(define id-len (string-length id-str))
(define suffix-str (caddr m))
(define suffix-len (string-length suffix-str))
(define id
(datum->syntax id0 (string->symbol (cadr m)) id0 id0))
(datum->syntax id0 (string->symbol id-str)
(list src ln col pos id-len)
id0))
(define suffix
(datum->syntax id0 (string->symbol (caddr m)) id0 id0))
(datum->syntax id0 (string->symbol suffix-str)
(list src ln (and col (+ col id-len 1)) (and pos (+ pos id-len 1)) suffix-len)
id0))
(declenv-check-unbound decls id (syntax-e suffix)
#:blame-declare? #t)
(let ([suffix-entry (declenv-lookup decls suffix)])
@ -300,6 +310,13 @@ expressions are duplicated, and may be evaluated in different scopes.
(values id sc))])))]
[else (values id0 #f)]))
(define (syntax-srcloc-values stx)
(values (syntax-source stx)
(syntax-line stx)
(syntax-column stx)
(syntax-position stx)
(syntax-span stx)))
;; ----
(provide get-eh-alternative-set)

7
racket/collects/syntax/parse/private/rep.rkt
View File

@ -812,7 +812,7 @@
(define (name->prefix id pfx)
(cond [(wildcard? id) #f]
[(epsilon? id) id]
[else (format-id id "~a~a" (syntax-e id) pfx)]))
[else (format-id id "~a~a" (syntax-e id) pfx #:source id)]))
(define (name->bind id)
(cond [(wildcard? id) #f]
@ -834,7 +834,10 @@
;; prefix-attr-name : id symbol -> id
(define (prefix-attr-name prefix name)
(format-id prefix "~a~a" (syntax-e prefix) name))
(orig (format-id prefix "~a~a" (syntax-e prefix) name #:source prefix)))
(define (orig stx)
(syntax-property stx 'original-for-check-syntax #t))
;; ----