diff options
| -rw-r--r-- | par/piece-table.scm | 86 | ||||
| -rw-r--r-- | par/piece-table.sld | 4 | ||||
| -rw-r--r-- | tests/piece-table.scm | 10 |
3 files changed, 54 insertions, 46 deletions
diff --git a/par/piece-table.scm b/par/piece-table.scm index aa4993b..7ddab44 100644 --- a/par/piece-table.scm +++ b/par/piece-table.scm @@ -12,6 +12,26 @@ (length piece-length set-piece-length!) (type piece-type set-piece-type!)) +(define (can-merge-pieces? a b) + (and (eq? (piece-buffer a) (piece-buffer b)) + (= (+ (piece-start a) (piece-length a)) (piece-start b)) + (equal? (piece-type a) (piece-type b)))) + +(define (merge-pieces! a b) + (set-piece-length! a (+ (piece-length a) (piece-length b))) + a) + +(define (split-piece! a at) + (values + (make-piece (piece-buffer a) + (piece-start a) + at + (piece-type a)) + (make-piece (piece-buffer a) + (+ at (piece-start a)) + (- (piece-length a) at) + (piece-type a)))) + ;; INTERNAL BUFFERS: The indirection level of the buffer records is cool, so we @@ -88,12 +108,6 @@ ro-buffer (make-add-buffer) (list (make-piece ro-buffer 0 (string-length original) 'normal))))) -(define (add-piece-table-piece! piece-table piece) - "Add a new piece to the piece table. Piece is added in the end. Order is - important." - (set-piece-table-pieces! piece-table - (append! (piece-table-pieces piece-table) (list piece)))) - (define (piece-table-index piece-table pos) (let loop ((pieces (piece-table-pieces piece-table)) (start 0)) @@ -119,42 +133,30 @@ (values idx rem) (loop (+ idx 1) (cdr ps) (- rem len)))))) -(define (piece-table-insert! piece-table pos str) - ;; Write to add-buffer first - (let ((piece-to-insert (add-buffer-append! (piece-table-add-buffer piece-table) str))) - ;; Now assign a piece for what we wrote - ;; It's probably reasonable to combine both branches in just the one in the - ;; bottom - (if (= (piece-table-text-length piece-table) pos) - ;; last position - (let ((last-piece (last (piece-table-pieces piece-table)))) - (if (eq? (piece-table-add-buffer piece-table) - (piece-buffer last-piece)) - (set-piece-length! last-piece (+ (string-length str) - (piece-length last-piece))) - (add-piece-table-piece! piece-table - (piece-to-insert #f)))) - - ;; not last - (let*-values (((idx rem) (piece-table-text-pos->piece-idx+remainder - piece-table pos)) - ((beg end) (split-at! (piece-table-pieces piece-table) idx))) - (let* ((altered (car end)) - (rest (cdr end)) - (buffer (piece-buffer altered)) - (start (piece-start altered)) - (length (piece-length altered)) - (add-buffer (piece-table-add-buffer piece-table))) - (set-piece-table-pieces! - piece-table - (append beg - (list (make-piece buffer start rem #f) - (piece-to-insert #f) - (make-piece buffer - (+ start rem) - (- length rem) - #f)) - rest))))))) +(define (piece-table-insert! piece-table pos str type) + (define candidate ((add-buffer-append! + (piece-table-add-buffer piece-table) str) + type)) + + (define (list-ref-with-context l i) + (let ((len (length l))) + (values (take l i) (list-ref l i) (drop l (+ 1 i))))) + + (set-piece-table-pieces! piece-table + (let*-values (((idx rem) (piece-table-text-pos->piece-idx+remainder + piece-table pos)) + ((beg piece end) (list-ref-with-context + (piece-table-pieces piece-table) + idx))) + (if (and (= rem (piece-length piece)) + (can-merge-pieces? piece candidate)) + (append beg (list (merge-pieces! piece candidate)) end) + (let-values (((first second) (split-piece! piece rem))) + (append beg (list first candidate second) end)))))) + + +(define (piece-table-delete! piece-table pos len) + #f) diff --git a/par/piece-table.sld b/par/piece-table.sld index 1c915d7..053b863 100644 --- a/par/piece-table.sld +++ b/par/piece-table.sld @@ -1,9 +1,11 @@ (define-library (par piece-table) (import (scheme base) - (srfi 1)) + (srfi 1) + (srfi 11)) (export make-piece-table piece-table-index piece-table-insert! piece-table-delete! + piece-table->string string->piece-table) (include "piece-table.scm")) diff --git a/tests/piece-table.scm b/tests/piece-table.scm index d1fa32a..04a62bc 100644 --- a/tests/piece-table.scm +++ b/tests/piece-table.scm @@ -12,9 +12,13 @@ (test-begin "insert") (define table (make-piece-table "HOLA")) - (piece-table-insert! table 2 "90") - (test-equal #\9 (piece-table-index table 2)) - (test-equal #\0 (piece-table-index table 3)) + (piece-table-insert! table 4 "9" 'normal) + (piece-table-insert! table 5 "0" 'normal) + (test-equal #\9 (piece-table-index table 4)) + (test-equal #\0 (piece-table-index table 5)) + (test-equal "HOLA90" (piece-table->string table)) + (piece-table-insert! table 5 "1" 'normal) + (test-equal "HOLA910" (piece-table->string table)) (test-end "insert") (test-begin "delete") |