srfi 207: padding, trimming, and indexing

2 files changed, 109 insertions, 43 deletions

diff --git a/src/srfi-207.scm b/src/srfi-207.scm
index 1b3505d..9f3dfa6 100644
--- a/src/srfi-207.scm
+++ b/src/srfi-207.scm
@@ -10,6 +10,14 @@
         base64->bytevector
         bytestring->list
         make-bytestring-generator
+        bytestring-pad
+        bytestring-pad-right
+        bytestring-trim
+        bytestring-trim-right
+        bytestring-trim-both
+
+        bytestring-index
+        bytestring-index-right
 
         bytestring-error?)
     (begin
@@ -25,6 +33,59 @@
                         (let ((val (bytevector-u8-ref bv bdx)))
                             (set! bdx (+ bdx 1))
                             val)))))
+        (define (bytestring-pad bv len pad)
+            (let ((padding (- len (bytevector-length bv))))
+                (if (< padding 0)
+                    (bytevector-copy bv)
+                    (let ((result (make-bytevector len (if (char? pad) (char->integer pad) pad))))
+                        (bytevector-copy! result padding bv)
+                        result))))
+        (define (bytestring-pad-right bv len pad)
+            (if (< (- len (bytevector-length bv)) 0)
+                (bytevector-copy bv)
+                (let ((result (make-bytevector len (if (char? pad) (char->integer pad) pad))))
+                    (bytevector-copy! result 0 bv)
+                    result)))
+        (define (bytestring-trim bv pred)
+            (let ((start (bytestring-index bv (lambda (n) (not (pred n))))))
+                (if start
+                    (bytevector-copy bv start)
+                    #u8())))
+        (define (bytestring-trim-right bv pred)
+            (let ((end (bytestring-index-right bv (lambda (n) (not (pred n))))))
+                (if end
+                    (bytevector-copy bv 0 (+ end 1))
+                    #u8())))
+        (define (bytestring-trim-both bv pred)
+            (let ((start (bytestring-index bv (lambda (n) (not (pred n))))))
+                (if start
+                    (bytevector-copy bv start
+                            (+ (bytestring-index-right bv (lambda (n) (not (pred n)))) 1))
+                    #u8())))
+
+        (define (%bytestring-index bv pred start end)
+            (if (>= start end)
+                #f
+                (if (pred (bytevector-u8-ref bv start))
+                    start
+                    (%bytestring-index bv pred (+ start 1) end))))
+        (define bytestring-index
+            (case-lambda
+                ((bv pred) (%bytestring-index bv pred 0 (bytevector-length bv)))
+                ((bv pred start) (%bytestring-index bv pred start (bytevector-length bv)))
+                ((bv pred start end) (%bytestring-index bv pred start end))))
+        (define (%bytestring-index-right bv pred start end)
+            (let ((end (- end 1)))
+                (if (>= start end)
+                    #f
+                    (if (pred (bytevector-u8-ref bv end))
+                        end
+                        (%bytestring-index-right bv pred start end)))))
+        (define bytestring-index-right
+            (case-lambda
+                ((bv pred) (%bytestring-index-right bv pred 0 (bytevector-length bv)))
+                ((bv pred start) (%bytestring-index-right bv pred start (bytevector-length bv)))
+                ((bv pred start end) (%bytestring-index-right bv pred start end))))
 
         (define (bytestring-error? obj)
             (and (error-object? obj) (eq? (error-object-kind obj) 'bytestring-error)))
diff --git a/test/srfi.scm b/test/srfi.scm
index 93c5497..c0dee35 100644
--- a/test/srfi.scm
+++ b/test/srfi.scm
@@ -4004,42 +4004,57 @@
     (bytestring-error? (guard (o (else o)) (make-bytestring-generator "abc\x3BB;efg" #\m #\u))))
 (check-equal #t
     (bytestring-error? (guard (o (else o)) (make-bytestring-generator 89 90 300))))
-#|
-(define test-bstring (bytestring "lorem"))
 
+(check-equal #u8"____Zaphod" (bytestring-pad #u8"Zaphod" 10 #\_))
+(check-equal #u8(#x80 #x7f 0 0 0 0 0 0) (bytestring-pad-right #u8(#x80 #x7f) 8 0))
+(check-equal #u8"Trillian" (bytestring-trim #u8"   Trillian" (lambda (b) (= b #x20))))
+(check-equal #u8(#x80 #x7f) (bytestring-trim-both #u8(0 0 #x80 #x7f 0 0 0) zero?))
 
-(define (check-selection)
-  (print-header "Running selection tests...")
+(check-equal #u8"lorem" (bytestring-pad #u8"lorem" (bytevector-length #u8"lorem") #x7a))
+(check-equal "zzzlorem" (utf8->string (bytestring-pad #u8"lorem" 8 #x7a)))
+(check-equal #t
+    (equal? (bytestring-pad #u8"lorem" 8 #\z)
+            (bytestring-pad #u8"lorem" 8 (char->integer #\z))))
+(check-equal #u8"lorem"
+        (bytestring-pad-right #u8"lorem" (bytevector-length #u8"lorem") #x7a))
+(check-equal "loremzzz" (utf8->string (bytestring-pad-right #u8"lorem" 8 #x7a)))
+(check-equal #t
+    (equal? (bytestring-pad-right #u8"lorem" 8 #\z)
+            (bytestring-pad-right #u8"lorem" 8 (char->integer #\z))))
+
+(check-equal #u8"Trillian" (bytestring-trim #u8" Trillian" (lambda (b) (= b #x20))))
+(check-equal #u8(#x80 #x7f) (bytestring-trim-both #u8(0 0 #x80 #x7f 0 0 0) zero?))
+
+(define (always n) #t)
+(define (never n) #f)
+(define (eq-r? n) (= n 114))
+
+(check-equal #u8() (bytestring-trim #u8"lorem" always))
+(check-equal #u8"lorem" (bytestring-trim #u8"lorem" never) )
+(check-equal #u8(#x72 #x65 #x6d) (bytestring-trim #u8"lorem" (lambda (u8) (< u8 #x70))))
+(check-equal #u8() (bytestring-trim-right #u8"lorem" always))
+(check-equal #u8"lorem" (bytestring-trim-right #u8"lorem" never))
+(check-equal #u8(#x6c #x6f #x72) (bytestring-trim-right #u8"lorem" (lambda (u8) (< u8 #x70))))
+(check-equal #u8() (bytestring-trim-both #u8"lorem" always))
+(check-equal #u8"lorem" (bytestring-trim-both #u8"lorem" never))
+(check-equal #u8(#x72) (bytestring-trim-both #u8"lorem" (lambda (u8) (< u8 #x70))))
+
+(check-equal 2 (bytestring-index #u8(#x65 #x72 #x83 #x6f) (lambda (b) (> b #x7f))))
+(check-equal #f (bytestring-index #u8"Beeblebrox" (lambda (b) (> b #x7f))))
+(check-equal 4 (bytestring-index-right #u8"Zaphod" odd?))
+
+(check-equal 0 (bytestring-index #u8"lorem" always))
+(check-equal #f (bytestring-index #u8"lorem" never))
+(check-equal 3 (bytestring-index #u8"lorem" always 3))
+(check-equal 2 (bytestring-index #u8"lorem" eq-r?))
+
+(check-equal 4 (bytestring-index-right #u8"lorem" always))
+(check-equal #f (bytestring-index-right #u8"lorem" never))
+(check-equal 4 (bytestring-index-right #u8"lorem" always 3))
+(check-equal 2 (bytestring-index-right #u8"lorem" eq-r?))
 
-  (check (bytestring-pad #u8"lorem" (bytevector-length #u8"lorem") #x7a)
-   => #u8"lorem")
-  (check (utf8->string (bytestring-pad #u8"lorem" 8 #x7a))
-   => "zzzlorem")
-  (check (equal? (bytestring-pad #u8"lorem" 8 #\z)
-                 (bytestring-pad #u8"lorem" 8 (char->integer #\z)))
-   => #t)
-  (check (bytestring-pad-right #u8"lorem"
-                               (bytevector-length #u8"lorem")
-                               #x7a)
-   => #u8"lorem")
-  (check (utf8->string (bytestring-pad-right #u8"lorem" 8 #x7a))
-   => "loremzzz")
-  (check (equal? (bytestring-pad-right #u8"lorem" 8 #\z)
-                 (bytestring-pad-right #u8"lorem" 8 (char->integer #\z)))
-   => #t)
-
-  (check (bytestring-trim #u8"lorem" always) => #u8())
-  (check (bytestring-trim #u8"lorem" never)  => #u8"lorem")
-  (check (bytestring-trim #u8"lorem" (lambda (u8) (< u8 #x70)))
-   => #u8(#x72 #x65 #x6d))
-  (check (bytestring-trim-right #u8"lorem" always) => #u8())
-  (check (bytestring-trim-right #u8"lorem" never)  => #u8"lorem")
-  (check (bytestring-trim-right #u8"lorem" (lambda (u8) (< u8 #x70)))
-   => #u8(#x6c #x6f #x72))
-  (check (bytestring-trim-both #u8"lorem" always) => #u8())
-  (check (bytestring-trim-both #u8"lorem" never)  => #u8"lorem")
-  (check (bytestring-trim-both #u8"lorem" (lambda (u8) (< u8 #x70)))
-   => #u8(#x72)))
+#|
+(define test-bstring (bytestring "lorem"))
 
 (define (check-replacement)
   (print-header "Running bytestring-replace tests...")
@@ -4090,16 +4105,6 @@
   (define (lt-r? b) (< b #x72))
   (print-header "Running search tests...")
 
-  (check (bytestring-index #u8"lorem" always)     => 0)
-  (check (bytestring-index #u8"lorem" never)      => #f)
-  (check (bytestring-index #u8"lorem" always 3)   => 3)
-  (check (bytestring-index #u8"lorem" eq-r?) => 2)
-
-  (check (bytestring-index-right #u8"lorem" always)     => 4)
-  (check (bytestring-index-right #u8"lorem" never)      => #f)
-  (check (bytestring-index-right #u8"lorem" always 3)   => 4)
-  (check (bytestring-index-right #u8"lorem" eq-r?) => 2)
-
   (check (values~>list (bytestring-span #u8"lorem" always))
    => (list #u8"lorem" (bytevector)))
   (check (values~>list (bytestring-span #u8"lorem" never))