From 67f7a5e9eba1e97b975b2d5cd8a29aef404f9149 Mon Sep 17 00:00:00 2001
From: Ekaitz Zarraga <ekaitz@elenq.tech>
Date: Tue, 9 Jan 2024 22:30:26 +0100
Subject: par: piece-table: delete operation
---
par/piece-table.scm | 63 ++++++++++++++++++++++++++++++++++++++++++---------
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")
--
cgit v1.2.3