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

trace the language-position require(s) specially

Browse Source 
so as not to turn them red when there is no use
of something exported by them in the program
  closes PR 12100
This commit is contained in:
Robby Findler 2011-08-10 19:10:18 -05:00
parent 17f1ac53be
commit 71c6483f4f
2 changed files with 43 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -54,6 +54,7 @@
[tl-binding-inits (make-id-set)]
[tl-templrefs (make-id-set)]
[tl-requires (make-hash)]
[tl-module-lang-requires (make-hash)]
[tl-require-for-syntaxes (make-hash)]
[tl-require-for-templates (make-hash)]
[tl-require-for-labels (make-hash)]
@ -75,6 +76,7 @@
[high-tops (make-id-set)]
[binding-inits (make-id-set)]
[templrefs (make-id-set)]
[module-lang-requires (make-hash)]
[requires (make-hash)]
[require-for-syntaxes (make-hash)]
[require-for-templates (make-hash)]
@ -87,6 +89,7 @@
low-tops high-tops
binding-inits
templrefs
module-lang-requires
requires require-for-syntaxes require-for-templates require-for-labels)
(annotate-variables user-namespace
user-directory
@ -99,6 +102,7 @@
low-tops
high-tops
templrefs
module-lang-requires
requires
require-for-syntaxes
require-for-templates
@ -113,6 +117,7 @@
tl-low-tops tl-high-tops
tl-binding-inits
tl-templrefs
tl-module-lang-requires
tl-requires
tl-require-for-syntaxes
tl-require-for-templates
@ -131,6 +136,7 @@
tl-low-tops
tl-high-tops
tl-templrefs
tl-module-lang-requires
tl-requires
tl-require-for-syntaxes
tl-require-for-templates
@ -156,6 +162,7 @@
low-tops high-tops
binding-inits
templrefs
module-lang-requires
requires require-for-syntaxes require-for-templates require-for-labels)
(let ([tail-ht (make-hasheq)]
@ -319,6 +326,7 @@
[(module m-name lang (#%plain-module-begin bodies ...))
(begin
(annotate-raw-keyword sexp varrefs)
(hash-set! module-lang-requires (syntax lang) #t)
((annotate-require-open user-namespace user-directory) (syntax lang))
(hash-cons! requires (syntax->datum (syntax lang)) (syntax lang))
@ -462,6 +470,7 @@
low-tops
high-tops
templrefs
module-lang-requires
requires
require-for-syntaxes
require-for-templates
@ -589,30 +598,31 @@
vars))
(get-idss high-tops))
(color-unused require-for-labels unused-require-for-labels)
(color-unused require-for-templates unused-require-for-templates)
(color-unused require-for-syntaxes unused-require-for-syntaxes)
(color-unused requires unused-requires)
(color-unused require-for-labels unused-require-for-labels module-lang-requires)
(color-unused require-for-templates unused-require-for-templates module-lang-requires)
(color-unused require-for-syntaxes unused-require-for-syntaxes module-lang-requires)
(color-unused requires unused-requires module-lang-requires)
(make-rename-menus id-sets)))
;; color-unused : hash-table[sexp -o> syntax] hash-table[sexp -o> #f] -> void
(define (color-unused requires unused)
;; color-unused : hash-table[sexp -o> syntax] hash-table[sexp -o> #f] hash-table[syntax -o> #t] -> void
(define (color-unused requires unused module-lang-requires)
(hash-for-each
unused
(λ (k v)
(for-each (λ (stx)
(define defs-text (current-annotations))
(define source-editor (find-source-editor stx))
(when (and defs-text source-editor)
(define pos (syntax-position stx))
(define span (syntax-span stx))
(when (and pos span)
(define start (- pos 1))
(define fin (+ start span))
(send defs-text syncheck:add-background-color
source-editor start fin "firebrick")))
(color stx unused-require-style-name 'default-mode))
(unless (hash-ref module-lang-requires stx #f)
(define defs-text (current-annotations))
(define source-editor (find-source-editor stx))
(when (and defs-text source-editor)
(define pos (syntax-position stx))
(define span (syntax-span stx))
(when (and pos span)
(define start (- pos 1))
(define fin (+ start span))
(send defs-text syncheck:add-background-color
source-editor start fin "firebrick")))
(color stx unused-require-style-name 'default-mode)))
(hash-ref requires k)))))
;; connect-identifier : syntax

36
collects/tests/drracket/syncheck-test.rkt
View File

@ -284,11 +284,9 @@ trigger runtime errors in check syntax.
'((57 58) (59 60) (61 62))))
(build-test "(module m mzscheme)"
'(("(" default-color)
("module" imported-syntax)
(" m " default-color)
("mzscheme" unused-require)
(")" default-color)))
'(("(" default-color)
("module" imported-syntax)
(" m mzscheme)" default-color)))
(build-test "(require-for-syntax mzscheme)"
'(("(" default-color)
("require-for-syntax" imported-syntax)
@ -863,21 +861,19 @@ trigger runtime errors in check syntax.
#f)
(build-test "#lang scheme/base\n(require scheme)\n(define-syntax m (lambda (x) #'1))"
'(("#lang " default-color)
("scheme/base" unused-require)
("\n(" default-color)
("require" imported)
(" scheme)\n(" default-color)
("define-syntax" imported)
(" " default-color)
("m" lexically-bound)
(" (" default-color)
("lambda" imported)
(" (" default-color)
("x" lexically-bound)
(") " default-color)
("#'" imported)
("1))" default-color))
'(("#lang scheme/base\n(" default-color)
("require" imported)
(" scheme)\n(" default-color)
("define-syntax" imported)
(" " default-color)
("m" lexically-bound)
(" (" default-color)
("lambda" imported)
(" (" default-color)
("x" lexically-bound)
(") " default-color)
("#'" imported)
("1))" default-color))
(list '((27 33) (19 26) (36 49) (53 59) (64 66))))
(rename-test "(lambda (x) x)"