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

improve check syntax so opening the context-sensitive menu is faster

Browse Source 
in certain situations

Specifically, don't compute the identifiers-hash before opening the
menu but, when it does need to be computed, avoid consider the same
arrows over and over. This makes an especially big difference when a
region of text is selected that contains lots of arrow heads that all
point to a place that has lots of arrows.

Specifically, the time to compute the identifers hash for the example in
the PR is now about 200x faster (altho this still takes 200 msec, which
is why it isn't computed at all in that sequence of steps any more).

closes PR 14586
This commit is contained in:
Robby Findler 2014-06-19 19:55:45 -05:00
parent 4aa438937a
commit 0c5239fb51
1 changed files with 48 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

55
pkgs/drracket-pkgs/drracket/drracket/private/syncheck/gui.rkt
View File

@ -690,14 +690,14 @@ If the namespace does not, they are colored the unbound color.
(define/public (syncheck:rename-identifier text)
(define canvas (send text get-canvas))
(define-values (binding-identifiers identifiers-hash)
(define-values (binding-identifiers make-identifiers-hash)
(position->matching-identifiers-hash text
(send text get-start-position)
(send text get-end-position)
#t))
(unless (null? binding-identifiers)
(define name-to-offer (find-name-to-offer binding-identifiers))
(rename-menu-callback identifiers-hash
(rename-menu-callback make-identifiers-hash
name-to-offer
binding-identifiers
(and canvas (send canvas get-top-level-window)))))
@ -718,11 +718,8 @@ If the namespace does not, they are colored the unbound color.
(when arrows
(tack/untack-callback arrows))))
;; rename-callback : (non-empty-listof identifier?)
;; (union #f (is-a?/c top-level-window<%>))
;; -> void
;; callback for the rename popup menu item
(define/private (rename-menu-callback identifiers-hash name-to-offer
(define/private (rename-menu-callback make-identifiers-hash name-to-offer
binding-identifiers parent)
(define (name-dup? x)
(for/or ([var-arrow (in-list binding-identifiers)])
@ -760,7 +757,7 @@ If the namespace does not, they are colored the unbound color.
(when do-renaming?
(define edit-sequence-txts (list this))
(define per-txt-positions (make-hash))
(for ([(k _) (in-hash identifiers-hash)])
(for ([(k _) (in-hash (make-identifiers-hash))])
(define-values (txt start-pos end-pos) (apply values k))
(hash-set! per-txt-positions txt
(cons (cons start-pos end-pos)
@ -1270,7 +1267,7 @@ If the namespace does not, they are colored the unbound color.
(for ([f (in-list add-menus)])
(f menu))
(define-values (binding-identifiers identifiers-hash)
(define-values (binding-identifiers make-identifiers-hash)
(position->matching-identifiers-hash text pos (+ pos 1) #t))
(unless (null? binding-identifiers)
(define name-to-offer (find-name-to-offer binding-identifiers))
@ -1281,7 +1278,7 @@ If the namespace does not, they are colored the unbound color.
[callback
(λ (x y)
(let ([frame-parent (find-menu-parent menu)])
(rename-menu-callback identifiers-hash
(rename-menu-callback make-identifiers-hash
name-to-offer
binding-identifiers
frame-parent)))]))
@ -1329,12 +1326,14 @@ If the namespace does not, they are colored the unbound color.
(un/highlight #f)
(set! current-matching-identifiers
(if (and cursor-text cursor-pos)
(let-values ([(_binders hash) (position->matching-identifiers-hash
cursor-text cursor-pos cursor-pos
#f)])
hash)
(make-hash)))
(cond
[(and cursor-text cursor-pos)
(define-values (_binders make-identifiers-hash)
(position->matching-identifiers-hash cursor-text cursor-pos cursor-pos
#f))
(make-identifiers-hash)]
[else
(make-hash)]))
(un/highlight #t)
@ -1376,16 +1375,25 @@ If the namespace does not, they are colored the unbound color.
(var-arrow-start-pos-right candidate-binder)))
(add-binding-arrow candidate-binder))))])))))
(define identifiers-hash (make-hash))
(define identifiers-hash #f)
(define (add-one txt start end)
(hash-set! identifiers-hash (list txt start end) #t))
(define (get-identifiers-hash)
(unless identifiers-hash
(set! identifiers-hash (make-hash))
(define already-considered (make-hash))
(for ([binding-arrow (in-list binding-arrows)])
(add-one (var-arrow-start-text binding-arrow)
(var-arrow-start-pos-left binding-arrow)
(var-arrow-start-pos-right binding-arrow))
(for ([pos (in-range (var-arrow-start-pos-left binding-arrow)
(var-arrow-start-pos-right binding-arrow))])
(for ([arrow (in-list (fetch-arrow-records (var-arrow-start-text binding-arrow)
(define range-to-consider
(cons (var-arrow-start-pos-left binding-arrow)
(var-arrow-start-pos-right binding-arrow)))
(unless (hash-ref already-considered range-to-consider #f)
(hash-set! already-considered range-to-consider #t)
(for ([pos (in-range (car range-to-consider) (cdr range-to-consider))])
(for ([arrow (in-list (fetch-arrow-records
(var-arrow-start-text binding-arrow)
pos))])
(when (var-arrow? arrow)
(when (or include-require-arrows?
@ -1398,9 +1406,10 @@ If the namespace does not, they are colored the unbound color.
(var-arrow-start-pos-right binding-arrow)))
(add-one (var-arrow-end-text arrow)
(var-arrow-end-pos-left arrow)
(var-arrow-end-pos-right arrow))))))))
(var-arrow-end-pos-right arrow))))))))))
identifiers-hash)
(values binding-arrows identifiers-hash))
(values binding-arrows get-identifiers-hash))
;; Sometimes when this is called, the calls to 'tooltip-info->ltrb'
;; fail and we get no information back. When that happens, we return
@ -1580,10 +1589,10 @@ If the namespace does not, they are colored the unbound color.
;; jump-to-next-callback : num text boolean? -> void
;; callback for the jump popup menu item
(define/private (jump-to-next-callback start-pos end-pos txt backwards?)
(define-values (_binders identifiers-hash)
(define-values (_binders make-identifiers-hash)
(position->matching-identifiers-hash txt start-pos end-pos #t))
(define orig-arrows
(sort (hash-map identifiers-hash
(sort (hash-map (make-identifiers-hash)
(λ (x y) x))
(λ (x y) (if backwards?
(not (syncheck:compare-bindings x y))