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

Optimize stick-to-next-sexp? to speculative match before using forward-match.

Browse Source 
Profiler output suggests that forward-match is a bit expensive.  Here
is profiler output from the original code, when profiler is wrapped
around tabify-selection:

------------------------------------------------------------------------------------------------------------
                                  loop [34]                                                             0.1%
                                  get-backward-sexp method in ...k/private/racket.rkt:425:2 [28]       99.9%
 [37] 50648(61.1%)     0(0.0%)  stick-to-next-sexp? method in ...k/private/racket.rkt:425:2 ...
                                  do-forward-match method in ...rk/private/color.rkt:71:2 [50]         99.9%

...

------------------------------------------------------------------------------------------------------------
                                  get-forward-sexp method in ...k/private/racket.rkt:425:2 [38]        17.1%
                                  stick-to-next-sexp? method in ...k/private/racket.rkt:425:2 [37]     82.9%
 [50] 61043(73.6%)    53(0.1%)  do-forward-match method in ...rk/private/color.rkt:71:2 ...
                                  colorer-driver method in ...rk/private/color.rkt:71:2 [66]           99.8%
                                  match-forward method in paren-tree% [72]                              0.1%
------------------------------------------------------------------------------------------------------------

The patch does the prerequisite string matching before calling forward-match.

Reference to dev list: http://lists.racket-lang.org/dev/archive/2012-November/010976.html
This commit is contained in:
Danny Yoo 2012-11-26 13:38:13 -07:00
parent df5ee4c7ba
commit 43b0e2157c
1 changed files with 33 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
collects/framework/private/racket.rkt
View File

@ -5,6 +5,7 @@
(require string-constants
racket/class
racket/string
mred/mred-sig
syntax-color/module-lexer
"collapsed-snipclass-helpers.rkt"
@ -900,17 +901,39 @@
(let ([snip-pos (get-snip-position snip)])
(delete snip-pos (+ snip-pos 1)))
(set-position pos pos)))
;; stick-to-next-sexp?: natural -> boolean
(define stick-to-patterns
'("'" "," ",@" "`" "#'" "#," "#`" "#,@"
"#&" "#;" "#hash" "#hasheq" "#ci" "#cs"))
(define stick-to-patterns-union
(regexp (string-append
"^("
(string-join (map regexp-quote stick-to-patterns) "|")
")")))
(define stick-to-patterns-union-anchored
(regexp (string-append
"^("
(string-join (map regexp-quote stick-to-patterns) "|")
")$")))
(define stick-to-max-pattern-length
(apply max (map string-length stick-to-patterns)))
(define/public (stick-to-next-sexp? start-pos)
(let ([end-pos (forward-match start-pos (last-position))])
(and end-pos
(member (get-text start-pos end-pos)
'("'" "," ",@" "`"
"#'" "#," "#`" "#,@"
"#&" "#;"
"#hash" "#hasheq"
"#ci" "#cs")))))
;; Optimization: speculatively check whether the string will
;; match the patterns; at time of writing, forward-match can be
;; really expensive.
(define snippet
(get-text start-pos
(min (last-position)
(+ start-pos stick-to-max-pattern-length))))
(and (regexp-match stick-to-patterns-union snippet)
(let ([end-pos (forward-match start-pos (last-position))])
(and end-pos
(regexp-match stick-to-patterns-union-anchored
(get-text start-pos end-pos))
#t))))
(define/public (get-forward-sexp start-pos)
;; loop to work properly with quote, etc.
(let loop ([one-forward (forward-match start-pos (last-position))])