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

performance improvement when the stacks are huge

Browse Source 
svn: r11000
This commit is contained in:
Robby Findler 2008-07-31 03:14:37 +00:00
parent 3c984246ca
commit fceb977f7b
1 changed files with 36 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
collects/drscheme/private/rep.ss
View File

@ -643,18 +643,29 @@ TODO
(define/public (highlight-errors raw-locs raw-error-arrows)
(let* ([cleanup-locs
(λ (locs)
(let ([ht (make-hasheq)])
(filter (λ (loc) (and (is-a? (srcloc-source loc) text:basic<%>)
(number? (srcloc-position loc))
(number? (srcloc-span loc))))
(map (λ (srcloc)
(cond
[(hash-ref ht (srcloc-source srcloc) #f)
=>
(λ (e)
(make-srcloc e
(srcloc-line srcloc)
(srcloc-column srcloc)
(srcloc-position srcloc)
(srcloc-span srcloc)))]
[(send definitions-text port-name-matches? (srcloc-source srcloc))
(hash-set! ht (srcloc-source srcloc) definitions-text)
(make-srcloc definitions-text
(srcloc-line srcloc)
(srcloc-column srcloc)
(srcloc-position srcloc)
(srcloc-span srcloc))]
[(port-name-matches? (srcloc-source srcloc))
(hash-set! ht (srcloc-source srcloc) definitions-text)
(make-srcloc this
(srcloc-line srcloc)
(srcloc-column srcloc)
@ -670,7 +681,7 @@ TODO
(srcloc-position srcloc)
(srcloc-span srcloc)))]
[else srcloc]))
locs)))]
locs))))]
[locs (cleanup-locs raw-locs)]
[error-arrows (and raw-error-arrows (cleanup-locs raw-error-arrows))])