From 7a1cb5ed11b44c1a10e6b882f8b411c2f69c22b5 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 24 Nov 2014 11:52:05 -0700 Subject: [PATCH] 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. original commit: ac5961eae9a4d5c24f78e1d8f7d531c7f7881783 --- .../gui-lib/mred/private/wxme/mline.rkt | 37 ++- .../gui-lib/mred/private/wxme/text.rkt | 306 +++++++++++------- 2 files changed, 205 insertions(+), 138 deletions(-) diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wxme/mline.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wxme/mline.rkt index 98ca7e93..a1f72a4d 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/private/wxme/mline.rkt +++ b/pkgs/gui-pkgs/gui-lib/mred/private/wxme/mline.rkt @@ -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? diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wxme/text.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wxme/text.rkt index 1dbc018b..fcc9c165 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/private/wxme/text.rkt +++ b/pkgs/gui-pkgs/gui-lib/mred/private/wxme/text.rkt @@ -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)))