Permalink
Browse files

reducing amount of search by saving length of paren

  • Loading branch information...
dyoo committed Nov 28, 2012
1 parent 39bf271 commit d4d2bed24f65f602950d9dd28ce701315ca04164
@@ -6,7 +6,9 @@
(require string-constants
racket/class
mred/mred-sig
+ racket/string
syntax-color/module-lexer
+ profile
(prefix-in time-acc: syntax-color/private/time-acc)
"collapsed-snipclass-helpers.rkt"
"sig.rkt"
@@ -718,7 +720,9 @@
(define/public (tabify-selection [start-pos (get-start-position)]
[end-pos (get-end-position)])
- (unless (is-stopped?)
+ (unless (is-stopped?)
+ (profile
+ (begin
(define start-time time-acc:total-time)
(define first-para (position-paragraph start-pos))
(define end-para (position-paragraph end-pos))
@@ -750,7 +754,7 @@
(when (< first-para end-para)
(end-busy-cursor))
(define stop-time time-acc:total-time)
- (printf "tabify time: ~s\n" (- stop-time start-time)))))))
+ (printf "tabify time: ~s\n" (- stop-time start-time)))))))))
(define (tabify-all)
(tabify-selection 0 (last-position)))
@@ -904,16 +908,39 @@
(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))])
@@ -227,6 +227,7 @@
(define (lexer-body start-state trans-table actions no-lookahead special-action
has-special-comment-action? special-comment-action eof-action)
+
(letrec ((lexer
(lambda (ip)
(let ((first-pos (get-position ip))
@@ -151,6 +151,8 @@
((and (not (send tree is-empty?))
(is-open? (paren-type (send tree get-root-data)))
(= (send tree get-root-start-position) pos))
+ (define pos-paren-len
+ (paren-length (send tree get-root-data)))
(let ((end
(let/ec ret
(do-match-forward (node-right (send tree get-root))
@@ -164,8 +166,7 @@
(else
(send tree search-max!)
(let ((end (send tree get-root-end-position)))
- (send tree search! pos)
- (values pos (+ pos (paren-length (send tree get-root-data))) end))))))
+ (values pos (+ pos pos-paren-len) end))))))
(else
(values #f #f #f))))
@@ -90,18 +90,10 @@
(rb:nil-node? focus))
(define/public (get-root-length)
- (cond
- [(rb:nil-node? focus)
- 0]
- [else
- (rb:node-self-width focus)]))
+ (rb:node-self-width focus))
(define/public (get-root-data)
- (cond
- [(rb:nil-node? focus)
- #f]
- [else
- (rb:node-data focus)]))
+ (rb:node-data focus))
(define/public (get-root-start-position)
(cond
@@ -72,7 +72,7 @@
[node-parent (node? . -> . node?)]
[node-left (node? . -> . node?)]
[node-right (node? . -> . node?)]
- [node-color (node? . -> . (or/c 'red 'black))]
+ #;[node-color (node? . -> . (or/c 'red 'black))]
[rename public:red? red? (node? . -> . boolean?)]
[rename public:black? black? (node? . -> . boolean?)]
@@ -1271,7 +1271,7 @@
node-parent
node-left
node-right
- node-color
+ #;node-color
[rename-out [public:red? red?]
[public:black? black?]]
new-tree

0 comments on commit d4d2bed

Please sign in to comment.