par: piece-table: clean insert a little bit

1 files changed, 30 insertions, 38 deletions

diff --git a/par/piece-table.scm b/par/piece-table.scm
index 7a1cae7..aa4993b 100644
--- a/par/piece-table.scm
+++ b/par/piece-table.scm
@@ -108,21 +108,20 @@
 (define (piece-table-text-length piece-table)
   (reduce + 0 (map piece-length (piece-table-pieces piece-table))))
 
-(define (piece-table-insert! piece-table pos str)
-
-  (define (pos->piece-idx-pos ps pos)
-    (let loop ((idx 0)
-               (pieces ps)
-               (rem pos))
-       (let* ((current (car pieces))
-              (len     (piece-length current)))
-        (if (<= rem len)
-          (values idx rem)
-          (loop (+ idx 1) (cdr pieces) (- rem len))))))
+(define (piece-table-text-pos->piece-idx+remainder piece-table pos)
+  "Returns (values piece remainder)"
+  (let loop ((idx 0)
+             (ps (piece-table-pieces piece-table))
+             (rem pos))
+     (let* ((current (car ps))
+            (len     (piece-length current)))
+      (if (<= rem len)
+        (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
@@ -137,32 +136,25 @@
                                   (piece-to-insert #f))))
 
       ;; not last
-      (call-with-values
-        (lambda () (pos->piece-idx-pos (piece-table-pieces piece-table) pos))
-        (lambda (idx rem)
-          (call-with-values
-            (lambda ()
-              (split-at! (piece-table-pieces piece-table) idx))
-            (lambda (beg end)
-              (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-delete! piece-table pos)
-  #f)
+      (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)))))))