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

PR 9300, cotd

Browse Source 
svn: r9344
This commit is contained in:
Robby Findler 2008-04-17 11:55:57 +00:00
parent c9e313648a
commit 0fe065e1b7
1 changed files with 21 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
collects/drscheme/syncheck.ss
View File

@ -2297,7 +2297,11 @@ If the namespace does not, they are colored the unbound color.
;; hash-table[syntax -o> (listof syntax)] -> void ;; hash-table[syntax -o> (listof syntax)] -> void
;; take something like a transitive closure, except ;; take something like a transitive closure, except
;; only when there are non-original links in between ;; only when there are non-original links in between
;; (this still has the cubic complexity in the worst case,
;; but running it on syncheck.ss it takes no time)
(define (collapse-tail-links tail-ht) (define (collapse-tail-links tail-ht)
(let loop ()
(let ([found-one? #f])
(hash-for-each (hash-for-each
tail-ht tail-ht
(λ (stx-from stx-tos) (λ (stx-from stx-tos)
@ -2308,9 +2312,13 @@ If the namespace does not, they are colored the unbound color.
(λ (stx-to-to) (λ (stx-to-to)
(unless (and (add-tail-link? stx-from stx-to) (unless (and (add-tail-link? stx-from stx-to)
(add-tail-link? stx-to stx-to-to)) (add-tail-link? stx-to stx-to-to))
(hash-cons! tail-ht stx-from stx-to-to))) (unless (memq stx-to-to (hash-ref tail-ht stx-from '()))
(set! found-one? #t)
(hash-cons! tail-ht stx-from stx-to-to))))
stx-to-tos))) stx-to-tos)))
stx-tos)))) stx-tos)))
(when found-one?
(loop)))))