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

34
collects/drscheme/syncheck.ss
View File

@ -2297,20 +2297,28 @@ 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)
(hash-for-each (let loop ()
tail-ht (let ([found-one? #f])
(λ (stx-from stx-tos) (hash-for-each
(for-each tail-ht
(λ (stx-to) (λ (stx-from stx-tos)
(let ([stx-to-tos (hash-ref tail-ht stx-to '())]) (for-each
(for-each (λ (stx-to)
(λ (stx-to-to) (let ([stx-to-tos (hash-ref tail-ht stx-to '())])
(unless (and (add-tail-link? stx-from stx-to) (for-each
(add-tail-link? stx-to stx-to-to)) (λ (stx-to-to)
(hash-cons! tail-ht stx-from stx-to-to))) (unless (and (add-tail-link? stx-from stx-to)
stx-to-tos))) (add-tail-link? stx-to stx-to-to))
stx-tos)))) (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-tos)))
(when found-one?
(loop)))))