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

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

@ -643,34 +643,45 @@ 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)
(filter (λ (loc) (and (is-a? (srcloc-source loc) text:basic<%>) (let ([ht (make-hasheq)])
(number? (srcloc-position loc)) (filter (λ (loc) (and (is-a? (srcloc-source loc) text:basic<%>)
(number? (srcloc-span loc)))) (number? (srcloc-position loc))
(map (λ (srcloc) (number? (srcloc-span loc))))
(cond (map (λ (srcloc)
[(send definitions-text port-name-matches? (srcloc-source srcloc)) (cond
(make-srcloc definitions-text [(hash-ref ht (srcloc-source srcloc) #f)
(srcloc-line srcloc) =>
(srcloc-column srcloc) (λ (e)
(srcloc-position srcloc) (make-srcloc e
(srcloc-span srcloc))] (srcloc-line srcloc)
[(port-name-matches? (srcloc-source srcloc)) (srcloc-column srcloc)
(make-srcloc this (srcloc-position srcloc)
(srcloc-line srcloc) (srcloc-span srcloc)))]
(srcloc-column srcloc) [(send definitions-text port-name-matches? (srcloc-source srcloc))
(srcloc-position srcloc) (hash-set! ht (srcloc-source srcloc) definitions-text)
(srcloc-span srcloc))] (make-srcloc definitions-text
[(and (symbol? (srcloc-source srcloc))
(text:lookup-port-name (srcloc-source srcloc)))
=>
(lambda (editor)
(make-srcloc editor
(srcloc-line srcloc) (srcloc-line srcloc)
(srcloc-column srcloc) (srcloc-column srcloc)
(srcloc-position srcloc) (srcloc-position srcloc)
(srcloc-span srcloc)))] (srcloc-span srcloc))]
[else srcloc])) [(port-name-matches? (srcloc-source srcloc))
locs)))] (hash-set! ht (srcloc-source srcloc) definitions-text)
(make-srcloc this
(srcloc-line srcloc)
(srcloc-column srcloc)
(srcloc-position srcloc)
(srcloc-span srcloc))]
[(and (symbol? (srcloc-source srcloc))
(text:lookup-port-name (srcloc-source srcloc)))
=>
(lambda (editor)
(make-srcloc editor
(srcloc-line srcloc)
(srcloc-column srcloc)
(srcloc-position srcloc)
(srcloc-span srcloc)))]
[else srcloc]))
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))])