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

Fix source syntax recovery.

Browse Source 
original commit: 632ce4e30a06c5a2bf81310f70a646beb993b015
This commit is contained in:
Vincent St-Amour 2013-11-19 18:35:16 -05:00
parent dfc7a0b8d9
commit 386364df34
1 changed files with 23 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
pkgs/typed-racket-pkgs/source-syntax/source-syntax.rkt
View File

@ -37,25 +37,33 @@
;; add-to-table: stx or #f -> stx or #f
;; #f as `lookfor` indicates "traverse all of `expanded`
(define (add-to-table lookfor)
;; stx is expanded syntax, target is source syntax
(let loop ([stx expanded] [target initial-target])
(cond
[(syntax? stx)
(define new-target
;; check if `stx` has the same srcloc as something in orig
;; in which case it's a good target to use
;; otherwise keep using the old target
(hash-ref syntax-locs (syntax-loc stx) target))
;; map `stx` to the best enclosing syntax we have, if it's not already there
(hash-ref! parent-table stx new-target)
(cond
;; if we got what we came for, stop
[(and lookfor (eq? stx lookfor)) new-target]
(define new-target
;; check if `stx` has the same srcloc as something in orig
;; in which case it's a good target to use
;; otherwise keep using the old target
(hash-ref syntax-locs (syntax-loc stx) target))
;; map `stx` to the best enclosing syntax we have, if it's not already there
(hash-ref! parent-table stx new-target)
(cond
;; if we got what we came for, stop
[(and lookfor (eq? stx lookfor)) new-target]
;; take apart stx and loop on the components
[else
(define stxe (syntax-e stx))
(and (pair? stxe)
(or (loop (car stxe) stx) (loop (cdr stxe) stx)))])]
;; take apart stx and loop on the components
[else
(let inner ([stxe (syntax-e stx)])
(cond [(list? stxe)
(for/or ([x (in-list stxe)])
(loop x new-target))]
[(pair? stxe) ; may be an improper syntax list
(or (loop (car stxe) new-target) (inner (cdr stxe)))]
[(syntax? stxe) ; base case
(loop stxe new-target)]
[else
#f]))])]
[else #f])))
;; if now?, add everything to the table