Add array-packed? tests on empty arrays.

Issue #959.

lib/chibi/text/base.scm

@@ -5,7 +5,7 @@
     (if text
         (lp (text-next text)
             (+ sum
-               (string-length (utf8->string! (text-source text)
+               (string-length (utf8->string! (text-bytes text)
                                              (text-start text)
                                              (text-end text)))))
         sum)))
@@ -34,19 +34,19 @@
     (make-text bv start end #f #f '() #f)))
 
 (define (text-string text)
-  (utf8->string (text-source text) (text-start text) (text-end text)))
+  (utf8->string (text-bytes text) (text-start text) (text-end text)))
 
 ;;> Returns the utf8 representation of the codepoints in \var{text}.
 (define (text->utf8 text)
   (if (and (not (text-prev text)) (not (text-next text)))
-      (bytevector-copy (text-source text) (text-start text) (text-end text))
+      (bytevector-copy (text-bytes text) (text-start text) (text-end text))
       (let ((out (open-output-bytevector)))
         (let lp ((piece (text-first text)))
           (cond
            ((not piece)
             (get-output-bytevector out))
            (else
-            (write-bytevector (text-source piece) out (text-start piece) (text-end piece))
+            (write-bytevector (text-bytes piece) out (text-start piece) (text-end piece))
             (lp (text-next piece))))))))
 
 ;;> Returns a string representing the same codepoints as \var{text}.
@@ -61,25 +61,25 @@
     (let lp ((text (text-prev (mark-text mark))))
       (and text
            (if (< (text-start text) (text-end text))
-               (utf8-ref (text-source text) (- (text-end text) 1))
+               (utf8-ref (text-bytes text) (- (text-end text) 1))
                (lp (text-prev text))))))
    ((>= (mark-offset mark) (text-end (mark-text mark)))
     (let lp ((text (text-next (mark-text mark))))
       (and text
            (if (< (text-start text) (text-end text))
-               (utf8-ref (text-source text) (text-start text))
+               (utf8-ref (text-bytes text) (text-start text))
                (lp (text-next text))))))
    (else
-    (utf8-ref (text-source (mark-text mark)) (mark-offset mark)))))
+    (utf8-ref (text-bytes (mark-text mark)) (mark-offset mark)))))
 
 (define (text-piece-copy text)
-  (let ((res (make-text (bytevector-copy (text-source text))
+  (let ((res (make-text (bytevector-copy (text-bytes text))
                         (text-start text)
                         (text-end text)
                         (text-prev text)
                         (text-next text)
                         '()
-                        (text-data text))))
+                        (text-source text))))
     (text-marks-set! res
                      (map (lambda (mk)
                             (make-mark res (mark-offset mk) (mark-data mk)))
@@ -144,9 +144,9 @@
            (size (max (- at-offset (text-start text))
                       (if (pair? o) (car o) 64)))
            (right (text-new-right! text size)))
-      (bytevector-copy! (text-source right)
+      (bytevector-copy! (text-bytes right)
                         0
-                        (text-source text)
+                        (text-bytes text)
                         at-offset
                         (text-end text))
       (text-end-set! right (- (text-end text) at-offset))
@@ -170,7 +170,7 @@
    (let* ((at-offset (mark-offset at-mark))
           (src (string->utf8 str))
           (size (bytevector-length src))
-          (dst (text-source text))
+          (dst (text-bytes text))
           (dst-size (bytevector-length dst)))
      (cond
       ((= at-offset (text-end text))
@@ -189,7 +189,7 @@
              ;; TODO: better sizing?
              (let ((right (text-new-right! text (* 2 size)))
                    (right-size (- size copy-size)))
-               (bytevector-copy! (text-source right) 0 src copy-size size)
+               (bytevector-copy! (text-bytes right) 0 src copy-size size)
                (text-end-set! right right-size)))
          text))
       ;; ((= at-offset (text-start text))
@@ -244,11 +244,7 @@
         (let lp ((text (text-next from-text)) (marks '()))
           (cond
            ((and text (not (eq? text to-text)))
-            ;; TODO: splice out the nodes themselves
+            (lp (text-next text) (cons (text-splice! text) marks)))
-            (let ((new-marks (text-marks text)))
-              (text-start-set! text (text-end text))
-              (text-marks-set! text '())
-              (lp (text-next text) (cons new-marks marks))))
            (else
             (text-marks-set! to-text
                              (append

lib/chibi/text/marks.scm

@@ -39,18 +39,18 @@
             (data (and (pair? o) (pair? (cdr o)) (cadr o))))
         (let lp ((n index)
                  (text text)
-                 (bv (text-source text))
+                 (bv (text-bytes text))
                  (sc (text-start text)))
           (cond
            ((positive? n)
             (if (>= sc (text-end text))
                 (let ((text2 (text-next text)))
-                  (lp n text2 (text-source text2) (text-start text2)))
+                  (lp n text2 (text-bytes text2) (text-start text2)))
                 (lp (- n 1) text bv (utf8-next bv sc (text-end text)))))
            ((zero? n)
             (values text (make-mark text sc data)))
            (else
             (if (<= sc (text-start text))
                 (let ((text2 (text-prev text)))
-                  (lp n text2 (text-source text2) (text-end text2)))
+                  (lp n text2 (text-bytes text2) (text-end text2)))
                 (lp (+ n 1) text bv (utf8-prev bv sc (text-start text))))))))))

lib/chibi/text/movement.scm

@@ -7,8 +7,8 @@
   (cond
    ((< (mark-offset mark) (text-end (mark-text mark)))
     ;; there was space in the current piece
-    (let ((ch (utf8-ref (text-source (mark-text mark)) (mark-offset mark)))
+    (let ((ch (utf8-ref (text-bytes (mark-text mark)) (mark-offset mark)))
-          (offset2 (utf8-next (text-source (mark-text mark))
+          (offset2 (utf8-next (text-bytes (mark-text mark))
                               (mark-offset mark)
                               (text-end (mark-text mark)))))
       (mark-offset-set! mark offset2)
@@ -18,8 +18,8 @@
       (and text
            (if (< (text-start text) (text-end text))
                ;; advanced to a new piece, need to also move the mark
-               (let ((ch (utf8-ref (text-source text) (text-start text)))
+               (let ((ch (utf8-ref (text-bytes text) (text-start text)))
-                     (offset2 (utf8-next (text-source text)
+                     (offset2 (utf8-next (text-bytes text)
                                          (text-start text)
                                          (text-end text))))
                  (mark-offset-set! mark offset2)
@@ -38,7 +38,7 @@
   (cond
    ((> (mark-offset mark) (text-start (mark-text mark)))
     (cond
-     ((utf8-prev (text-source (mark-text mark))
+     ((utf8-prev (text-bytes (mark-text mark))
                  (mark-offset mark)
                  (text-start (mark-text mark)))
       => (lambda (offset) (mark-offset-set! mark offset) (text-ref mark)))
@@ -49,7 +49,7 @@
            (if (< (text-start text) (text-end text))
                ;; advanced to a new piece, need to also move the mark
                (cond
-                ((utf8-prev (text-source text) (text-end text) (text-start text))
+                ((utf8-prev (text-bytes text) (text-end text) (text-start text))
                  => (lambda (offset)
                       (mark-offset-set! mark offset)
                       (text-marks-set! (mark-text mark)

lib/chibi/text/search.scm

@@ -7,7 +7,7 @@
     (let lp ((tx (mark-text mk)))
       (and tx
            ;; Note string size is mis-named, it's actually the end offset.
-           (let* ((bv (text-source tx))
+           (let* ((bv (text-bytes tx))
                   (start (if (eqv? tx (mark-text mk)) (mark-offset mk) (text-start tx)))
                   (end (text-end tx))
                   (str (utf8->string! bv start end))

lib/chibi/text/types.scm

@@ -7,15 +7,15 @@
 ;; Basically implemented as a piece table with mark management.
 
 (define-record-type Text
-  (make-text source start end prev next marks data)
+  (make-text bytes start end prev next marks source)
   text?
-  (source text-source text-source-set!)
+  (bytes text-bytes text-bytes-set!)
   (start text-start text-start-set!)
   (end text-end text-end-set!)
   (prev text-prev text-prev-set!)
   (next text-next text-next-set!)
   (marks text-marks text-marks-set!)
-  (data text-data text-data-set!))
+  (source text-source text-source-set!))
 
 (define (text-first text)
   (cond ((text-prev text) => text-first)
@@ -25,9 +25,37 @@
   (cond ((text-next text) => text-last)
         (else text)))
 
+(define (text-splice! text)
+  ;; TODO: splice out the nodes themselves
+  (let ((marks (text-marks text)))
+    (text-start-set! text (text-end text))
+    (text-marks-set! text '())
+    marks))
+
 (define-record-type Mark
   (make-mark text offset data)
   mark?
   (text mark-text mark-text-set!)
   (offset mark-offset mark-offset-set!)
   (data mark-data mark-data-set!))
+
+(define-record-type Text-Source
+  (make-text-source loader path data)
+  text-source?
+  (loader text-source-loader text-source-loader-set!)
+  (path text-source-path text-source-path-set!)
+  (data text-source-data text-source-data-set!))
+
+(define-record-type Text-Loader
+  (make-text-loader load reload write modified?)
+  text-loader?
+  ;; load is used on construction
+  (load text-loader-load text-loader-load-set!)
+  ;; reload updates the text to match the file (discards changes)
+  (reload text-loader-reload text-loader-reload-set!)
+  ;; write updates the file to match the text (overwrites external edits)
+  (write text-loader-write text-loader-write-set!)
+  ;; modified tells us if the file has been modified since we last synced
+  ;; (either write or reload)
+  (modified? text-loader-modified? text-loader-modified?-set!)
+  )

lib/chibi/text/types.sld

@@ -3,16 +3,26 @@
   (import (scheme base))
   (export
    make-text text?
-   text-source text-source-set!
+   text-bytes text-bytes-set!
    text-start text-start-set!
    text-end text-end-set!
    text-prev text-prev-set!
    text-next text-next-set!
    text-marks text-marks-set!
-   text-data text-data-set!
+   text-source text-source-set!
    text-first text-last
    make-mark mark?
    mark-text mark-text-set!
    mark-offset mark-offset-set!
-   mark-data mark-data-set!)
+   mark-data mark-data-set!
+   ;; loading
+   make-text-source text-source?
+   text-source-loader text-source-loader-set!
+   text-source-path text-source-path-set!
+   text-source-data text-source-data-set!
+   make-text-loader text-loader?
+   text-loader-load text-loader-load-set!
+   text-loader-reload text-loader-reload-set!
+   text-loader-write text-loader-write-set!
+   text-loader-modified? text-loader-modified?-set!)
   (include "types.scm"))

lib/srfi/231/test.sld

@@ -1311,14 +1311,21 @@
         (test #\a
             (array-ref (make-specialized-array (make-interval '#())
                                                char-storage-class #\a)))
+        (test-assert
+            (array-packed? (make-specialized-array (make-interval '#())
+                                                   f32-storage-class)))
+        (test-assert
+            (array-packed? (make-specialized-array (make-interval '#(1 2 3)
+                                                                  '#(1 2 3))
+                                                   f32-storage-class)))
 
         ;; all these are true, we'll have to see how to screw it up later.
-        ;; (do ((i 0 (+ i 1)))
+        (do ((i 0 (+ i 1)))
-        ;;     ((= i tests))
+            ((= i tests))
-        ;;   (let ((array
+          (let ((array
-        ;;          (make-specialized-array (random-interval)
+                 (make-specialized-array (random-interval)
-        ;;                                  u1-storage-class)))
+                                         u1-storage-class)))
-        ;;     (test-assert (array-packed? array))))
+            (test-assert (array-packed? array))))
 
         (let ((array
                (make-specialized-array (make-interval '#(0 0) '#(2 3)))))