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