text%: avoid O(n^2) behavior on string insert
Break large inserts into smaller chunks by successively halving the chunk, instead of successviely peeling off a small part. Also, avoid traversals and re-traversals of a long line while checking and breaking up lines.
This commit is contained in:
Matthew Flatt
parent
ce4f41bc72
commit
ac5961eae9
|
|
@ -41,6 +41,7 @@
|
|||
set-scroll-length
|
||||
set-height
|
||||
calc-line-length
|
||||
adjust-line-length
|
||||
set-starts-paragraph
|
||||
starts-paragraph
|
||||
adjust-max-width
|
||||
|
|
@ -639,20 +640,7 @@
|
|||
h mline-h set-mline-h!
|
||||
mline-y set-mline-y!))
|
||||
|
||||
(define (calc-line-length mline)
|
||||
(let ([l
|
||||
(let ([nexts (snip->next (mline-last-snip mline))])
|
||||
(let loop ([asnip (mline-snip mline)][l 0])
|
||||
(if (eq? asnip nexts)
|
||||
l
|
||||
(let ([l (+ l (snip->count asnip))])
|
||||
(when (has-flag? (snip->flags asnip) WIDTH-DEPENDS-ON-X)
|
||||
(send asnip size-cache-invalid))
|
||||
(loop (snip->next asnip) l)))))])
|
||||
|
||||
(when (not (= l (mline-len mline)))
|
||||
(set-length mline l)))
|
||||
|
||||
(define (set-paragraph-ends mline)
|
||||
(let ([next (mline-next mline)])
|
||||
(cond
|
||||
[(and next
|
||||
|
|
@ -674,6 +662,27 @@
|
|||
[(positive? (starts-paragraph mline))
|
||||
(set-starts-paragraph mline #f)])))
|
||||
|
||||
(define (calc-line-length mline)
|
||||
(let ([l
|
||||
(let ([nexts (snip->next (mline-last-snip mline))])
|
||||
(let loop ([asnip (mline-snip mline)][l 0])
|
||||
(if (eq? asnip nexts)
|
||||
l
|
||||
(let ([l (+ l (snip->count asnip))])
|
||||
(when (has-flag? (snip->flags asnip) WIDTH-DEPENDS-ON-X)
|
||||
(send asnip size-cache-invalid))
|
||||
(loop (snip->next asnip) l)))))])
|
||||
|
||||
(when (not (= l (mline-len mline)))
|
||||
(set-length mline l)))
|
||||
(set-paragraph-ends mline))
|
||||
|
||||
;; A scalable variant of `calc-line-lengt`, but doesn't
|
||||
;; check WIDTH-DEPENDS-ON-X flags:
|
||||
(define (adjust-line-length mline delta)
|
||||
(set-length mline (+ (mline-len mline) delta))
|
||||
(set-paragraph-ends mline))
|
||||
|
||||
(define (set-starts-paragraph mline starts?)
|
||||
(unless (= (if starts? 1 0) (starts-paragraph mline))
|
||||
(if starts?
|
||||
|
|
|
|||
|
|
@ -1618,133 +1618,183 @@
|
|||
(when (and prev
|
||||
(not (has-flag? (snip->flags (mline-last-snip prev)) HARD-NEWLINE)))
|
||||
(mline-mark-check-flow prev))))
|
||||
|
||||
;; If the snip is too large, divide it up:
|
||||
(define-values (initial-snip initial-s)
|
||||
(cond
|
||||
[((+ s addlen) . > . MAX-COUNT-FOR-SNIP)
|
||||
(let loop ([pos (- start s)] [snip snip] [size (+ addlen s)])
|
||||
(cond
|
||||
[(size . > . MAX-COUNT-FOR-SNIP)
|
||||
(define half (quotient size 2))
|
||||
|
||||
(define intm-snip
|
||||
(split-one half snip #f))
|
||||
|
||||
(define-values (next-snip next-pos)
|
||||
(loop pos intm-snip half))
|
||||
(loop next-pos next-snip (- size half))]
|
||||
[else
|
||||
(define new-snip (split-one* size snip))
|
||||
(values (snip->next new-snip) (+ pos size))]))
|
||||
(find-snip/pos start 'after)]
|
||||
[else (values snip s)]))
|
||||
|
||||
;; The text is inserted, but all into one big snip. If the
|
||||
;; inserted text contains any newlines or tabs, we need to split
|
||||
;; it up to use tab snips or the HARD-NEWLINE flag:
|
||||
(let loop ([snip-start-pos start]
|
||||
[str (string-snip-buffer snip)]
|
||||
[sp (+ s (string-snip-dtext snip))]
|
||||
;; If the inserted text contains any newlines or tabs,
|
||||
;; we need to split it up to use tab snips or the
|
||||
;; HARD-NEWLINE flag:
|
||||
(let loop ([the-snip initial-snip]
|
||||
[the-s s]
|
||||
[snip-start-pos start]
|
||||
[str (string-snip-buffer initial-snip)]
|
||||
[sp (+ s (string-snip-dtext initial-snip))]
|
||||
[i 0]
|
||||
[cnt 0]
|
||||
[inserted-line? inserted-line?])
|
||||
(if (= i addlen)
|
||||
(begin
|
||||
(set! first-line (mline-first (unbox line-root-box)))
|
||||
(set! last-line (mline-last (unbox line-root-box)))
|
||||
(set! len (+ len addlen))
|
||||
(assert (= (last-position) (+ (mline-get-position last-line)
|
||||
(mline-len last-line))))
|
||||
(success-finish addlen inserted-line?))
|
||||
(begin
|
||||
(when (equal? (string-ref str sp) #\return)
|
||||
(string-set! str sp #\newline))
|
||||
(let ([c (string-ref str sp)])
|
||||
(cond
|
||||
[(or (equal? c #\newline) (equal? c #\tab))
|
||||
(let ([newline? (equal? c #\newline)])
|
||||
(make-snipset (+ i start) (+ i start 1))
|
||||
(let ([snip (do-find-snip (+ i start) 'after)])
|
||||
(if newline?
|
||||
[inserted-line (and inserted-line?
|
||||
(snip->line initial-snip))]
|
||||
[sniplen (- (snip->count initial-snip) s)])
|
||||
(cond
|
||||
[(= i addlen)
|
||||
(set! first-line (mline-first (unbox line-root-box)))
|
||||
(set! last-line (mline-last (unbox line-root-box)))
|
||||
(set! len (+ len addlen))
|
||||
(assert (= (last-position) (+ (mline-get-position last-line)
|
||||
(mline-len last-line))))
|
||||
(when inserted-line
|
||||
;; The last added line could have snips with WIDTH-DEPENDS-ON-X,
|
||||
;; but we've only called `adjust-line-length` so far.
|
||||
(mline-calc-line-length inserted-line))
|
||||
(success-finish addlen (and inserted-line #t))]
|
||||
[(= cnt sniplen)
|
||||
;; move to next snip
|
||||
(define snip (snip->next the-snip))
|
||||
(loop snip
|
||||
0
|
||||
(+ i start)
|
||||
(string-snip-buffer snip)
|
||||
(string-snip-dtext snip)
|
||||
i
|
||||
0
|
||||
inserted-line
|
||||
(snip->count snip))]
|
||||
[else
|
||||
(when (equal? (string-ref str sp) #\return)
|
||||
(string-set! str sp #\newline))
|
||||
(define c (string-ref str sp))
|
||||
(cond
|
||||
[(or (equal? c #\newline) (equal? c #\tab))
|
||||
(let ([newline? (equal? c #\newline)])
|
||||
(define long-char-snip
|
||||
(if (zero? (+ cnt the-s))
|
||||
the-snip
|
||||
(snip->next (split-one* (+ cnt the-s) the-snip))))
|
||||
(define char-snip (split-one* 1 long-char-snip))
|
||||
(define new-snip
|
||||
(let ([snip char-snip])
|
||||
(if newline?
|
||||
|
||||
;; forced return - split the snip
|
||||
(begin
|
||||
(set-snip-flags! snip
|
||||
(remove-flag
|
||||
(add-flag (add-flag (add-flag (snip->flags snip)
|
||||
NEWLINE)
|
||||
HARD-NEWLINE)
|
||||
INVISIBLE)
|
||||
CAN-APPEND))
|
||||
(if (not (eq? snip (mline-last-snip (snip->line snip))))
|
||||
(let* ([old-line (snip->line snip)]
|
||||
[line (mline-insert old-line line-root-box #t)])
|
||||
(set-snip-line! snip line)
|
||||
(set! num-valid-lines (add1 num-valid-lines))
|
||||
(set-mline-last-snip! line snip)
|
||||
(set-mline-snip! line (mline-snip old-line))
|
||||
;; forced return - split the line
|
||||
(begin
|
||||
(set-snip-flags! snip
|
||||
(remove-flag
|
||||
(add-flag (add-flag (add-flag (snip->flags snip)
|
||||
NEWLINE)
|
||||
HARD-NEWLINE)
|
||||
INVISIBLE)
|
||||
CAN-APPEND))
|
||||
(if (not (eq? snip (mline-last-snip (snip->line snip))))
|
||||
(let* ([old-line (snip->line snip)]
|
||||
[line (mline-insert old-line line-root-box #t)])
|
||||
(set-snip-line! snip line)
|
||||
(set! num-valid-lines (add1 num-valid-lines))
|
||||
(set-mline-last-snip! line snip)
|
||||
(set-mline-snip! line (mline-snip old-line))
|
||||
|
||||
;; retarget snips moved to new line:
|
||||
(let loop ([c-snip (mline-snip old-line)])
|
||||
(unless (eq? c-snip snip)
|
||||
(set-snip-line! c-snip line)
|
||||
(loop (snip->next c-snip))))
|
||||
|
||||
(set-mline-snip! old-line (snip->next snip))
|
||||
|
||||
(mline-calc-line-length old-line)
|
||||
(mline-mark-recalculate old-line)
|
||||
(when (max-width . > . 0)
|
||||
(mline-mark-check-flow old-line))
|
||||
|
||||
(mline-calc-line-length line)
|
||||
(mline-mark-recalculate line)
|
||||
(when (max-width . > . 0)
|
||||
(mline-mark-check-flow line)))
|
||||
|
||||
;; carriage-return inserted at the end of a auto-wrapped line;
|
||||
;; line lengths stay the same, but next line now starts
|
||||
;; a paragraph
|
||||
(let ([next (mline-next (snip->line snip))])
|
||||
(when next
|
||||
(when (zero? (mline-starts-paragraph next))
|
||||
(mline-set-starts-paragraph next #t))))))
|
||||
|
||||
;; convert a tab to a tab-snip%
|
||||
(let ([tabsnip (let ([ts (on-new-tab-snip)])
|
||||
(if (or (send ts is-owned?)
|
||||
(positive? (snip->count ts)))
|
||||
;; uh-oh
|
||||
(new tab-snip%)
|
||||
ts))])
|
||||
(set-snip-style! tabsnip (snip->style snip))
|
||||
(let* ([rsnip (snip-set-admin tabsnip snip-admin)]
|
||||
[tabsnip (if (not (eq? rsnip tabsnip))
|
||||
;; uh-oh
|
||||
(let ([tabsnip (new tab-snip%)])
|
||||
(set-snip-style! tabsnip (snip->style snip))
|
||||
(send tabsnip set-admin snip-admin)
|
||||
tabsnip)
|
||||
tabsnip)])
|
||||
;; retarget snips moved to new line:
|
||||
(define delta
|
||||
(let loop ([c-snip (mline-snip old-line)] [delta 0])
|
||||
(cond
|
||||
[(eq? c-snip snip)
|
||||
(+ delta (snip->count snip))]
|
||||
[else
|
||||
(set-snip-line! c-snip line)
|
||||
(loop (snip->next c-snip)
|
||||
(+ delta (snip->count c-snip)))])))
|
||||
|
||||
(set-snip-flags! tabsnip
|
||||
(add-flag (snip->flags tabsnip) CAN-SPLIT))
|
||||
(send tabsnip insert "\t" 1 0)
|
||||
(when (has-flag? (snip->flags tabsnip) CAN-SPLIT)
|
||||
(set-snip-flags! tabsnip
|
||||
(remove-flag (snip->flags tabsnip) CAN-SPLIT)))
|
||||
(when (has-flag? (snip->flags snip) NEWLINE)
|
||||
(set-snip-flags! tabsnip (add-flag (snip->flags tabsnip) NEWLINE)))
|
||||
(set-mline-snip! old-line (snip->next snip))
|
||||
|
||||
(splice-snip tabsnip (snip->prev snip) (snip->next snip))
|
||||
(set-snip-line! tabsnip (snip->line snip))
|
||||
(when (eq? (mline-snip (snip->line snip)) snip)
|
||||
(set-mline-snip! (snip->line tabsnip) tabsnip))
|
||||
(when (eq? (mline-last-snip (snip->line snip)) snip)
|
||||
(set-mline-last-snip! (snip->line tabsnip) tabsnip))))))
|
||||
(mline-adjust-line-length old-line (- delta))
|
||||
(mline-mark-recalculate old-line)
|
||||
(when (max-width . > . 0)
|
||||
(mline-mark-check-flow old-line))
|
||||
|
||||
(let ([snip (do-find-snip (+ i start 1) 'after)])
|
||||
(let ([i (add1 i)])
|
||||
(loop (+ i start)
|
||||
(if (= i addlen) #f (string-snip-buffer snip))
|
||||
(if (= i addlen) #f (string-snip-dtext snip))
|
||||
i
|
||||
0
|
||||
(or inserted-line? newline?)))))]
|
||||
(mline-adjust-line-length line delta)
|
||||
(mline-mark-recalculate line)
|
||||
(when (max-width . > . 0)
|
||||
(mline-mark-check-flow line)))
|
||||
|
||||
[(cnt . > . MAX-COUNT-FOR-SNIP)
|
||||
;; divide up snip, because it's too large:
|
||||
(make-snipset (+ i start) (+ i start))
|
||||
(let ([snip (do-find-snip (+ i start) 'after)])
|
||||
(loop (+ i start)
|
||||
(string-snip-buffer snip)
|
||||
(add1 (string-snip-dtext snip))
|
||||
(add1 i)
|
||||
1
|
||||
inserted-line?))]
|
||||
|
||||
[else
|
||||
(loop start str (+ sp 1) (+ i 1) (+ cnt 1) inserted-line?)])))))))))))
|
||||
;; carriage-return inserted at the end of a auto-wrapped line;
|
||||
;; line lengths stay the same, but next line now starts
|
||||
;; a paragraph
|
||||
(let ([next (mline-next (snip->line snip))])
|
||||
(when next
|
||||
(when (zero? (mline-starts-paragraph next))
|
||||
(mline-set-starts-paragraph next #t)))))
|
||||
|
||||
snip)
|
||||
|
||||
;; convert a tab to a tab-snip%
|
||||
(let ([tabsnip (let ([ts (on-new-tab-snip)])
|
||||
(if (or (send ts is-owned?)
|
||||
(positive? (snip->count ts)))
|
||||
;; uh-oh
|
||||
(new tab-snip%)
|
||||
ts))])
|
||||
(set-snip-style! tabsnip (snip->style snip))
|
||||
(let* ([rsnip (snip-set-admin tabsnip snip-admin)]
|
||||
[tabsnip (if (not (eq? rsnip tabsnip))
|
||||
;; uh-oh
|
||||
(let ([tabsnip (new tab-snip%)])
|
||||
(set-snip-style! tabsnip (snip->style snip))
|
||||
(send tabsnip set-admin snip-admin)
|
||||
tabsnip)
|
||||
tabsnip)])
|
||||
|
||||
(set-snip-flags! tabsnip
|
||||
(add-flag (snip->flags tabsnip) CAN-SPLIT))
|
||||
(send tabsnip insert "\t" 1 0)
|
||||
(when (has-flag? (snip->flags tabsnip) CAN-SPLIT)
|
||||
(set-snip-flags! tabsnip
|
||||
(remove-flag (snip->flags tabsnip) CAN-SPLIT)))
|
||||
(when (has-flag? (snip->flags snip) NEWLINE)
|
||||
(set-snip-flags! tabsnip (add-flag (snip->flags tabsnip) NEWLINE)))
|
||||
|
||||
(splice-snip tabsnip (snip->prev snip) (snip->next snip))
|
||||
(set-snip-line! tabsnip (snip->line snip))
|
||||
(when (eq? (mline-snip (snip->line snip)) snip)
|
||||
(set-mline-snip! (snip->line tabsnip) tabsnip))
|
||||
(when (eq? (mline-last-snip (snip->line snip)) snip)
|
||||
(set-mline-last-snip! (snip->line tabsnip) tabsnip))
|
||||
tabsnip)))))
|
||||
|
||||
(let ([snip (snip->next new-snip)])
|
||||
(let ([i (add1 i)])
|
||||
(loop snip
|
||||
0
|
||||
(+ i start)
|
||||
(if (= i addlen) #f (string-snip-buffer snip))
|
||||
(if (= i addlen) #f (string-snip-dtext snip))
|
||||
i
|
||||
0
|
||||
(if newline?
|
||||
(snip->line (or snip new-snip))
|
||||
inserted-line)
|
||||
(if (= i addlen) 0 (snip->count snip))))))]
|
||||
|
||||
[else
|
||||
(loop the-snip the-s
|
||||
start str (+ sp 1) (+ i 1) (+ cnt 1)
|
||||
inserted-line sniplen)])]))))))))
|
||||
|
||||
(define/private (check-len str len)
|
||||
(unless (len . <= . (string-length str))
|
||||
|
|
@ -4315,7 +4365,13 @@
|
|||
(set-snip-flags! a (remove-flag (remove-flag (snip->flags b) NEWLINE)
|
||||
HARD-NEWLINE)))))
|
||||
|
||||
(define/private (split-one pos s-pos snip extra)
|
||||
(define/private (split-one* amt snip)
|
||||
(if (or (= 0 amt)
|
||||
(= amt (snip->count snip)))
|
||||
snip
|
||||
(split-one amt snip #f)))
|
||||
|
||||
(define/private (split-one amt snip extra)
|
||||
(let ([line (snip->line snip)]
|
||||
[prev (snip->prev snip)]
|
||||
[next (snip->next snip)]
|
||||
|
|
@ -4325,7 +4381,7 @@
|
|||
[orig snip])
|
||||
(let-boxes ([ins-snip #f]
|
||||
[snip #f])
|
||||
(snip-split orig (- pos s-pos) ins-snip snip)
|
||||
(snip-split orig amt ins-snip snip)
|
||||
|
||||
(set-snip-style! snip style)
|
||||
(set-snip-style! ins-snip style)
|
||||
|
|
@ -4347,7 +4403,9 @@
|
|||
(snip-set-admin snip snip-admin)
|
||||
(snip-set-admin ins-snip snip-admin)
|
||||
|
||||
(after-split-snip (- pos s-pos))))))
|
||||
(after-split-snip amt)
|
||||
|
||||
ins-snip))))
|
||||
|
||||
(define/private (make-snipset start end)
|
||||
;; BEWARE: `len' may not be up-to-date
|
||||
|
|
@ -4355,11 +4413,11 @@
|
|||
(let-values ([(snip s-pos) (find-snip/pos start 'after-or-none)])
|
||||
(when snip
|
||||
(unless (= s-pos start)
|
||||
(split-one start s-pos snip #f)))))
|
||||
(split-one (- start s-pos) snip #f)))))
|
||||
(when (positive? end)
|
||||
(let-values ([(snip s-pos) (find-snip/pos end 'before)])
|
||||
(unless (= (+ s-pos (snip->count snip)) end)
|
||||
(split-one end s-pos snip #f)))))
|
||||
(split-one (- end s-pos) snip #f)))))
|
||||
|
||||
(define/private (insert-text-snip start style)
|
||||
(let* ([snip (on-new-string-snip)]
|
||||
|
|
@ -4412,7 +4470,7 @@
|
|||
(set-mline-snip! (snip->line snip) snip))
|
||||
snip]
|
||||
[else
|
||||
(split-one start s-pos gsnip
|
||||
(split-one (- start s-pos) gsnip
|
||||
(lambda (gsnip)
|
||||
(set-snip-line! snip (snip->line gsnip))
|
||||
(insert-snip gsnip snip)))
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user