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

add a little more info in the syntax check printouts for drdr

Browse Source
This commit is contained in:
Robby Findler 2014-08-02 09:09:58 -05:00
parent 1bf4bf1872
commit 484f512965
2 changed files with 22 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
pkgs/drracket-pkgs/drracket-test/tests/drracket/syncheck-test.rkt
View File

@ -1470,7 +1470,10 @@
(when extra-info?
(printf "got-arrows\n")
(pretty-print got-arrows)
(newline))
(newline)
(printf "'drracket:syncheck:show-arrows? ~s\n"
(preferences:get 'drracket:syncheck:show-arrows?)))
(compare-output (cond
[(dir-test? test)
(map (lambda (x)

19
pkgs/drracket-pkgs/drracket/drracket/private/syncheck/traversals.rkt
View File

@ -101,7 +101,24 @@
(list 'require-for-templates require-for-templates)
(list 'require-for-labels require-for-templates)
(list 'sub-identifier-binding-directives
sub-identifier-binding-directives)))))]
sub-identifier-binding-directives)))
(define vars (set))
(let loop ([thing (list phase-to-varrefs phase-to-binders)])
(cond
[(pair? thing) (loop (car thing)) (loop (cdr thing))]
[(hash? thing) (for ([(k v) (in-hash thing)])
(loop k)
(loop v))]
[(free-identifier-mapping? thing)
(free-identifier-mapping-for-each
thing
(λ (k v) (loop v)))]
[(syntax? thing) (set! vars (set-add vars thing))]))
(printf "--- vars\n")
(for ([x (in-set vars)])
(for ([y (in-set vars)])
(printf " ~s\n ~s\n ~s\n" x y (free-identifier=? x y))))
(printf "--- vars\n\n")))]
[else
(annotate-basic sexp
user-namespace user-directory