diff options
-rw-r--r-- | par/piece-table.scm | 63 | ||||
-rw-r--r-- | tests/piece-table.scm | 7 |
2 files changed, 59 insertions, 11 deletions
diff --git a/par/piece-table.scm b/par/piece-table.scm index 7ddab44..9f967c0 100644 --- a/par/piece-table.scm +++ b/par/piece-table.scm @@ -1,3 +1,23 @@ +;; TODO: REMOVE ME: Chibi scheme fails to append! to empty lists. I fixed it +;; upstream, but it will take time to get to guix +(define (concatenate! lists) + (if (null? lists) + '() + (let loop ((acc '()) + (prev '()) + (rem lists)) + (cond + ((null? rem) acc) + ((null? acc) (let ((cur (car rem))) (loop cur cur (cdr rem)))) + ((null? (car rem)) (loop acc prev (cdr rem))) + (else (let ((cur (car rem))) + (set-cdr! (last-pair prev) cur) + (loop acc cur (cdr rem)))))))) +(define (append! . lists) (concatenate! lists)) +;; /REMOVE ME + + + ;; Pieces themselves: the buffer is a reference to the buffer they take their ;; data from. ;; Start and end are numbers. @@ -129,19 +149,19 @@ (rem pos)) (let* ((current (car ps)) (len (piece-length current))) - (if (<= rem len) + (if (<= rem len) ; TODO not cool when removing! (values idx rem) (loop (+ idx 1) (cdr ps) (- rem len)))))) +(define (list-ref-with-context l i) + (let ((len (length l))) + (values (take l i) (list-ref l i) (drop l (+ 1 i))))) + (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)) @@ -150,13 +170,34 @@ idx))) (if (and (= rem (piece-length piece)) (can-merge-pieces? piece candidate)) - (append beg (list (merge-pieces! piece candidate)) end) + (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) + (append! beg (list first candidate second) end)))))) + + +; TODO: SET-CDR for the win? +; - That would need other way to find the affected pieces and manipulate them. +; > we'll leave it for the future +(define (piece-table-delete! piece-table pos) + (let*-values (((idx rem) (piece-table-text-pos->piece-idx+remainder + piece-table (+ 1 pos))) ; TODO because of the <= + ((beg piece end) (list-ref-with-context + (piece-table-pieces piece-table) + idx))) + (let ((piece-len (piece-length piece))) + (cond + ((= piece-len 1) + (append! beg end)) + ((= rem piece-len) + (set-piece-length! piece (- piece-len 1))) + ((= rem 1) + (set-piece-start! piece (+ 1 (piece-start piece)))) + (else + (let-values (((first second) (split-piece! piece rem))) + (set-piece-length! first (- rem 1)) + (set-piece-table-pieces! + piece-table + (append! beg (list first second) end)))))))) diff --git a/tests/piece-table.scm b/tests/piece-table.scm index 04a62bc..b8b6ff1 100644 --- a/tests/piece-table.scm +++ b/tests/piece-table.scm @@ -22,4 +22,11 @@ (test-end "insert") (test-begin "delete") + (define table (make-piece-table "HOLA SOY EKAITZ")) + (piece-table-delete! table 4) + (test-equal "HOLASOY EKAITZ" (piece-table->string table)) + (piece-table-delete! table 0) + (test-equal "OLA SOY EKAITZ" (piece-table->string table)) + (piece-table-delete! table 13) + (test-equal "OLA SOY EKAIT" (piece-table->string table)) (test-end "delete") |