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

fixed PR 8502

Browse Source 
svn: r5473
This commit is contained in:
Robby Findler 2007-01-27 05:06:39 +00:00
parent f31128cf11
commit 84e9f499dd
1 changed files with 39 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
collects/drscheme/syncheck.ss
View File

@ -1561,12 +1561,13 @@ If the namespace does not, they are colored the unbound color.
(define (add-require-spec require-ht) (define (add-require-spec require-ht)
(λ (raw-spec syntax) (λ (raw-spec syntax)
(when (syntax-original? syntax) (when (syntax-original? syntax)
(let ([key (syntax-object->datum raw-spec)])
(hash-table-put! require-ht (hash-table-put! require-ht
(syntax-object->datum raw-spec) key
(cons syntax (cons syntax
(hash-table-get require-ht (hash-table-get require-ht
(syntax-object->datum raw-spec) key
(λ () '()))))))) (λ () '()))))))))
;; annotate-unused-require : syntax -> void ;; annotate-unused-require : syntax -> void
(define (annotate-unused-require req/tag) (define (annotate-unused-require req/tag)
@ -1708,6 +1709,9 @@ If the namespace does not, they are colored the unbound color.
(when req-stxes (when req-stxes
(hash-table-remove! unused req-path) (hash-table-remove! unused req-path)
(for-each (λ (req-stx) (for-each (λ (req-stx)
(when (id/require-match? (syntax-object->datum var)
id
(syntax-object->datum req-stx))
(when id (when id
(add-jump-to-definition (add-jump-to-definition
var var
@ -1716,9 +1720,29 @@ If the namespace does not, they are colored the unbound color.
(add-mouse-over var (format (string-constant cs-mouse-over-import) (add-mouse-over var (format (string-constant cs-mouse-over-import)
(syntax-e var) (syntax-e var)
req-path)) req-path))
(connect-syntaxes req-stx var)) (connect-syntaxes req-stx var)))
req-stxes)))))))) req-stxes))))))))
(define (id/require-match? var id req-stx)
(cond
[(and (pair? req-stx)
(eq? (list-ref req-stx 0) 'prefix))
(let ([prefix (list-ref req-stx 1)])
(equal? (format "~a~a" prefix id)
(symbol->string var)))]
[(and (pair? req-stx)
(eq? (list-ref req-stx 0) 'prefix-all-except))
(let ([prefix (list-ref req-stx 1)])
(and (not (memq id (cdddr req-stx)))
(equal? (format "~a~a" prefix id)
(symbol->string var))))]
[(and (pair? req-stx)
(eq? (list-ref req-stx 0) 'rename))
(eq? (list-ref req-stx 2)
var)]
[else (eq? var id)]))
;; get-module-req-path : binding -> (union #f (cons require-sexp sym)) ;; get-module-req-path : binding -> (union #f (cons require-sexp sym))
;; argument is the result of identifier-binding or identifier-transformer-binding ;; argument is the result of identifier-binding or identifier-transformer-binding
(define (get-module-req-path binding) (define (get-module-req-path binding)