par: piece-table: delete operation

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")