From 8ef151b19ab9d23485518809cb0fec71a861bb93 Mon Sep 17 00:00:00 2001
From: Ekaitz Zarraga <ekaitz@elenq.tech>
Date: Wed, 14 Feb 2024 18:08:44 +0100
Subject: par: piece-table: Start massive rewrite

---
 par/%piece-table-all.sld |  24 +++++
 par/piece-table.scm      | 257 ++++++++++++++---------------------------------
 par/piece-table.sld      |  10 +-
 tests/piece-table.scm    | 101 ++++++++++---------
 4 files changed, 156 insertions(+), 236 deletions(-)
 create mode 100644 par/%piece-table-all.sld

diff --git a/par/%piece-table-all.sld b/par/%piece-table-all.sld
new file mode 100644
index 0000000..99894ee
--- /dev/null
+++ b/par/%piece-table-all.sld
@@ -0,0 +1,24 @@
+(define-library (par %piece-table-all)
+  (import (scheme base)
+          (par buffers)
+          (srfi 11))
+  (export make-piece
+          piece-next
+          piece-prev
+          split-piece!
+          merge-pieces!
+          connect-pieces!
+          can-merge-pieces?
+          piece-empty?
+
+          make-piece-table
+          piece-table-sentinel
+          piece-table-index
+          piece-table-length
+          piece-table-insert!
+          piece-table-delete!
+          piece-table-change-looks!
+
+          piece-table->string
+          string->piece-table)
+  (include "piece-table.scm"))
diff --git a/par/piece-table.scm b/par/piece-table.scm
index 5012a94..f20dbd5 100644
--- a/par/piece-table.scm
+++ b/par/piece-table.scm
@@ -5,7 +5,7 @@
 ;; possible to account for hyperlinks or stuff like that in the future with
 ;; ease.
 (define-record-type <piece>
-  (%make-piece buffer start length type next prev)
+  (make-piece buffer start length type next prev)
   piece?
   (buffer piece-buffer set-piece-buffer!)
   (start piece-start set-piece-start!)
@@ -40,53 +40,40 @@
   (cond
     ((sentinel-piece? p) (%set-sentinel-piece-next! p next))
     ((piece? p) (%set-piece-next! p next))))
+;; End polymorphic magic
 
-
+(define (piece-empty? p)
+  (= (piece-length p) 0))
 
 (define (can-merge-pieces? a b)
-  ;; Maybe simplify the and/or/not magic?
-  (and (not (or (sentinel-piece? a) (sentinel-piece? b)))
-       (or
-         (or (= 0 (piece-length a)) (= 0 (piece-length 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)
-  (when (= 0 (piece-length a)) ;; First is empty, so we eat it
-    (set-piece-start! a (piece-start b)))
-  (set-piece-length! a (+ (piece-length a) (piece-length b)))
-  (set-piece-next! a (piece-next b))
-  (unless (sentinel-piece? (piece-next b)) (set-piece-prev! (piece-next b) a)))
-
-
-
-;; Piece API
-(define (make-piece buffer start length type prev next)
-  (%make-piece buffer start length type prev next))
+  (and (piece? a) (piece? b)
+       (or (piece-empty? a) (piece-empty? b)
+           (and
+             (equal? (piece-buffer a) (piece-buffer b))
+             (= (+ (piece-start a) (piece-length a)) (piece-start b))
+             (equal? (piece-type a) (piece-type b)) ))))
 
 (define (connect-pieces! a b)
-  (begin
-    (set-piece-next! a b)
-    (set-piece-prev! b a)))
-
-(define (split-piece! a at)
-  (if (and (= at 0) (sentinel-piece? a))
-    (values a a) ;; Just return the sentinel twice, as this is only used to
-                 ;; take one of them
-    (letrec* ((b (%make-piece (piece-buffer a)
-                              (+ at (piece-start a))
-                              (- (piece-length a) at)
-                              (piece-type a)
-                              (piece-next a)
-                              a)))
-      (unless (sentinel-piece? (piece-next a))
-        (set-piece-prev! (piece-next a) b))
-      (set-piece-length! a at)
-      (set-piece-next! a b)
-      (values a b))))
+  (set-piece-next! a b)
+  (set-piece-prev! b a))
 
-
+(define (merge-pieces! a b)
+  (set-piece-length! a (+ (piece-length a) (piece-length b)))
+  (connect-pieces! a (piece-next b)))
+
+(define (split-piece! a pos)
+  (when (sentinel-piece? a)
+    (error "Attempting to split the sentinel-piece"))
+  (when (>= pos (piece-length a))
+    (error "Attempting a split out of a piece"))
+  (let ((new-p (make-piece (piece-buffer a)
+                           (+ (piece-start a) pos)
+                           (- (piece-length a) pos)
+                           (piece-type a)
+                           #f #f)))
+   (set-piece-length! a pos)
+   (connect-pieces! new-p (piece-next a))
+   (connect-pieces! a new-p)))
 
 
 
@@ -94,165 +81,73 @@
 ;; original is a ro-buffer, add is an add-buffer (a string designed to grow)
 ;; and pieces is a piece that has its prev and next.
 (define-record-type <piece-table>
-  (%make-piece-table original-buffer add-buffer piece)
+  (%make-piece-table original-buffer add-buffer sentinel length
+                     cached-piece cached-origin)
   piece-table?
   (original-buffer piece-table-original-buffer set-piece-table-original-buffer!)
   (add-buffer piece-table-add-buffer set-piece-table-add-buffer!)
-  (piece piece-table-piece set-piece-table-piece!))
+  (sentinel piece-table-sentinel set-piece-table-sentinel!)
+  (length piece-table-length set-piece-table-length!)
+  (cached-piece piece-table-cached-piece set-piece-table-cached-piece!)
+  (cached-origin piece-table-cached-origin set-piece-table-cached-origin!))
 
 
 (define (make-piece-table original)
   (letrec* ((ro-buffer (make-ro-buffer original))
             (piece     (make-piece ro-buffer 0 (string-length original) 'normal
-                                   sentinel sentinel))
-            (sentinel  (make-sentinel-piece piece piece)))
-    (set-piece-prev! piece sentinel)
-    (set-piece-next! piece sentinel)
+                                   #f #f))
+            (sentinel  (make-sentinel-piece #f #f)))
+    (connect-pieces! sentinel piece)
+    (connect-pieces! piece sentinel)
     (%make-piece-table
-      ro-buffer (make-add-buffer) piece)))
-
-(define (piece-table-index->piece+index piece-table pos)
-  "Returns (values piece remainder) or eof-object"
-  (let loop ((piece (piece-table-piece piece-table))
-             (rem pos))
-    (cond
-      ((sentinel-piece? piece)
-       (if (= rem 0)
-         (values piece rem)
-         (error "Requested position out of piece-table")))
-      ((< rem (piece-length piece))
-       (values piece rem))
-      (else
-       (loop (piece-next piece) (- rem (piece-length piece)))))))
-
-(define (piece-table-last-piece piece-table)
-  (piece-prev (piece-prev (piece-table-piece piece-table))))
+      ro-buffer (make-add-buffer) sentinel (string-length original) piece 0)))
+
+(define (piece-table-update-length! piece-table by)
+  (set-piece-table-length! piece-table
+    (+ (piece-table-length piece-table) by)))
+
+(define (piece-table-find-piece piece-table pos)
+  "Returns (values piece origin) so the local coordinate is (- pos origin)"
+  (define (search-forward piece origin)
+    (if (>= pos (+ origin (piece-length piece)))
+      (search-forward (piece-next piece) (+ (piece-length piece) origin))
+      (values piece origin)))
+  (define (search-backwards piece origin)
+    (if (< pos origin)
+      (search-backwards (piece-prev piece) (- origin (piece-length piece)))
+      (values piece origin)))
+
+  (let-values (((piece origin)
+                ((if (> pos (piece-table-cached-origin piece-table))
+                   search-forward search-backwards)
+                 (piece-table-cached-piece piece-table)
+                 (piece-table-cached-origin piece-table))))
+    (set-piece-table-cached-piece!  piece-table piece)
+    (set-piece-table-cached-origin! piece-table origin)
+    (values piece origin)))
 
 
 
-
 ;; API
-
 (define (piece-table-index piece-table pos)
-  ;; TODO: Validate input
-  (let-values (((piece idx) (piece-table-index->piece+index piece-table pos)))
-   (string-ref (buffer->string (piece-buffer piece))
-               (+ (piece-start piece) idx))))
-
-(define (piece-table-text-length piece-table)
-  (let loop ((piece (piece-table-piece piece-table))
-             (acc   0))
-    (if (sentinel-piece? (piece-next piece))
-      (+ acc (piece-length piece))
-      (loop (piece-next piece) (+ (piece-length piece) acc)))))
-
-(define (%piece-fold-from piece f identity)
-  (let loop ((piece piece)
-             (acc   identity))
-    (unless (sentinel-piece? piece)
-      (loop (piece-next piece) (f piece acc)))))
+  (when (< -1 pos (piece-table-length piece-table))
+    (let-values (((piece origin) (piece-table-find-piece piece-table pos)))
+      (string-ref (buffer->string (piece-buffer piece))
+                  (+ (piece-start piece) (- pos origin))))))
 
-(define (%piece-fold-from-right piece f identity)
-  (let loop ((piece piece)
-             (acc  identity))
-    (unless (sentinel-piece? piece)
-      (loop (piece-prev piece) (f piece acc)))))
-
-
-(define (piece-table-for-each piece-table f from to)
-  ;; TODO: default from and to
-  ;; TODO: maybe combine with the `piece-table-index->piece+index` to find the
-  ;; `from`
-  ;; TODO: make this lower level, searching from a piece, not from the table
-  ;; TODO: implement using `%piece-fold-from`
-  "Calls `f` through the characters of the piece-table, like `string-for-each`
-  would do, but the `f` call also includes the piece (to expose extra data) and
-  the index of the character"
-  (let loop ((idx   0)
-             (start 0)
-             (piece (piece-table-piece piece-table)))
-    (let* ((len   (piece-length piece))
-           (end   (+ start len))
-           (more? (not (sentinel-piece? (piece-next piece)))))
-      (when (< idx to) ;; Skip tail
-        (if (or (= idx end) (<= end from))
-          ;; Current piece doesn't contain the section we need or finished
-          ;; Jump to next piece
-          (when more? (loop end end (piece-next piece)))
-          ;; Current piece contains part of the section we need, go char by
-          ;; char
-          (begin
-            (when (<= from idx)
-              (f
-                (string-ref (buffer->string (piece-buffer piece))
-                            (+ (piece-start piece) (- idx start)))
-                idx
-                piece))
-            ;; There are chars to process in this piece
-            (loop (+ idx 1) start piece)))))))
-
-(define (piece-table-for-each-right piece-table f from to)
-  "-right version of piece-table-for-each, it finds the tail and goes
-  backwards"
-  ;; TODO: not implemented yet
-  ;; TODO: make this lower level, searching from a piece, not from the table
-  )
 
 
 (define (piece-table-insert! piece-table pos str type)
-  ;; TODO: validate input
-  ;; TODO: Try to reuse the caracters on the target buffer if they are already
-  ;; there? Is this maximum evilness? => it's just a string-ref and it prevents
-  ;; us from creating pieces!
-
-  (let* ((add-buffer (piece-table-add-buffer piece-table))
-         (start      (add-buffer-used add-buffer))
-         (_          (add-buffer-append! add-buffer str))
-         (candidate  (make-piece add-buffer
-                                start
-                                (string-length str)
-                                type
-                                #f #f)))
-    (unless (= 0 (string-length str))
-      (let*-values (((piece idx)
-                     (piece-table-index->piece+index piece-table pos)))
-        (cond
-          ((= idx 0)
-           (connect-pieces! (piece-prev piece) candidate)
-           (connect-pieces! candidate piece)
-           (when (can-merge-pieces? (piece-prev piece) candidate)
-             (merge-pieces! (piece-prev piece) candidate)))
-          (else
-            (let-values (((first second) (split-piece! piece idx)))
-              (connect-pieces! first candidate)
-              (connect-pieces! candidate second)
-              (when (can-merge-pieces? first candidate)
-                (merge-pieces! first candidate)))))))))
+  ;; TODO
+  (piece-table-update-length! (string-length str)))
 
 
 (define (piece-table-delete! piece-table from len)
-  (unless (= 0 len)
-    (let*-values (((start-piece idx) (piece-table-index->piece+index
-                                       piece-table from))
-                  ((first second) (split-piece! start-piece idx))
-                  ((end-piece end-idx) (piece-table-index->piece+index
-                                         piece-table (+ from len)))
-                  ((third fourth) (split-piece! end-piece end-idx)))
-      (connect-pieces! first fourth))))
+  ;; TODO
+  (piece-table-update-length! (- len)))
 
-;; Finding:
-(define (piece-table-find piece-table char from)
-  ;; TODO: generalize the from
-  ;; TODO: Implement the backwards one too
-  (call/cc (lambda (cont)
-             (piece-table-for-each
-               piece-table
-               (lambda (c i p)
-                 (when (char=? c char)
-                   (cont i)))
-               from
-               (piece-table-text-length piece-table))
-             (cont (eof-object)))))
+(define (piece-table-change-looks!)
+  #f)
 
 
 
@@ -271,7 +166,7 @@
 
 (define (piece-table-substring piece-table from to)
   (let ((out-string (make-string (- to from))))
-    (let loop ((piece (piece-table-piece piece-table))
+    (let loop ((piece (piece-next (piece-table-sentinel piece-table)))
                (acc   0))
       (if (or (sentinel-piece? piece) (>= acc to))
         out-string
@@ -286,4 +181,4 @@
           (loop (piece-next piece) (+ acc (piece-length piece))))))))
 
 (define (piece-table->string piece-table)
-  (piece-table-substring piece-table 0 (piece-table-text-length piece-table)))
+  (piece-table-substring piece-table 0 (piece-table-length piece-table)))
diff --git a/par/piece-table.sld b/par/piece-table.sld
index cdef979..6215fb0 100644
--- a/par/piece-table.sld
+++ b/par/piece-table.sld
@@ -4,13 +4,11 @@
           (srfi 11))
   (export make-piece-table
           piece-table-index
-          piece-table-text-length
+          piece-table-length
           piece-table-insert!
           piece-table-delete!
+          piece-table-change-looks!
+
           piece-table->string
-          piece-table-substring
-          string->piece-table
-          add-buffer-length
-          piece-table-for-each
-          piece-table-find)
+          string->piece-table)
   (include "piece-table.scm"))
diff --git a/tests/piece-table.scm b/tests/piece-table.scm
index c8d1280..620b50c 100644
--- a/tests/piece-table.scm
+++ b/tests/piece-table.scm
@@ -1,67 +1,70 @@
 (import (srfi 64)
-        (scheme base)
-        (par piece-table))
+        (scheme small)
+        (par %piece-table-all))
 
 ;; https://srfi.schemers.org/srfi-64/srfi-64.html
 
 
 (test-begin "index")
   (define table (make-piece-table "HOLA"))
+  (split-piece! (piece-next (piece-table-sentinel table)) 2) ;;Spice up the test
   (test-equal #\H (piece-table-index table 0))
   (test-equal #\O (piece-table-index table 1))
   (test-equal #\L (piece-table-index table 2))
   (test-equal #\A (piece-table-index table 3))
+  (test-equal #\O (piece-table-index table 1))
 (test-end "index")
 
 (test-begin "length")
   (define table (make-piece-table "HOLA"))
-  (test-equal 4 (piece-table-text-length table))
+  (test-equal 4 (piece-table-length table))
 (test-end "length")
 
-(test-begin "insert")
-  (define table (make-piece-table "HOLA"))
-  (piece-table-insert! table 4 "9" 'normal)
-  (test-equal #\9 (piece-table-index table 4))
-  (piece-table-insert! table 5 "0" 'normal)
-  (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 "substring")
-  (parameterize ((add-buffer-length 10))
-    (define table (make-piece-table "1234567890"))
-    (test-equal  "1234567890" (piece-table-substring table 0 10))
-    (test-equal  "67890" (piece-table-substring table 5 10))
-    (piece-table-insert! table 6 "X" 'normal)
-    (test-equal  "6X78" (piece-table-substring table 5 9)))
-(test-end "substring")
-
-(test-begin "delete")
-  (define table (make-piece-table "HOLA SOY EKAITZ"))
-  (piece-table-delete! table 4 1)
-  (test-equal "HOLASOY EKAITZ" (piece-table->string table))
-  (piece-table-delete! table 0 1)
-  (test-equal "OLASOY EKAITZ" (piece-table->string table))
-  (piece-table-delete! table 12 1)
-  (test-equal "OLASOY EKAIT" (piece-table->string table))
-(test-end "delete")
-
-(test-begin "for-each")
-  (define table (make-piece-table "12346890"))
-  (piece-table-insert! table 4 "5" 'normal)
-  (test-equal "123456890" (piece-table->string table))
-  (piece-table-insert! table 6 "7" 'normal)
-  (test-equal "1234567890" (piece-table->string table))
-  (piece-table-for-each table
-                        (lambda (c i p)
-                          (test-equal c (string-ref "1234567890" i)))
-                        0
-                        10)
-(test-end "for-each")
 
-(test-begin "find")
-  (define table (make-piece-table "1234567890"))
-  (test-equal 8 (piece-table-find table #\9 0))
-(test-end "find")
+;(test-begin "insert")
+;  (define table (make-piece-table "HOLA"))
+;  (piece-table-insert! table 4 "9" 'normal)
+;  (test-equal #\9 (piece-table-index table 4))
+;  (piece-table-insert! table 5 "0" 'normal)
+;  (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 "substring")
+;  (parameterize ((add-buffer-length 10))
+;    (define table (make-piece-table "1234567890"))
+;    (test-equal  "1234567890" (piece-table-substring table 0 10))
+;    (test-equal  "67890" (piece-table-substring table 5 10))
+;    (piece-table-insert! table 6 "X" 'normal)
+;    (test-equal  "6X78" (piece-table-substring table 5 9)))
+;(test-end "substring")
+;
+;(test-begin "delete")
+;  (define table (make-piece-table "HOLA SOY EKAITZ"))
+;  (piece-table-delete! table 4 1)
+;  (test-equal "HOLASOY EKAITZ" (piece-table->string table))
+;  (piece-table-delete! table 0 1)
+;  (test-equal "OLASOY EKAITZ" (piece-table->string table))
+;  (piece-table-delete! table 12 1)
+;  (test-equal "OLASOY EKAIT" (piece-table->string table))
+;(test-end "delete")
+;
+;(test-begin "for-each")
+;  (define table (make-piece-table "12346890"))
+;  (piece-table-insert! table 4 "5" 'normal)
+;  (test-equal "123456890" (piece-table->string table))
+;  (piece-table-insert! table 6 "7" 'normal)
+;  (test-equal "1234567890" (piece-table->string table))
+;  (piece-table-for-each table
+;                        (lambda (c i p)
+;                          (test-equal c (string-ref "1234567890" i)))
+;                        0
+;                        10)
+;(test-end "for-each")
+;
+;(test-begin "find")
+;  (define table (make-piece-table "1234567890"))
+;  (test-equal 8 (piece-table-find table #\9 0))
+;(test-end "find")
-- 
cgit v1.2.3