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

refactored check syntax in preparation to fix the problem with binding identifiers being duplicated by macros

Browse Source
This commit is contained in:
Robby Findler 2010-11-30 15:47:03 -06:00
parent b212fc9485
commit 6c25210a6b
1 changed files with 31 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
collects/drracket/private/syncheck/traversals.rkt
View File

@ -626,7 +626,19 @@
(color-unused require-for-templates unused-require-for-templates) (color-unused require-for-templates unused-require-for-templates)
(color-unused require-for-syntaxes unused-require-for-syntaxes) (color-unused require-for-syntaxes unused-require-for-syntaxes)
(color-unused requires unused-requires) (color-unused requires unused-requires)
(hash-for-each rename-ht (lambda (k stxs) (make-rename-menu stxs id-sets)))))
(define src-loc-id-table (make-hash))
(for ([id-set (in-list id-sets)])
(for-each-ids
id-set
(λ (ids)
(for ([id (in-list ids)])
(define key (list (syntax-source id)
(syntax-position id)
(syntax-span id)))
(hash-set! src-loc-id-table key (hash-ref src-loc-id-table key '()))))))
(hash-for-each rename-ht (lambda (k stxs) (make-rename-menu stxs id-sets src-loc-id-table)))))
;; record-renamable-var : rename-ht syntax -> void ;; record-renamable-var : rename-ht syntax -> void
@ -1309,8 +1321,11 @@
; ;;; ; ;;;
;; make-rename-menu : (cons stx[original,id] (listof stx[original,id])) (listof id-set) -> void ;; make-rename-menu : (cons stx[original,id] (listof stx[original,id]))
(define (make-rename-menu stxs id-sets) ;; (listof id-set)
;; hash[(list source number number) -o> (listof syntax)]
;; -> void
(define (make-rename-menu stxs id-sets src-loc-id-table)
(let ([defs-text (currently-processing-definitions-text)]) (let ([defs-text (currently-processing-definitions-text)])
(when defs-text (when defs-text
(let* ([source (syntax-source (car stxs))] ;; all stxs in the list must have the same source (let* ([source (syntax-source (car stxs))] ;; all stxs in the list must have the same source
@ -1335,6 +1350,7 @@
defs-text defs-text
stxs stxs
id-sets id-sets
src-loc-id-table
frame-parent)))))))))))))) frame-parent))))))))))))))
;; find-parent : menu-item-container<%> -> (union #f (is-a?/c top-level-window<%>) ;; find-parent : menu-item-container<%> -> (union #f (is-a?/c top-level-window<%>)
@ -1359,10 +1375,11 @@
;; (and/c syncheck-text<%> definitions-text<%>) ;; (and/c syncheck-text<%> definitions-text<%>)
;; (listof syntax[original]) ;; (listof syntax[original])
;; (listof id-set) ;; (listof id-set)
;; hash[(list source number number) -o> (listof syntax)]
;; (union #f (is-a?/c top-level-window<%>)) ;; (union #f (is-a?/c top-level-window<%>))
;; -> void ;; -> void
;; callback for the rename popup menu item ;; callback for the rename popup menu item
(define (rename-callback name-to-offer defs-text stxs id-sets parent) (define (rename-callback name-to-offer defs-text stxs id-sets src-loc-id-table parent)
(let ([new-str (let ([new-str
(fw:keymap:call/text-keymap-initializer (fw:keymap:call/text-keymap-initializer
(λ () (λ ()
@ -1373,18 +1390,18 @@
name-to-offer)))]) name-to-offer)))])
(when new-str (when new-str
(let* ([new-sym (format "~s" (string->symbol new-str))] (let* ([new-sym (format "~s" (string->symbol new-str))]
[raw-to-be-renamed
(let ([raw '()])
(for ([id-set (in-list id-sets)])
(for ([stx (in-list stxs)])
(for ([id (in-list (or (get-ids id-set stx) '()))])
(set! raw (cons id raw)))))
raw)]
[to-be-renamed [to-be-renamed
(remove-duplicates-stx (remove-duplicates-stx
(sort (sort raw-to-be-renamed
(apply >=
append #:key syntax-position))]
(map (λ (id-set)
(apply
append
(map (λ (stx) (or (get-ids id-set stx) '())) stxs)))
id-sets))
(λ (x y)
((syntax-position x) . >= . (syntax-position y)))))]
[do-renaming? [do-renaming?
(or (not (name-duplication? to-be-renamed id-sets new-sym)) (or (not (name-duplication? to-be-renamed id-sets new-sym))
(equal? (equal?